diff options
332 files changed, 48220 insertions, 23596 deletions
@@ -1,42 +1,247 @@ 1999-04-15 <stanton@scriptics.com> - * Merged changes from 8.0.5: - - Updated for Mac release + * Merged 8.1 branch into the main trunk + +1999-04-09 <redman@scriptics.com> + + * generic/tkWindow.c: Fixed deadlock situation when the Initialize() + function returns without releasing the mutex. Found while testing + Bug 1700, during safe.test (tk). + +1999-04-06 <stanton@scriptics.com> + + * generic/tkMain.c (Tk_MainEx): Changed to reset result before + calling Tcl_EvalFile. The ensures that error messages will be + generated cleanly. + + * tests/winfo.test: Enabled tests that previously failed. + +1999-04-05 <stanton@scriptics.com> + + * library/bgerror.tcl: + * library/button.tcl: + * library/clrpick.tcl: + * library/console.tcl: + * library/dialog.tcl: + * library/entry.tcl: + * library/focus.tcl: + * library/listbox.tcl: + * library/menu.tcl: + * library/msgbox.tcl: + * library/palette.tcl: + * library/scale.tcl: + * library/scrlbar.tcl: + * library/tearoff.tcl: + * library/text.tcl: + * library/tk.tcl: Lots of minor performance improvements + contributed by Jeffrey Hobbs. [Bug: 1118] + + * win/tkWinWm.c (Tk_WmCmd): Fixed bad code in tracing + suboption. [Bug: 1519] + + * library/tkfbox.tcl: Change to restore button text after an + action to avoid the sticky "Open" button in a save dialog. + [Bug: 1640] + + * library/entry.tcl: Fixed so selection is returned using the + -show character during cut and paste operations. [Bug: 1687] -1999-03-22 <redman@scriptics.com> +1999-04-5 <redman@scriptics.com> - * unix/configure.in: Removed --enable-tcl-stub from configure - scripts. Due to linking problems with wish and potentially anyone - else linking directly to Tk, linking Tk to the Tcl stubs is being - disabled until Tk is a truly loadable extension. + * generic/tkInt.decls: + * generic/tkIntXlibDecls.h: + * generic/tkStubInit.c: + * xlib/xgc.c: + * xlib/X11/Xlib.h: + * xlib/X11/Xutil.h: Added more X functions to the Win & Mac stubs + tables. +1999-04-05 <stanton@scriptics.com> + + * unix/configure.in: + * generic/tkCanvPs.c: Added configure test for pw_gecos field in + pwd to support OS/390. [Bug: 1724] + +1999-04-02 <stanton@scriptics.com> + + * tests/text.test: + * generic/tkText.c: Fixed handling of Unicode in text searches. + The -count option was returning byte counts instead of character + counts. [Bug: 1056, 1148, 1666] + +1999-04-01 <redman@scriptics.com> + + * generic/tk.decls: + * generic/tk.h: + * generic/tkStubInit.c: + * generic/tkWindow.c: + * unix/Makefile.in: + * win/makefile.vc: Tk now uses its own stub library to store + pointers to its own stubs table. + + * doc/dde.n: (removed) + * doc/send.n: + * generic/tk.decls: + * tests/winSend.test: + * generic/tkPlatDecls.h: + * win/tkWinSend.c: Removed the DDE-based send and dde commands, + they were causing Tk to lock up when any window on the system was + not processing its message queue (more importantly, windows in Tcl + and Tk). The send command needs to be rewritten to prevent the + deadlock situation (soon). The dde command is being pushed into + its own package and will provide almost all of the capabilities + that send did before (using a "dde eval" command), not yet + completed. + +1999-03-31 <redman@scriptics.com> + + * win/tkWinSend.c: Modified dde/send code to work properly on + Win95/Win98. String lengths are not returned properly by DDE, so + NULL terminate all strings going in and ignore the string length + coming back out. Do not destroy handles until all necessary work + on those handles (and child handles) is done. + +1999-03-30 <stanton@scriptics.com> + + * generic/tkWindow.c (Tk_DestroyWindow): Image handlers are now + finalized before the font subsystem since complex image handlers + may contain references to fonts (e.g. Tix compound images). + [Bug: 1603] + +1999-03-29 <stanton@scriptics.com> + + * doc/MeasureChar.3: + * doc/TextLayout.3: + * generic/tk.decls: + * generic/tkCanvText.c: + * generic/tkEntry.c: + * generic/tkFont.c: + * generic/tkListbox.c: + * generic/tkMessage.c: + * mac/tkMacFont.c: + * unix/tkUnixButton.c: + * unix/tkUnixFont.c: + * unix/tkUnixMenu.c: + * win/tkWinFont.c: + * win/tkWinMenu.c: Standardized text layout and font interfaces + so they are consistent with respect to byte versus character + oriented indices. The layout functions all manipulate character + oriented values while the lower level measurement functions all + operate on byte oriented values. This distinction was not clear + and so the functions were being used improperly in a number of + places. [Bug: 1053, 747, 749, 1646] + + * generic/tk.decls: Eliminated uses of C++ STL types string and + list from declarations. + + * generic/tkFont.c: Changes to named fonts were not being + propagated in some cases. [Bug: 1144] + + * xlib/X11/Xlib.h: + * generic/tkInt.decls: Added XParseColor to xlib stub + tables. [Bug: 1574] + + * doc/GetBitmap.3: + * generic/tkBitmap.c (BitmapInit): Eliminated use of Tk_Uid's in + bitmaps. Added a few CONST declarations. + +1999-03-29 <redman@scriptics.com> + + * unix/configure.in: + * unix/Makefile.in: + * win/makefile.vc: + * generic/tkDecls.h: + * generic/tkIntDecls.h: + * generic/tkIntPlatDecls.h: + * generic/tkPlatDecls.h: + * generic/tkIntXlibDecls.h: Removed stub functions. Always use the + Tcl stubs when building with --enable-shared. + + +1999-03-26 <redman@scriptics.com> + + * generic/tkTextIndex.c: + * tests/testIndex.test: Avoid looking past the beginning of the + array storing data for the text widget (.t index end-2c). Added + test case to check for the bug. [Bug 991] + + * generic/tkConsole.c: Copy static strings into a Tcl_DString + before passing to Tcl_Eval, in case the compiler puts static + strings into read-only memory. + +1999-03-26 <suresh@scriptics.com> + + * unix/configure.in: + --nameble-shared is now the default and builds Tk as a shared + library; specify --disable-shared to build a static Tk library + and shell. + +1999-03-26 <surles@scriptics.com> + + * library/menu.tcl: Fixed bug reported by Bryan Oakley in the + menubutton bindings. There was a false assumption that there was + always a menu attached to the button. [Bug 1116] + +1999-03-26 <redman@scriptics.com> + + * unix/configure.in: Removed --enable-tcl-stub. Linking Tk to Tcl + stubs is causing too many problems when linking executables like wish. + Until the Tk is a fully loadable extension, linking against the Tcl + stubs is not supported in Tk. + +1999-03-19 <redman@scriptics.com> + + * generic/tkBitmap.c: + * generic/tkCursor.c: + * generic/tkGC.c: When creating hash tables that key off of XID + handles, make sure to pass TCL_ONE_WORD_KEYS. XIDs are guaranteed + to be 32bit numbers, although on some 64bit systems (including 64bit + Solaris 7) they are packed into a 64bit value where the upper 32bits + are zero. The normal method of sizeof(XID)/sizeof(int) causes the + hash table code to assume that the XID is a pointer to an array of + two ints, which it is not. Tk now supports 64bit Solaris 7. + +1999-03-17 <stanton@scriptics.com> + + * win/makefile.vc: + * generic/tk.h: Changed to use TCL_BETA_RELEASE macro, and fixed + so this works in rc files. + + * win/makefile.vc: + * win/makefile.bc: + * win/README: + * unix/configure.in: + * generic/tk.h: + * README: Updated version to 8.1b3. + +1999-03-14 <stanton@GASPODE> + + * unix/configure.in: Added missing stub related definitions. + + * unix/Makefile.in: Install tkDecls.h in addition to tk.h. + + * generic/tkStubLib.c: Added flags to ensure we are using Tcl + stub macros. + 1999-03-11 <stanton@GASPODE> * generic/tkInt.decls: Added reserved slot for XSetDashes for use by the dash patch. 1999-03-10 <redman@scriptics.com> - * win/tkWinInt.h: - * win/tkWinPointer.c: - * win/tkWinWm.c: Fixed bug with "focus -force". Windows' - SetForegroundWindow doesn't work properly if you don't pass the - handle to the true toplevel window. Added a wrapper function - TkWinSetForegroundWindow to work around the problem. Back-ported - from Tk 8.1. - -1999-03-10 <redman@scriptics.com> + * xlib/xdraw.c: * xlib/X11/Xlib.h: - * unix/tkUnixInt.h: * mac/tkMac.h: * mac/tkMacInt.h: * mac/tkMacPort.h: * mac/tkMacXStubs.c: + * mac/tkMacAppInit.c: + * mac/tkMacCursor.c: * win/makefile.vc: * win/tkWin.h: * win/tkWinInt.h: * win/tkWinPort.h: - * win/tkWinDraw.c: * win/winMain.c: * generic/tk.h: * generic/tkInt.h: @@ -56,31 +261,143 @@ * generic/tkStubLib.c: * generic/tkBind.c: * generic/tkCmds.c: - * generic/tkConsole.c + * generic/tkConfig.c: + * generic/tkConsole.c: + * generic/tkCursor.c: * generic/tkGrab.c: * generic/tkImgPhoto.c: * generic/tkMain.c: + * generic/tkMenu.c: * generic/tkPointer.c: * generic/tkTextDisp.c: * generic/tkWindow.c: + * unix/tkUnixInt.h: + * unix/tkUnixPort.h: * unix/Makefile.in: * unix/configure.in: * unix/tkConfig.sh.in: * unix/tkUnix.c: * unix/tkUnix3d.c: * unix/tkUnixDraw.c: - * unix/tkUnixFont.c: Stubs implementation for 8.0.6. Tk_Main() is - now a wrapper around Tk_MainEx() and will be removed in 8.1 and - replaced with a macro. Tk does not link to the Tcl stubs library - for now, because of issues with wish (will be fixed in 8.1). - Exported all public functions through the stubs mechanism (see the - *.decls files) and many of the internal functions. Most of the - changes dealt with shifting around the function declarations in - the header files. Mac code may not compile, but it shouldn't take - much work to fix this. + * unix/tkUnixFont.c: + * unix/tkUnixMenubu.c: Stubs implementation for 8.1. Tk_Main() is + replaced with a macro which calls Tk_MainEx(). Tk can link to the Tcl + stubs library, wish links directly to Tcl and Tk. Use + --enable-tcl-stubs to link Tk to the Tcl stubs library (Unix), on + by default on Windows. Exported all public functions through the + stubs mechanism (see the *.decls files) and many of the internal + functions. Most of the changes dealt with shifting around the + function declarations in the header files. Mac code may not + compile, but it shouldn't take much work to fix this. + + * mac/tkMacMenu.c: Added dummy TkpMenuThreadInit for Mac to be + consistent with Unix and Windows versions. + +1999-03-08 <lfb@scriptics.com> + + * win/tkWinWm.c: Toplevel class no longer shared between + threads. + + * win/tkWinX.c: Multiple threads no longer share the same + TkDisplay structure. Required because TkDisplay stores much + thread-specific data for a given thread. + + * win/tkWinSend.c: Moved application instance handle out + out thread-local storage. DDE was failing to initialize + when the instance handles were different between threads. + + * win/makefile.vc: Added THREADDEFINES for building with + threads enabled. + + * generic/tkMenu.c: + * win/tkWinMenu.c: + * unix/tkUnixMenu.c: Added TkpMenuThreadInit for initializing + thread-specific Menu state. + +1999-03-01 <redman@scriptics.com> + + * win/tkWinWm.c: + * win/tkWinPointer.c: + * win/tkWinInt.h: Fix "focus -force" for Windows. The Win32 API + function SetForegroundWindow() does not work unless the window + handle is a toplevel window (a Windows toplevel). The handle + being passed was a Tk toplevel, which is a child of the Windows + toplevel. + +1999-02-26 <redman@scriptics.com> + + * win/cat.c: Remove this file, use the one in the Tcl source directory. + + * win/makefile.vc: Remove the wishc.exe from the default targets. Add + a separate console-wish target to build it. The need for a + console-wish will go away soon, so we don't want to encourage its + use. + +1999-02-25 <redman@scriptics.com> + + * win/tkWinWm.c: Properly initialize the tsdPtr->firstWindow field. + + * win/cat.c: Code for cat32.exe, copied from the Tcl sources. Required + in order to run the test suite from the makefile + + * win/winMain.c: Add main() for a console-based wishc.exe, which meant + adding code to disable the call to Tk_ConsoleInit(). + + * generic/tkConsole.c: Check the standard handles before creating the + new standard channels. This allows a windows app that has stdin, + stdout, or stderr to correctly connect to them. + + * generic/tkMain.c: Add a proper check for the interactive mode, since + the standard channels may actually be connected in windows mode or + even in the console-based wish. + + * win/makefile.vc: Add targets for wishc.exe (console-based wish) and + cat32.exe (for testing). Fix the test suite target so it can be run + from the makefile (which can happen since the standard handles have + been fixed). + +1999-02-12 <lfb@scriptics.com> + + * generic/tkMenuButton.h: + * generic/tkMenuButton.c: + * mac/tkMacMenubutton.c: + * mac/tkMacDefault.h + * unix/tkUnixMenubu.c: Eliminated Tk_Uids used by -state option. + * unix/tkUnixDefault.h + * win/tkWinDefault.h + + + * generic/tk.h: + * generic/tkScale.h: + * generic/tkScale.c: + * generic/tkWindow.c: + * unix/tkUnixScale.c: + * unix/tkUnixDefault.h: + * unix/tkWinDefault.h: + * mac/tkMacDefault.h: Objectified scale widget. + + * win/tkWinX.c: Removed Thread-specific data from process + initialization code that was stopping the Tk Dll from + loading. + +1999-02-11 <stanton@GASPODE> + + * README: + * generic/tk.h: + * unix/configure.in: + * win/README: + * win/makefile.bc: + * win/makefile.vc: Updated version to 8.1b2. + + * unix/tkUnixSend.c: Fixed one more Tcl_*ObjVar instance. 1999-02-04 <stanton@GASPODE> + * Various cleanup related to the Tcl_Eval and Tcl_ObjSetVar + changes in Tcl. + + INTEGRATED PATCHES FROM 8.0.5b2: + * win/tkWinMenu.c (TkpDestroyMenu): Changed so modalMenuPtr is cleared when it is being destroyed. @@ -95,7 +412,7 @@ mask changed but ended up with the same XID, the GC failed to be updated and so the new mask was not used. [Bug: 970] - * generic/tkFocus.c (SetFocus): Changed o focus window is always + * generic/tkFocus.c (SetFocus): Changed so focus window is always set if -force is specified. This fixes the problem on Windows where Tk does not activate the window if it already has focus. @@ -142,15 +459,96 @@ * unix/tkUnixSend.c (Tk_SetAppName): Fixed uninitialized memory access bug. [Bug: 919] -1998-12-30 <stanton@GASPODE> +1999-1-28 <stanton@GASPODE> * generic/tkGrid.c: Fixed bug in "grid forget" that failed to cancel pending idle handlers, resulting in a crash in a few odd cases. +1999-01-06 <lfb@JUSTICE> + + * generic/tk.h, generic/tkGet.c, generic/tkConfig.c, + * generic/tkOldConfig.c, generic/tkEntry.c, generic/tkMenubutton.c, + * generic/tkMenubutton.h, generic/tkScale.c, generic/tkScale.h, + * generic/tkTextDisplay.c, generic/tkText.c, unix/tkUnixMenubu.c, + * unix/tkUnixScale.c, mac/tkMacMenu.c, mac/tkMacMenubutton.c, + + Removed global Tk_Uids dealing with "-state" configuration option + and added new TK_CONFIG_STATE configSpec that doesn't use + Tk_Uids. + +1998-12-11 === Tk 8.1b1 Release === + +1998-12-11 <stanton@GASPODE> + + * generic/tkMain.c (Tk_Main): Fixed improper command line encoding + handling. + +1998-12-08 <stanton@GASPODE> + + * win/tkWinClipboard.c (TkSelGetSelection, TkWinClipboardRender): + Changed to handle multibyte characters properly. [Bug: 935] + +1998-12-07 <stanton@GASPODE> + + * library/xmfbox.tcl (tkMotifFDialog_Create): In the cached case, + the data array was not being initialized with the correct set of + widgets. + +1998-12-4 <welch@SAGE> + + * Changed patchLevel to 8.1b1 + + * generic/tkMenu.c (ConfigureMenuCloneEntries): The -menu configuration + option was being incorrectly specified as just "menu". + +1998-11-30 <stanton@GASPODE> + + * generic/tkButton.c (ConfigureButton): The error result was + getting lost when restoring configuration options. [Bug: 619] + +1998-11-25 <stanton@GASPODE> + + * unix/tkUnixFont.c (GetFontAttributes): Initialize an unspecified + family to an empty string. + (FontMapLoadPage): if the font included characters below 32, the + index computation was incorrect because the range was shifted up + to 32. + (CreateClosestFont): check for empty locale as well as NULL. + + * generic/tkFont.c (TkFontParseXLFD): initialize charset to + iso8859-1 if no charset is specified. + + * mac/tkMacHLEvents.c (OdocHandler): added conversion from + external string to UTF [Bug: 869] + + * integrated tk8.0.4 changes. + + * generic/tkBind.c: fixed deletion order bug where a crash would + result if a binding deleted "." + + * generic/tkMenu.c (MenuWidgetObjCmd): disabled menu entries were + getting reenabled whenever the mouse passed over the entry [Bug: 860] + + * unix/tkUnixMenu.c (TkpComputeStandardMenuGeometry): hidemargin + option was not honored properly in menus [Bug: 859] + 1998-11-24 <stanton@GASPODE> - * unix/tkUnixFont.c (TkpGetNativeFont): On some X servers, - XQueryLoadFont will always return a font, even if the name is - meaningless. This prevents Tk from parsing the font name, so now - we perform a quick sanity check on the name before letting X have - it. [Bug: 846] + * tkMacMenu.c, tkUnixMenu.c, tkWinMenu.c, tkMenuDraw.c, tkMenu.h, + * tkMenu.c: Backed out the previous fix for bug 620 and + eliminated a bunch of code that created unnecessary objects. + Changed back to using internal types instead of objects for many + configuration options. There are many more fixes like this that + could be made, but some require a little restructuring of the + code. In any case the leaks are fixed and there is a lot less + allocation happening. [Bug: 620] + +1998-11-19 <stanton@GASPODE> + + * tkMenu.c (DestroyMenuEntry): fixed memory leaks [Bug: 620] + + * tkWinX.c (GetTranslatedKey): fixed bad code merge + + * tkWinWm.c, tkWinMenu.c: fixed titles and menus so they properly + display Unicode [Bug: 819] + @@ -3,7 +3,7 @@ README: Tk Tk is maintained, enhanced, and distributed freely as a service to the Tcl community by Scriptics Corporation. -RCS: @(#) $Id: README,v 1.13 1999/02/17 02:34:36 hershey Exp $ +RCS: @(#) $Id: README,v 1.14 1999/04/16 01:51:07 stanton Exp $ Contents -------- @@ -11,7 +11,7 @@ Contents 2. Documentation 3. Compiling and installing Tk 4. Getting started - 5. Summary of changes in Tk 8.0 + 5. Summary of changes in Tk 8.1 6. Development tools 7. Tcl newsgroup 8. Tcl contributed archive @@ -25,19 +25,23 @@ Contents This directory contains the sources and documentation for Tk, an X11 toolkit implemented with the Tcl scripting language. The information -here corresponds to release 8.0.5, which is the fifth patch update for -Tk 8.0. This release is designed to work with Tcl 8.0.5 and may not -work with any other version of Tcl. +here corresponds to release 8.1b3, which is the third beta release +for Tk 8.1. This release is mostly feature complete but may have bugs +and be missing some minor features. This release is for early +adopters who are willing to help us find and fix problems. Please let +us know about any problems you uncover. -Tk 8.0 is a major release with significant new features such as native -look and feel on Macintoshes and PCs, a new font mechanism, application -embedding, and proper support for Safe-Tcl. See below for details. -There should be no backward incompatibilities in Tk 8.0 that affect -scripts. This patch release fixes various bugs in Tk 8.0; there are no -feature changes relative to Tk 8.0. +The most important change in Tk 8.1 is that it supports the new +internationalization features in Tcl 8.1. It also contains a new +library for handling configuration options some of the widgets have +been converted to use the Tcl object facilities. For details on +features, incompatibilities, and potential problems with this release, +see the Tcl/Tk 8.1 Web page at -Note: with Tk 8.0 the Tk version number skipped from 4.2 to 8.0. The -jump was made in order to synchronize the Tcl and Tk version numbers. + http://www.scriptics.com/software/8.1.html + +or refer to the "changes" file in this directory, which contains a +historical record of all changes to Tk. Tk is a freely available open source package. You can do virtually anything you like with it, such as modifying it, redistributing it, @@ -153,120 +157,9 @@ library/demos/widget is a script that you can use to invoke many individual demonstrations of Tk's facilities, see the code that produced the demos, and modify the code to try out alternatives. -5. Summary of changes in Tk 8.0 +5. Summary of changes in Tk 8.1 ------------------------------- -Here is a list of the most important new features in Tk 8.0. The -release also includes several smaller feature changes and bug fixes. -See the "changes" file for a complete list of all changes. - - 1. Native look and feel. The widgets have been rewritten to provide - (nearly?) native look and feel on the Macintosh and PC. Many - widgets, including scrollbars, menus, and the button family, are - implemented with native platform widgets. Others, such as entries - and texts, have been modified to emulate native look and feel. - These changes are backwards compatible except that (a) some - configuration options are now ignored on some platforms and (b) you - must use the new menu mechanism described below to native look and - feel for menus. - - 2. There is a new interface for creating menus, where a menubar is - implemented as a menu widget instead of a frame containing menubuttons. - The -menu option for a toplevel is used to specify the name of the - menubar; the menu will be displayed *outside* the toplevel using - different mechanisms on each platform (e.g. on the Macintosh the menu - will appear at the top of the screen). See the menu demos in the - widget demo for examples. The old style of menu still works, but - does not provide native look and feel. Menus have several new - features: - - New "-columnbreak" and "-hideMargin" options make it possible - to create multi-column menus. - - It is now possible to manipulate the Apple and Help menus on - the Macintosh, and the system menu on Windows. It is also - possible to have a right justified Help menu on Unix. - - Menus now issue the virtual event <<MenuSelect>> whenever the - current item changes. Applications can use this to generate - help messages. - - There is a new "-direction" option for menubuttons, which - controls where the menu pops up revenues to the button. - - 3. The font mechanism in Tk has been completely reworked: - - Font names need not be nasty X LFDs: more intuitive names - like {Times 12 Bold} can also be used. See the manual entry - font.n for details. - - Font requests always succeed now. If the requested font is - not available, Tk finds the closest available font and uses - that one. - - Tk now supports named fonts whose precise attributes can be - changed dynamically. If a named font is changed, any widget - using that font updates itself to reflect the change. - - There is a new command "font" for creating named fonts and - querying various information about fonts. - - There are now officially supported C APIs for measuring and - displaying text. If you use these APIs now, your code will - automatically handle international text when internationalization - is added to Tk in a future release. See the manual entries - MeasureChar.3, TextLayout.3, and FontId.3. - - The old C procedures Tk_GetFontStruct, Tk_NameOfFontStruct, - and Tk_FreeFontStruct have been replaced with more portable - procedures Tk_GetFont, Tk_NameOfFont, and Tk_FreeFont. - - 4. Application embedding. It is now possible to embedded one Tcl/Tk - application inside another, using the -container option on frame - widgets and the -use option for toplevel widgets or on the command - line for wish. Embedding should be fully functional under Unix, - but the implementation is incomplete on the Macintosh and PC. - - 5. Tk now works correctly with Safe-Tcl: it can be loaded into - safe interpreters using safe::loadTk. - - 6. Text widgets now allow images to be embedded directly in the - text without using embedded windows. This is more efficient and - provides smoother scrolling. - - 7. Buttons have a new -default option for drawing default rings in - a platform-specific manner. - - 8. There is a new "gray75" bitmap, and the "gray25" bitmap is now - really 25% on (due to an ancient mistake, it had been only 12% on). - The Macintosh now supports native bitmaps, including new builtin - bitmaps "stop", "caution", and "note", plus the ability to use - bitmaps in the application's resource fork. - - 9. The "destroy" command now ignores windows that don't exist - instead of generating an error. - -Tk 8.0 introduces the following incompatibilities that may affect Tcl/Tk -scripts that worked under Tk 4.2 and earlier releases: - - 1. Font specifications such as "Times 12" now interpret the size - as points, whereas it used to be pixels (this was actually a bug, - since the behavior was documented as points). To get pixels now, - use a negative size such as "Times -12". - - 2. The -transient option for menus is no longer supported. You can - achieve the same effect with the -type field. - - 3. In the canvas "coords" command, polygons now return only the - points that were explicitly specified when the polygon was created - (they used to return an extra point if the polygon wasn't originally - closed). Internally, polygons are still closed automatically for - purposes of display and hit detection; the extra point just isn't - returned by the "coords" command. - - 4. The photo image mechanism now uses Tcl_Channels instead of FILEs, - in order to make it portable. FILEs are no longer used anywhere - in Tk. The procedure Tk_FindPhoto now requires an extra "interp" - argument in order to fix a bug where images in different interpreters - with the same name could get confused. - - 5. The procedures Tk_GetFontStruct, Tk_NameOfFontStruct, - and Tk_FreeFontStruct have been removed. - -Note: the new compiler in Tcl 8.0 may also affect Tcl/Tk scripts; check -the Tcl documentation for information on incompatibilities introduced by -Tcl 8.0. - 6. Development tools -------------------- @@ -2,7 +2,7 @@ This file summarizes all changes made to Tk since version 1.0 was released on March 13, 1991. Changes that aren't backward compatible are marked specially. -RCS: @(#) $Id: changes,v 1.31 1999/04/16 01:25:53 stanton Exp $ +RCS: @(#) $Id: changes,v 1.32 1999/04/16 01:51:07 stanton Exp $ 3/16/91 (bug fix) Modified tkWindow.c to remove Tk's Tcl commands from the interpreter when the main window is deleted (otherwise there will @@ -4010,19 +4010,19 @@ virtual events now go to the correct (focus) window. (RJ) 9/19/97 (bug fix) Made Macintosh tearoff menus non-resizable. (RJ) +10/9/97 (bug fix) Default font for new canvas text items was hardcoded to +"Helvetica 12" instead of using DEF_CANVTEXT_FONT defined in +tk{platform}Default.h like all the other widget settings. (CCS) + 10/9/97 (bug fix) Image code could cause crashes during "exit" under some conditions (such as an image named "place"). (JO) 10/9/97 (bug fix) Fixed bug that sometimes prevented listboxes from scrolling far enough horizontally to see the rightmost character. (JO) -10/9/97 (bug fix) Default font for new canvas text items was hardcoded to -"Helvetica 12" instead of using DEF_CANVTEXT_FONT defined in -tk{platform}Default.h like all the other widget settings. (CCS) - -10/10/97 (bug fix) In canvas text items, if the text ended with a \n, it -was not counted in the bbox height, as it did in tk4.2. This caused -"hello\n" to be the same height as "hello" and you couldn't see the +10/10/97 (bug fix) In canvas text items, if the text ended with a \n, it +was not counted in the bbox height, as it did in tk4.2. This caused +"hello\n" to be the same height as "hello" and you couldn't see the cursor positioned on the next line. (CCS) 10/10/97 (bug fix) The grid geometry manager didn't always properly @@ -4343,10 +4343,242 @@ on Win NT 4.0/Japanese that cause a crash in some cases. (stanton) 2/4/99 (bug fix) Fixed uninitialized memory access bug in Unix send code. (stanton) ------------------ Released 8.0.5, 3/9/99 ------------------------- - ---------------------------------------------------------- Changes for Tk 8.0 go above this line. Changes for Tk 8.1 go below this line. ---------------------------------------------------------- +1/16/98 (new feature) Tk now supports international characters sets: + - Font display mechanism overhauled to display Unicode strings + containing full set of international characters. You do not need + Unicode fonts on your system in order to use tk or see international + characters. For those familiar with the Japanese or Chinese patches, + there is no "-kanjifont" option. Characters from any available fonts + will automatically be used if the widget's originally selected font is + not capable of displaying a given character. + - Textual widgets are international aware. For instance, cursor + positioning commands would now move the cursor forwards/back by 1 + international character, not by 1 byte. + - Input Method Editors (IMEs) work on Mac and Windows. Unix is still in + progress. + +7/7/97 (new feature) The send command now works for Microsoft +Windows. It is implemented using Dynamic Data Exchange, and a new +command, dde, allows Tk to send more generic DDE commands to other +applications. (SRP) + +11/3/97 (new feature) Major overhaul of code that manages configuration +options to use Tcl_Obj structures instead of strings: + - There is a new set of procedures including Tk_CreateOptionTable, + Tk_InitOptions, and Tk_SetOptions, which replace Tk_ConfigureWidget + and related procedures. The old procedures are still available. + The new procedures use a new format for configuration tables. + See SetOptions.3 for more information. + - There are new procedures Tk_AllocColorFromObj, Tk_GetColorFromObj, + and Tk_FreeColorFromObj to manage colors using objects to hold the + name of the color and cache the corresponding XColor pointer. + There are similar procedures Tk_Alloc3DBorderFromObj, + Tk_AllocBitmapFromObj, Tk_AllocCursorFromObj, Tk_AllocFontFromObj, + and so on to manage borders, bitmaps, cursors, and fonts. + - The old-style procedures such as Tk_GetColor and Tk_GetBitmap no + longer take Tk_Uids for arguments; they just take strings. + - Menus, labels, buttons, checkbuttons, and radiobuttons have been + converted to use the new object-based configuration library. + (SRP & JO) + +11/7/97 (improvement) Changed code referring to "interp->result" to call +accessor functions like Tcl_SetResult(). + +12/23/97 (fix) Fixed transparency and web optimized the palette of +the images/ Tcl powered logos. (DL) + +12/16/97 (bug fix) Canvas and text "bind" subcommands generated an +error with no message if called to fetch a binding that didn't exist. +They now silently return without an error like the "bind" command. (SS) + +1/13/98 (bug fix) Keysyms for international characters were not being +reported properly under Windows. (SS) + +----------------- Released 8.1a1, 1/22/98 ----------------------- + +2/4/98 (bug fix) Calling XFreeFontNames() twice if couldn't allocate +font. (CCS) + +2/10/98 (bug fix) Inlined prolog.ps in tkCanvPs.c to make it accessible +from safe interpreters: canvas postscript now works in safe interps +(like in tk8.0plugin). (DL) + +2/11/98 (bug fix) Windows "send" to a remote interp wasn't propagating +$errorInfo correctly from the remote interp to the local invoking interp. +(CCS) + +2/11/98 (bug fix) Windows "send" should have accepted "--" to mean "no more +arguments". (CCS) + +2/11/98 (bug fix) Windows "send" was concatenating its arguments +incorrectly (not consistent with "eval", "uplevel", or Unix "send"). (CCS) + +2/18/98 (bug fix) Macintosh radiobuttons and checkbuttons now color +their backgrounds correctly under Appearance. The controls gadgets themselves +however, remain the Theme colors. (JI) + +2/18/98 (improvement) The corner pixels that peek through around the +rounded corners of the Mac button widget are now controlled by the +-highlightbackground, rather than the -background option. (JI) + +2/18/98 (improvement) Implemented the intra-application Send on the +Mac (RJ) + +2/18/98 (bug fix) Under X, a problem mapping from a fontStructPtr to an +XLFD (no XA_FONT attribute) would lead to dereferencing NULL. (CCS) + +----------------- Released 8.1a2, Feb 20 1998 ----------------------- + +10/21/98 (bug fix) Tk_UnderlineChars did not handle UTF strings properly +so underline indices were in bytes instead of characters. (stanton) + +11/19/98 (bug fix) Fixed menus and titles so they properly display +Unicode characters under Windows. [Bug: 819] (stanton) + +11/24/98 (bug fix) Fixed a bunch of memory leaks in the Windows menu +code. [Bug: 620] (stanton) + +11/25/98 (bug fix) Various small bug fixes: (stanton) + - hidemargin option was not honored properly in menus [Bug: 859] + - disabled menu entries were getting reenabled whenever the + mouse passed over the entry [Bug: 860] + - fixed deletion order bug where a crash would result if a + binding deleted "." + +11/30/98 (bug fix) The error result was getting lost when restoring +configuration options in buttons. [Bug: 619] (stanton) + +12/8/98 (bug fix) The Windows clipboard was not correctly traslating +multibyte characters. [Bug: 935] (stanton) + +----------------- Released 8.1b1, Dec 11 1998 ----------------------- + +1/29/99 (bug fix) Fixed bug in "grid forget" that failed to cancel +pending idle handlers, resulting in a crash in a few odd +cases. (stanton) + +2/4/99 (bug fix): Fixed uninitialized memory access in +Tk_SetAppName. [Bug: 919] (stanton) + +2/4/99 (bug fix): Added a workaround for a bug in GetTextExtentExPoint +on Win NT 4.0/Japanese. [Bug: 1006] (stanton) + +2/4/99 (bug fix): Changed so keyboard shortcuts for menus will only be +found in the current toplevel. Previously, they might be found in +menus attached to other toplevels that might not even be mapped. +[Bug: 924] (stanton) + +2/4/99 (bug fix): Changed to treat zero width lines in the canvas like +they have width 1 for purposes of selection. [Bug: 925] (stanton) + +2/4/99 (bug fix): TK_LD_SEARCH_FLAGS was set incorrectly if +SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through the C +compiler. Systems affected are Linux, MP-RAS and NEXTSTEP, but also +with gcc on many more systems. [Bug: 908] (stanton) + +2/4/99 (feature enhancement): Changed so windows that aren't resizable +don't have resize handles and the zoom box is disabled on +Windows. (stanton) + +2/4/99 (bug fix): Fixed so errors in console eval are reported +properly. Eliminated duplicate result messages. [Bug: 973] (stanton) + +2/4/99 (bug fix): Changed so focus window is always set if -force is +specified. This fixes the problem on Windows where Tk does not +activate the window if it already has focus. (stanton) + +2/4/99 (bug fix): If an image mask changed but ended up with the same +XID, the GC failed to be updated and so the new mask was not +used. [Bug: 970] (stanton) + +2/12/99 (new feature): Tk is now thread safe. You enable this by +configuring with --enable-threads. Tcl must also be compiled with +--enable-threads. See Tcl for more information about the threading +interfaces. (lfb) + +2/25/99 (bug fix) Under Windows, wish can now inherit pipe handles on +stdio so it is possible to use the wish executable in a command +pipeline to capture the output of puts or read from the pipe with +gets. (redman) + +3/1/99 (bug fix) Under Windows, Tk was not properly handling focus and +activation changes in some cases. (redman) + +3/10/99 (new feature) Tk now uses the new stub library feature in Tcl. +The Tk library now contains no direct references to any symbols in +Tcl. In addition, there is a new Tk_MainEx() function that takes an +interpreter as an argument. See the Tcl documentation for more +information about the stubs mechanism. (redman) + +3/14/99 (feature change) Test suite now uses "test" namespace to +define the test procedure and other auxiliary procedures as well as +global variables. + - Global array testConfige is now called ::test::testConfig. + - Global variable VERBOSE is now called ::test::verbose, and + ::test::verbose no longer works with numerical values. We've + switched to a bitwise character string. You can set + ::test::verbose by using the -verbose option on the Tk command + line. + - Global variable TESTS is now called ::test::matchingTests, and + can be set on the Tk command line via the -match option. + - There is now a ::test::skipTests variable (works similarly to + ::test::matchTests) that can be set on the Tk command line via + the -match option. + - The test suite can now be run in any working directory. When + you run "make test", the working directory is nolonger switched + to ../tests. +(hirschl) +*** POTENTIAL INCOMPATIBILITY *** + +----------------- Released 8.1b2, March 16, 1999 --------------------- + +3/23/99 (feature change) Test suite now uses "tcltest" namespace to +define the test procedure and other auxiliary procedures as well as +global variables. The previously chosen "test" namespace was thought +to be too generic and likely to create conflits. +(hirschl) +*** POTENTIAL INCOMPATIBILITY *** + +3/26/99 [bug fix] Fixed bug reported by Bryan Oakley in the +menubutton bindings. There was a false assumption that there was +always a menu attached to the button. [Bug 1116] (surles) + +3/26/99 (feature change) Removed --enable-tcl-stub from the configure +script. Linking Tk to Tcl stubs is causing too many problems when +linking executables like wish. Until the Tk is a fully loadable +extension, linking against the Tcl stubs is not supported in Tk. +(redman) + +3/26/99 (feature change) --nameble-shared is now the default and builds +Tk as a shared library; specify --disable-shared to build a static Tk +library and shell. +*** POTENTIAL INCOMPATIBILITY *** + +3/29/99 (api change) Standardized text layout and font interfaces +so they are consistent with respect to byte versus character +oriented indices. The layout functions all manipulate character +oriented values while the lower level measurement functions all +operate on byte oriented values. (stanton) + +4/1/99 (bug fix) Image handlers are finalized before the font subsystem +to fix crashes during finalization of complex widgets. (stanton) + +4/1/99 (feature change) Removed the send command on Windows. Moved +the DDE basis of that command out to its own extension. The send +implementation on top of DDE was causing Tk to lock up in some cases. +(redman) + +4/5/99 (bug fix) Fixed handling of Unicode in text searches. The +-count option was returning byte counts instead of character counts. + +4/5/99 (feature change) Cut and paste to an entry widget returns the +selection instead of the widget contents, which can be different if the +-show option is used to hide the display. (stanton) + +--------------- Released 8.1b3, April 6, 1999 ---------------------- + diff --git a/compat/stdlib.h b/compat/stdlib.h index 650750d..4b76fe5 100644 --- a/compat/stdlib.h +++ b/compat/stdlib.h @@ -9,12 +9,12 @@ * declare all the procedures needed here (such as strtod). * * Copyright (c) 1991 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. + * 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. * - * RCS: @(#) $Id: stdlib.h,v 1.2 1998/09/14 18:03:09 stanton Exp $ + * RCS: @(#) $Id: stdlib.h,v 1.3 1999/04/16 01:51:07 stanton Exp $ */ #ifndef _STDLIB diff --git a/doc/3DBorder.3 b/doc/3DBorder.3 index ea1a629..2780bde 100644 --- a/doc/3DBorder.3 +++ b/doc/3DBorder.3 @@ -1,24 +1,32 @@ '\" '\" Copyright (c) 1990-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: 3DBorder.3,v 1.2 1998/09/14 18:22:45 stanton Exp $ +'\" RCS: @(#) $Id: 3DBorder.3,v 1.3 1999/04/16 01:51:07 stanton Exp $ '\" .so man.macros -.TH Tk_Get3DBorder 3 4.0 Tk "Tk Library Procedures" +.TH Tk_Alloc3DBorderFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_Get3DBorder, Tk_Draw3DRectangle, Tk_Fill3DRectangle, Tk_Draw3DPolygon, Tk_Fill3DPolygon, Tk_3DVerticalBevel, Tk_3DHorizontalBevel, Tk_SetBackgroundFromBorder, Tk_NameOf3DBorder, Tk_3DBorderColor, Tk_3DBorderGC, Tk_Free3DBorder \- draw borders with three-dimensional appearance +Tk_Alloc3DBorderFromObj, Tk_Get3DBorder, Tk_Get3DBorderFromObj, Tk_Draw3DRectangle, Tk_Fill3DRectangle, Tk_Draw3DPolygon, Tk_Fill3DPolygon, Tk_3DVerticalBevel, Tk_3DHorizontalBevel, Tk_SetBackgroundFromBorder, Tk_NameOf3DBorder, Tk_3DBorderColor, Tk_3DBorderGC, Tk_Free3DBorderFromObj, Tk_Free3DBorder \- draw borders with three-dimensional appearance .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp +.VS 8.1 +Tk_3DBorder +\fBTk_Alloc3DBorderFromObj(\fIinterp, tkwin, objPtr\fB)\fR +.sp Tk_3DBorder \fBTk_Get3DBorder(\fIinterp, tkwin, colorName\fB)\fR .sp +Tk_3DBorder +\fBTk_Get3DBorderFromObj(\fItkwin, objPtr\fB)\fR +.VE +.sp void \fBTk_Draw3DRectangle(\fItkwin, drawable, border, x, y, width, height, borderWidth, relief\fB)\fR .sp @@ -49,6 +57,10 @@ XColor * GC * \fBTk_3DBorderGC(\fItkwin, border, which\fB)\fR .sp +.VS 8.1 +\fBTk_Free3DBorderFromObj(\fItkwin, objPtr\fB)\fR +.VE +.sp \fBTk_Free3DBorder(\fIborder\fB)\fR .SH ARGUMENTS .AS "Tk_3DBorder" borderWidth @@ -57,10 +69,15 @@ Interpreter to use for error reporting. .AP Tk_Window tkwin in Token for window (for all procedures except \fBTk_Get3DBorder\fR, must be the window for which the border was allocated). -.AP Tk_Uid colorName in -Textual description of color corresponding to background (flat areas). -Illuminated edges will be brighter than this and shadowed edges will -be darker than this. +.AP Tcl_Obj *objPtr in +.VS 8.1 +Pointer to object 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. +.VE .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 @@ -129,22 +146,42 @@ Must be TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or TK_3D_DARK_GC. .SH DESCRIPTION .PP These procedures provide facilities for drawing window borders in a -way that produces a three-dimensional appearance. \fBTk_Get3DBorder\fR +way that produces a three-dimensional appearance. +.VS 8.1 +\fBTk_Alloc3DBorderFromObj\fR allocates colors and Pixmaps needed to draw a border in the window -given by the \fItkwin\fR argument. The \fIcolorName\fR -argument indicates what colors should be used in the border. -\fIColorName\fR may be any value acceptable to \fBTk_GetColor\fR. -The color indicated by \fIcolorName\fR will not actually be used in +given by the \fItkwin\fR argument. The value of \fIobjPtr\fR +is a standard Tk color name that determines the border colors. +The color indicated by \fIobjPtr\fR will not actually be used in the border; it indicates the background color for the window (i.e. a color for flat surfaces). The illuminated portions of the border will appear brighter than indicated -by \fIcolorName\fR, and the shadowed portions of the border will appear -darker than \fIcolorName\fR. +by \fIobjPtr\fR, and the shadowed portions of the border will appear +darker than \fIobjPtr\fR. .PP -\fBTk_Get3DBorder\fR returns a token that may be used in later calls +\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. \fIcolorName\fR isn't a legal color specifier), +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. +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 +prevents \fBTk_Get3DBorder\fR from caching the return value, so +\fBTk_Get3DBorder\fR is less efficient than \fBTk_Alloc3DBorderFromObj\fR. +.PP +\fBTk_Get3DBorderFromObj\fR returns the token for an existing border, given +the window and color name used to create the border. +\fBTk_Get3DBorderFromObj\fR doesn't actually create the border; it must +already have been created with a previous call to +\fBTk_Alloc3DBorderFromObj\fR or \fBTk_Get3DBorder\fR. The return +value is cached in \fIobjPtr\fR, which speeds up +future calls to \fBTk_Get3DBorderFromObj\fR with the same \fIobjPtr\fR +and \fItkwin\fR. +.VE .PP Once a border structure has been created, \fBTk_Draw3DRectangle\fR may be invoked to draw the border. @@ -171,7 +208,7 @@ a groove or ridge around the exterior of the rectangle. \fBTk_Fill3DRectangle\fR is somewhat like \fBTk_Draw3DRectangle\fR except that it first fills the rectangular area with the background color (one corresponding -to the \fIcolorName\fR used to create \fIborder\fR). Then it calls +to the color used to create \fIborder\fR). Then it calls \fBTk_Draw3DRectangle\fR to draw a border just inside the outer edge of the rectangular area. The argument \fIrelief\fR indicates the desired effect (TK_RELIEF_FLAT means no border should be drawn; all that @@ -228,21 +265,19 @@ bottom bevel should be drawn with 0 for both arguments. The procedure \fBTk_SetBackgroundFromBorder\fR will modify the background pixel and/or pixmap of \fItkwin\fR to produce a result compatible with \fIborder\fR. For color displays, the resulting background will -just be the color given by the \fIcolorName\fR argument passed to -\fBTk_Get3DBorder\fR when \fIborder\fR was created; for monochrome +just be the color specified when \fIborder\fR was created; for monochrome displays, the resulting background will be a light stipple pattern, in order to distinguish the background from the illuminated portion of the border. .PP Given a token for a border, the procedure \fBTk_NameOf3DBorder\fR -will return the \fIcolorName\fR string that was passed to -\fBTk_Get3DBorder\fR to create the border. +will return the color name that was used to create the border. .PP The procedure \fBTk_3DBorderColor\fR returns the XColor structure that will be used for flat surfaces drawn for its \fIborder\fR argument by procedures like \fBTk_Fill3DRectangle\fR. -The return value corresponds to the \fIcolorName\fR passed to -\fBTk_Get3DBorder\fR. +The return value corresponds to the color name that was used to +create the border. The XColor, and its associated pixel value, will remain allocated as long as \fIborder\fR exists. .PP @@ -253,10 +288,18 @@ TK_3D_FLAT_GC returns the context used for flat surfaces, TK_3D_LIGHT_GC returns the context for light shadows, and TK_3D_DARK_GC returns the context for dark shadows. .PP -When a border is no longer needed, \fBTk_Free3DBorder\fR should -be called to release the resources associated with the border. -There should be exactly one call to \fBTk_Free3DBorder\fR for -each call to \fBTk_Get3DBorder\fR. +.VS 8.1 +When a border is no longer needed, \fBTk_Free3DBorderFromObj\fR +or \fBTk_Free3DBorder\fR should +be called to release the resources associated with it. +For \fBTk_Free3DBorderFromObj\fR the border to release is specified +with the window and color name used to create the +border; for \fBTk_Free3DBorder\fR the border to release is specified +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. +.VE .SH KEYWORDS -3D, background, border, color, depressed, illumination, polygon, raised, shadow, three-dimensional effect +3D, background, border, color, depressed, illumination, object, polygon, raised, shadow, three-dimensional effect diff --git a/doc/ConfigWidg.3 b/doc/ConfigWidg.3 index 04daead..0b8b91b 100644 --- a/doc/ConfigWidg.3 +++ b/doc/ConfigWidg.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ConfigWidg.3,v 1.2 1998/09/14 18:22:46 stanton Exp $ +'\" RCS: @(#) $Id: ConfigWidg.3,v 1.3 1999/04/16 01:51:07 stanton Exp $ '\" .so man.macros .TH Tk_ConfigureWidget 3 4.1 Tk "Tk Library Procedures" @@ -26,10 +26,11 @@ int \fBTk_ConfigureInfo(\fIinterp, tkwin, specs, widgRec, argvName, flags\fB)\fR .sp int +\fBTk_ConfigureValue(\fIinterp, tkwin, specs, widgRec, argvName, flags\fB)\fR .sp \fBTk_FreeOptions(\fIspecs, widgRec, display, flags\fB)\fR .SH ARGUMENTS -.AS Tk_ConfigSpec *widgRec +.AS Tk_ConfigSpec *widgRec in/out .AP Tcl_Interp *interp in Interpreter to use for returning error messages. .AP Tk_Window tkwin in diff --git a/doc/GetAnchor.3 b/doc/GetAnchor.3 index 5342ea5..b12d48f 100644 --- a/doc/GetAnchor.3 +++ b/doc/GetAnchor.3 @@ -1,21 +1,26 @@ '\" '\" Copyright (c) 1990 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: GetAnchor.3,v 1.2 1998/09/14 18:22:48 stanton Exp $ +'\" RCS: @(#) $Id: GetAnchor.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetAnchor 3 "" Tk "Tk Library Procedures" +.TH Tk_GetAnchorFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetAnchor, Tk_NameOfAnchor \- translate between strings and anchor positions +Tk_GetAnchorFromObj, Tk_GetAnchor, Tk_NameOfAnchor \- translate between strings and anchor positions .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp +.VS 8.1 +int +\fBTk_GetAnchorFromObj(\fIinterp, objPtr, anchorPtr\fB)\fR +.VE +.sp int \fBTk_GetAnchor(\fIinterp, string, anchorPtr\fB)\fR .sp @@ -24,35 +29,52 @@ char * .SH ARGUMENTS .AS "Tk_Anchor" *anchorPtr .AP Tcl_Interp *interp in -Interpreter to use for error reporting. +Interpreter to use for error reporting, or NULL. +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +String value contains name of anchor point: \fBn\fR, \fBne\fR, +\fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR; +internal rep will be modified to cache corresponding Tk_Anchor. .AP char *string in -String containing name of anchor point: one of ``n'', ``ne'', ``e'', ``se'', -``s'', ``sw'', ``w'', ``nw'', or ``center''. +Same as \fIobjPtr\fR except description of anchor point is passed as +a string. +.VE .AP int *anchorPtr out Pointer to location in which to store anchor position corresponding to -\fIstring\fR. +\fIobjPtr\fR or \fIstring\fR. .AP Tk_Anchor anchor in Anchor position, e.g. \fBTCL_ANCHOR_CENTER\fR. .BE .SH DESCRIPTION .PP -\fBTk_GetAnchor\fR places in \fI*anchorPtr\fR an anchor position +.VS 8.1 +\fBTk_GetAnchorFromObj\fR places in \fI*anchorPtr\fR an anchor position (enumerated type \fBTk_Anchor\fR) -corresponding to \fIstring\fR, which will be one of +corresponding to \fIobjPtr\fR's value. The result will be one of \fBTK_ANCHOR_N\fR, \fBTK_ANCHOR_NE\fR, \fBTK_ANCHOR_E\fR, \fBTK_ANCHOR_SE\fR, \fBTK_ANCHOR_S\fR, \fBTK_ANCHOR_SW\fR, \fBTK_ANCHOR_W\fR, \fBTK_ANCHOR_NW\fR, or \fBTK_ANCHOR_CENTER\fR. Anchor positions are typically used for indicating a point on an object -that will be used to position that object, e.g. \fBTK_ANCHOR_N\fR means +that will be used to position the object, e.g. \fBTK_ANCHOR_N\fR means position the top center point of the object at a particular place. .PP Under normal circumstances the return value is \fBTCL_OK\fR and \fIinterp\fR is unused. If \fIstring\fR doesn't contain a valid anchor position -or an abbreviation of one of these names, then an error message is -stored in \fIinterp->result\fR, \fBTCL_ERROR\fR is returned, and -\fI*anchorPtr\fR is unmodified. +or an abbreviation of one of these names, \fBTCL_ERROR\fR is returned, +\fI*anchorPtr\fR is unmodified, and an error message is +stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL. +\fBTk_GetAnchorFromObj\fR caches information about the return +value in \fIobjPtr\fR, which speeds up future calls to +\fBTk_GetAnchorFromObj\fR with the same \fIobjPtr\fR. +.PP +\fBTk_GetAnchor\fR is identical to \fBTk_GetAnchorFromObj\fR except +that the description of the anchor is specified with a string instead +of an object. This prevents \fBTk_GetAnchor\fR from caching the +return value, so \fBTk_GetAnchor\fR is less efficient than +\fBTk_GetAnchorFromObj\fR. +.VE .PP \fBTk_NameOfAnchor\fR is the logical inverse of \fBTk_GetAnchor\fR. Given an anchor position such as \fBTK_ANCHOR_N\fR it returns a diff --git a/doc/GetBitmap.3 b/doc/GetBitmap.3 index 4321cce..28b5cb1 100644 --- a/doc/GetBitmap.3 +++ b/doc/GetBitmap.3 @@ -1,42 +1,61 @@ '\" '\" Copyright (c) 1990 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: GetBitmap.3,v 1.2 1998/09/14 18:22:48 stanton Exp $ +'\" RCS: @(#) $Id: GetBitmap.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetBitmap 3 8.0 Tk "Tk Library Procedures" +.TH Tk_AllocBitmapFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetBitmap, Tk_DefineBitmap, Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeBitmap, Tk_GetBitmapFromData \- maintain database of single-plane pixmaps +Tk_AllocBitmapFromObj, Tk_GetBitmap, Tk_GetBitmapFromObj, Tk_DefineBitmap, Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeBitmapFromObj, Tk_FreeBitmap, Tk_GetBitmapFromData \- maintain database of single-plane pixmaps .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp +.VS 8.1 Pixmap -\fBTk_GetBitmap(\fIinterp, tkwin, id\fB)\fR +\fBTk_GetBitmapFromObj(\fIinterp, tkwin, objPtr\fB)\fR +.sp +Pixmap +\fBTk_GetBitmap(\fIinterp, tkwin, info\fB)\fR +.sp +Pixmap +\fBTk_GetBitmapFromObj(\fItkwin, objPtr\fB)\fR +.VE .sp int -\fBTk_DefineBitmap(\fIinterp, nameId, source, width, height\fB)\fR +\fBTk_DefineBitmap(\fIinterp, name, source, width, height\fB)\fR .sp -Tk_Uid +char * \fBTk_NameOfBitmap(\fIdisplay, bitmap\fB)\fR .sp \fBTk_SizeOfBitmap(\fIdisplay, bitmap, widthPtr, heightPtr\fB)\fR .sp +.VS 8.1 +\fBTk_FreeBitmapFromObj(\fItkwin, objPtr\fB)\fR +.VE +.sp \fBTk_FreeBitmap(\fIdisplay, bitmap\fB)\fR .SH ARGUMENTS .AS "unsigned long" *pixelPtr .AP Tcl_Interp *interp in -Interpreter to use for error reporting. +Interpreter to use for error reporting; if NULL then no error message +is left after errors. .AP Tk_Window tkwin in Token for window in which the bitmap will be used. -.AP Tk_Uid id in -Description of bitmap; see below for possible values. -.AP Tk_Uid nameId in +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +String value describes desired bitmap; internal rep will be +modified to cache pointer to corresponding Pixmap. +.AP "CONST char" *info in +Same as \fIobjPtr\fR except description of bitmap is passed as a string and +resulting Pixmap isn't cached. +.VE +.AP "CONST char" *name in Name for new bitmap to be defined. .AP char *source in Data for bitmap, in standard bitmap format. @@ -52,7 +71,8 @@ Pointer to word to fill in with \fIbitmap\fR's height. .AP Display *display in Display for which \fIbitmap\fR was allocated. .AP Pixmap bitmap in -Identifier for a bitmap allocated by \fBTk_GetBitmap\fR. +Identifier for a bitmap allocated by \fBTk_AllocBitmapFromObj\fR or +\fBTk_GetBitmap\fR. .BE .SH DESCRIPTION @@ -62,11 +82,13 @@ being used by an application. The procedures allow bitmaps to be re-used efficiently, thereby avoiding server overhead, and also allow bitmaps to be named with character strings. .PP -\fBTk_GetBitmap\fR takes as argument a Tk_Uid describing a bitmap. -It returns a Pixmap identifier for a bitmap corresponding to the -description. It re-uses an existing bitmap, if possible, and -creates a new one otherwise. At present, \fIid\fR must have -one of the following forms: +.VS 8.1 +\fBTk_AllocBitmapFromObj\fR returns a Pixmap identifier for a bitmap +that matches the description in \fIobjPtr\fR and is suitable for use +in \fItkwin\fR. It re-uses an existing bitmap, if possible, and +creates a new one otherwise. \fIObjPtr\fR's value must have one +of the following forms: +.VE .TP 20 \fB@\fIfileName\fR \fIFileName\fR must be the name of a file containing a bitmap @@ -166,15 +188,35 @@ A face with ballon words. A triangle with an exclamation point. .RE .LP -Under normal conditions, \fBTk_GetBitmap\fR +.VS 8.1 +Under normal conditions, \fBTk_AllocBitmapFromObj\fR returns an identifier for the requested bitmap. If an error -occurs in creating the bitmap, such as when \fIid\fR refers +occurs in creating the bitmap, such as when \fIobjPtr\fR refers to a non-existent file, then \fBNone\fR is returned and an error -message is left in \fIinterp->result\fR. +message is left in \fIinterp\fR's result if \fIinterp\fR isn't +NULL. \fBTk_AllocBitmapFromObj\fR caches information about the return +value in \fIobjPtr\fR, which speeds up future calls to procedures +such as \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmapFromObj\fR. +.PP +\fBTk_GetBitmap\fR is identical to \fBTk_AllocBitmapFromObj\fR except +that the description of the bitmap is specified with a string instead +of an object. This prevents \fBTk_GetBitmap\fR from caching the +return value, so \fBTk_GetBitmap\fR is less efficient than +\fBTk_AllocBitmapFromObj\fR. +.PP +\fBTk_GetBitmapFromObj\fR returns the token for an existing bitmap, given +the window and description used to create the bitmap. +\fBTk_GetBitmapFromObj\fR doesn't actually create the bitmap; the bitmap +must already have been created with a previous call to +\fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR. The return +value is cached in \fIobjPtr\fR, which speeds up +future calls to \fBTk_GetBitmapFromObj\fR with the same \fIobjPtr\fR +and \fItkwin\fR. +.VE .PP \fBTk_DefineBitmap\fR associates a name with in-memory bitmap data so that the name can be used in later -calls to \fBTk_GetBitmap\fR. The \fInameId\fR +calls to \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR. The \fInameId\fR argument gives a name for the bitmap; it must not previously have been used in a call to \fBTk_DefineBitmap\fR. The arguments \fIsource\fR, \fIwidth\fR, and \fIheight\fR @@ -186,7 +228,8 @@ TCL_ERROR is returned and an error message is left in Note: \fBTk_DefineBitmap\fR expects the memory pointed to by \fIsource\fR to be static: \fBTk_DefineBitmap\fR doesn't make a private copy of this memory, but uses the bytes pointed to -by \fIsource\fR later in calls to \fBTk_GetBitmap\fR. +by \fIsource\fR later in calls to \fBTk_AllocBitmapFromObj\fR or +\fBTk_GetBitmap\fR. .PP Typically \fBTk_DefineBitmap\fR is used by \fB#include\fR-ing a bitmap file directly into a C program and then referencing @@ -196,36 +239,40 @@ which was created by the \fBbitmap\fR program and contains a stipple pattern. The following code uses \fBTk_DefineBitmap\fR to define a new bitmap named \fBfoo\fR: +.VS .CS Pixmap bitmap; #include "stip.bitmap" -Tk_DefineBitmap(interp, Tk_GetUid("foo"), stip_bits, +Tk_DefineBitmap(interp, "foo", stip_bits, stip_width, stip_height); \&... -bitmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid("foo")); +bitmap = Tk_GetBitmap(interp, tkwin, "foo"); .CE +.VE This code causes the bitmap file to be read at compile-time and incorporates the bitmap information into the program's executable image. The same bitmap file could be read at run-time using \fBTk_GetBitmap\fR: +.VS .CS Pixmap bitmap; -bitmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid("@stip.bitmap")); +bitmap = Tk_GetBitmap(interp, tkwin, "@stip.bitmap"); .CE +.VE The second form is a bit more flexible (the file could be modified after the program has been compiled, or a different string could be provided to read a different file), but it is a little slower and requires the bitmap file to exist separately from the program. .PP -\fBTk_GetBitmap\fR maintains a -database of all the bitmaps that are currently in use. +Tk maintains a database of all the bitmaps that are currently in use. Whenever possible, it will return an existing bitmap rather than creating a new one. +When a bitmap is no longer used, Tk will release it automatically. This approach can substantially reduce server overhead, so -\fBTk_GetBitmap\fR should generally be used in preference to Xlib -procedures like \fBXReadBitmapFile\fR. +\fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR should generally +be used in preference to Xlib procedures like \fBXReadBitmapFile\fR. .PP -The bitmaps returned by \fBTk_GetBitmap\fR +The bitmaps returned by \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR are shared, so callers should never modify them. If a bitmap must be modified dynamically, then it should be created by calling Xlib procedures such as \fBXReadBitmapFile\fR @@ -233,28 +280,33 @@ or \fBXCreatePixmap\fR directly. .PP The procedure \fBTk_NameOfBitmap\fR is roughly the inverse of \fBTk_GetBitmap\fR. -Given an X Pixmap argument, it returns the \fIid\fR that was +Given an X Pixmap argument, it returns the textual description that was passed to \fBTk_GetBitmap\fR when the bitmap was created. \fIBitmap\fR must have been the return value from a previous -call to \fBTk_GetBitmap\fR. +call to \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR. .PP \fBTk_SizeOfBitmap\fR returns the dimensions of its \fIbitmap\fR argument in the words pointed to by the \fIwidthPtr\fR and \fIheightPtr\fR arguments. As with \fBTk_NameOfBitmap\fR, -\fIbitmap\fR must have been created by \fBTk_GetBitmap\fR. +\fIbitmap\fR must have been created by \fBTk_AllocBitmapFromObj\fR or +\fBTk_GetBitmap\fR. .PP -When a bitmap returned by \fBTk_GetBitmap\fR -is no longer needed, \fBTk_FreeBitmap\fR should be called to release it. -There should be exactly one call to \fBTk_FreeBitmap\fR for -each call to \fBTk_GetBitmap\fR. -When a bitmap is no longer in use anywhere (i.e. it has been freed as -many times as it has been gotten) \fBTk_FreeBitmap\fR will release -it to the X server and delete it from the database. +.VS 8.1 +When a bitmap is no longer needed, \fBTk_FreeBitmapFromObj\fR or +\fBTk_FreeBitmap\fR should be called to release it. +For \fBTk_FreeBitmapFromObj\fR the bitmap to release is specified +with the same information used to create it; for +\fBTk_FreeBitmap\fR the bitmap to release is specified +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. +.VE .SH BUGS In determining whether an existing bitmap can be used to satisfy -a new request, \fBTk_GetBitmap\fR -considers only the immediate value of its \fIid\fR argument. For +a new request, \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR +consider only the immediate value of the string description. For example, when a file name is passed to \fBTk_GetBitmap\fR, \fBTk_GetBitmap\fR will assume it is safe to re-use an existing bitmap created from the same file name: it will not check to diff --git a/doc/GetColor.3 b/doc/GetColor.3 index 4b551f2..d5abc78 100644 --- a/doc/GetColor.3 +++ b/doc/GetColor.3 @@ -1,32 +1,44 @@ '\" -'\" Copyright (c) 1990, 1991 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" Copyright (c) 1990-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. '\" -'\" RCS: @(#) $Id: GetColor.3,v 1.2 1998/09/14 18:22:48 stanton Exp $ +'\" RCS: @(#) $Id: GetColor.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetColor 3 4.0 Tk "Tk Library Procedures" +.TH Tk_AllocColorFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetColor, Tk_GetColorByValue, Tk_NameOfColor, Tk_FreeColor \- maintain database of colors +Tk_AllocColorFromObj, Tk_GetColor, Tk_GetColorFromObj, Tk_GetColorByValue, Tk_NameOfColor, Tk_FreeColorFromObj, Tk_FreeColor \- maintain database of colors .SH SYNOPSIS .nf \fB#include <tk.h>\fR +.VS 8.1 .sp XColor * -\fBTk_GetColor\fR(\fIinterp, tkwin, nameId\fB)\fR +\fBTk_AllocColorFromObj(\fIinterp, tkwin, objPtr\fB)\fR .sp XColor * -\fBTk_GetColorByValue\fR(\fItkwin, prefPtr\fB)\fR +\fBTk_GetColor(\fIinterp, tkwin, name\fB)\fR +.sp +XColor * +\fBTk_GetColorFromObj(\fItkwin, objPtr\fB)\fR +.VE +.sp +XColor * +\fBTk_GetColorByValue(\fItkwin, prefPtr\fB)\fR .sp char * \fBTk_NameOfColor(\fIcolorPtr\fB)\fR .sp GC -\fBTk_GCForColor\fR(\fIcolorPtr, drawable\fR) +\fBTk_GCForColor(\fIcolorPtr, drawable\fB)\fR +.sp +.VS 8.1 +\fBTk_FreeColorFromObj(\fItkwin, objPtr\fB)\fR +.VE .sp \fBTk_FreeColor(\fIcolorPtr\fB)\fR .SH ARGUMENTS @@ -35,27 +47,39 @@ GC Interpreter to use for error reporting. .AP Tk_Window tkwin in Token for window in which color will be used. -.AP Tk_Uid nameId in -Textual description of desired color. +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +String value describes desired color; internal rep will be +modified to cache pointer to corresponding (XColor *). +.AP char *name in +Same as \fIobjPtr\fR except description of color is passed as a string and +resulting (XColor *) isn't cached. +.VE .AP XColor *prefPtr in Indicates red, green, and blue intensities of desired color. .AP XColor *colorPtr in Pointer to X color information. Must have been allocated by previous -call to \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR, except when passed -to \fBTk_NameOfColor\fR. +call to \fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR or +\fBTk_GetColorByValue\fR, except when passed to \fBTk_NameOfColor\fR. .AP Drawable drawable in 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 +.VS 8.1 +.PP +These procedures manage the colors being used by a Tk application. +They allow colors to be shared whenever possible, so that colormap +space is preserved, and they pick closest available colors when +colormap space is exhausted. .PP -The \fBTk_GetColor\fR and \fBTk_GetColorByValue\fR procedures -locate pixel values that may be used to render particular -colors in the window given by \fItkwin\fR. In \fBTk_GetColor\fR -the desired color is specified with a Tk_Uid (\fInameId\fR), which -may have any of the following forms: +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: +.VE .TP 20 \fIcolorname\fR Any of the valid textual names for a color defined in the @@ -76,38 +100,56 @@ When fewer than 16 bits are provided for each color, they represent the most significant bits of the color. For example, #3a7 is the same as #3000a0007000. .PP -In \fBTk_GetColorByValue\fR, the desired color is indicated with -the \fIred\fR, \fIgreen\fR, and \fIblue\fR fields of the structure -pointed to by \fIcolorPtr\fR. -.PP -If \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR is successful -in allocating the desired color, then it returns a pointer to +.VS 8.1 +\fBTk_AllocColorFromObj\fR returns a pointer to an XColor structure; the structure indicates the exact intensities of the allocated color (which may differ slightly from those requested, depending on the limitations of the screen) and a pixel value -that may be used to draw in the color. -If the colormap for \fItkwin\fR is full, \fBTk_GetColor\fR -and \fBTk_GetColorByValue\fR will use the closest existing color -in the colormap. -If \fBTk_GetColor\fR encounters an error while allocating -the color (such as an unknown color name) then NULL is returned and -an error message is stored in \fIinterp->result\fR; -\fBTk_GetColorByValue\fR never returns an error. +that may be used to draw with the color in \fItkwin\fR. +If an error occurs in \fBTk_AllocColorFromObj\fR (such as an unknown +color name) then NULL is returned and an error message is stored in +\fIinterp\fR's result if \fIinterp\fR isn't NULL. +If the colormap for \fItkwin\fR is full, \fBTk_AllocColorFromObj\fR +will use the closest existing color in the colormap. +\fBTk_AllocColorFromObj\fR caches information about +the return value in \fIobjPtr\fR, which speeds up future calls to procedures +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 +return value, so \fBTk_GetColor\fR is less efficient than +\fBTk_AllocColorFromObj\fR. +.PP +\fBTk_GetColorFromObj\fR returns the token for an existing color, given +the window and description used to create the color. +\fBTk_GetColorFromObj\fR doesn't actually create the color; the color +must already have been created with a previous call to +\fBTk_AllocColorFromObj\fR or \fBTk_GetColor\fR. The return +value is cached in \fIobjPtr\fR, which speeds up +future calls to \fBTk_GetColorFromObj\fR with the same \fIobjPtr\fR +and \fItkwin\fR. +.VE .PP -\fBTk_GetColor\fR and \fBTk_GetColorByValue\fR maintain a database +\fBTk_GetColorByValue\fR is similar to \fBTk_GetColor\fR except that +the desired color is indicated with the \fIred\fR, \fIgreen\fR, and +\fIblue\fR fields of the structure pointed to by \fIcolorPtr\fR. +.PP +This package maintains a database of all the colors currently in use. -If the same \fInameId\fR is requested multiple times from -\fBTk_GetColor\fR (e.g. by different windows), or if the +If the same color is requested multiple times from +\fBTk_GetColor\fR or \fBTk_AllocColorFromObj\fR (e.g. by different +windows), or if the same intensities are requested multiple times from \fBTk_GetColorByValue\fR, then existing pixel values will be re-used. Re-using an existing pixel avoids any interaction -with the X server, which makes the allocation much more -efficient. For this reason, you should generally use -\fBTk_GetColor\fR or \fBTk_GetColorByValue\fR -instead of Xlib procedures like \fBXAllocColor\fR, -\fBXAllocNamedColor\fR, or \fBXParseColor\fR. +with the window server, which makes the allocation much more +efficient. These procedures also provide a portable interface that +works across all platforms. For this reason, you should generally use +\fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR, or \fBTk_GetColorByValue\fR +instead of lower level procedures like \fBXAllocColor\fR. .PP -Since different calls to \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR +Since different calls to this package may return the same shared pixel value, callers should never change the color of a pixel returned by the procedures. @@ -116,15 +158,16 @@ If you need to change a color value dynamically, you should use .PP The procedure \fBTk_NameOfColor\fR is roughly the inverse of \fBTk_GetColor\fR. If its \fIcolorPtr\fR argument was created -by \fBTk_GetColor\fR, then the return value is the \fInameId\fR -string that was passed to \fBTk_GetColor\fR to create the +by \fBTk_AllocColorFromObj\fR or \fBTk_GetColor\fR then the return value +is the string that was used to create the color. If \fIcolorPtr\fR was created by a call to \fBTk_GetColorByValue\fR, or by any other mechanism, then the return value is a string that could be passed to \fBTk_GetColor\fR to return the same color. Note: the string returned by \fBTk_NameOfColor\fR is -only guaranteed to persist until the next call to \fBTk_NameOfColor\fR. +only guaranteed to persist until the next call to +\fBTk_NameOfColor\fR. .PP -\fBTk_GCForColor\fR returns a graphics context whose \fBForeground\fR +\fBTk_GCForColor\fR returns a graphics context whose \fBforeground\fR field is the pixel allocated for \fIcolorPtr\fR and whose other fields all have default values. This provides an easy way to do basic drawing with a color. @@ -132,15 +175,16 @@ The graphics context is cached with the color and will exist only as long as \fIcolorPtr\fR exists; it is freed when the last reference to \fIcolorPtr\fR is freed by calling \fBTk_FreeColor\fR. .PP -When a pixel value returned by \fBTk_GetColor\fR or -\fBTk_GetColorByValue\fR is no longer -needed, \fBTk_FreeColor\fR should be called to release the color. -There should be exactly one call to \fBTk_FreeColor\fR for -each call to \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR. -When a pixel value is no longer in -use anywhere (i.e. it has been freed as many times as it has been gotten) -\fBTk_FreeColor\fR will release it to the X server and delete it from -the database. - +.VS 8.1 +When a color is no longer needed \fBTk_FreeColorFromObj\fR or +\fBTk_FreeColor\fR should be called to release it. +For \fBTk_FreeColorFromObj\fR the color to release is specified +with the same information used to create it; for +\fBTk_FreeColor\fR the color to release is specified +with a pointer to its XColor structure. +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. +.VE .SH KEYWORDS -color, intensity, pixel value +color, intensity, object, pixel value diff --git a/doc/GetCursor.3 b/doc/GetCursor.3 index dca27ad..55b9c58 100644 --- a/doc/GetCursor.3 +++ b/doc/GetCursor.3 @@ -1,23 +1,31 @@ '\" '\" Copyright (c) 1990 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: GetCursor.3,v 1.2 1998/09/14 18:22:49 stanton Exp $ +'\" RCS: @(#) $Id: GetCursor.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetCursor 3 4.1 Tk "Tk Library Procedures" +.TH Tk_AllocCursorFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetCursor, Tk_GetCursorFromData, Tk_NameOfCursor, Tk_FreeCursor \- maintain database of cursors +Tk_AllocCursorFromObj, Tk_GetCursor, Tk_GetCursorFromObj, Tk_GetCursorFromData, Tk_NameOfCursor, Tk_FreeCursorFromObj, Tk_FreeCursor \- maintain database of cursors .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp +.VS 8.1 Tk_Cursor -\fBTk_GetCursor(\fIinterp, tkwin, nameId\fB)\fR +\fBTk_AllocCursorFromObj(\fIinterp, tkwin, objPtr\fB)\fR +.sp +Tk_Cursor +\fBTk_GetCursor(\fIinterp, tkwin, name\fB)\fR +.sp +Tk_Cursor +\fBTk_GetCursorFromObj(\fItkwin, objPtr\fB)\fR +.VE .sp Tk_Cursor \fBTk_GetCursorFromData(\fIinterp, tkwin, source, mask, width, height, xHot, yHot, fg, bg\fB)\fR @@ -25,6 +33,10 @@ Tk_Cursor char * \fBTk_NameOfCursor(\fIdisplay, cursor\fB)\fR .sp +.VS 8.1 +\fBTk_FreeCursorFromObj(\fItkwin, objPtr\fB)\fR +.VE +.sp \fBTk_FreeCursor(\fIdisplay, cursor\fB)\fR .SH ARGUMENTS .AS "unsigned long" *pixelPtr @@ -32,12 +44,18 @@ char * Interpreter to use for error reporting. .AP Tk_Window tkwin in Token for window in which the cursor will be used. -.AP Tk_Uid nameId in -Description of cursor; see below for possible values. +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +Description of cursor; see below for possible values. Internal rep will be +modified to cache pointer to corresponding Tk_Cursor. +.AP char *name in +Same as \fIobjPtr\fR except description of cursor is passed as a string and +resulting Tk_Cursor isn't cached. +.VE .AP char *source in -Data for cursor bitmap, in standard bitmap format. +Data for cursor cursor, in standard cursor format. .AP char *mask in -Data for mask bitmap, in standard bitmap format. +Data for mask cursor, in standard cursor format. .AP "int" width in Width of \fIsource\fR and \fImask\fR. .AP "int" height in @@ -53,7 +71,7 @@ Textual description of background color for cursor. .AP Display *display in Display for which \fIcursor\fR was allocated. .AP Tk_Cursor cursor in -Opaque Tk identifier for cursor. If passed to\fBTk_FreeCursor\fR, must +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 @@ -63,18 +81,25 @@ have been returned by some previous call to \fBTk_GetCursor\fR or These procedures manage a collection of cursors being used by an application. The procedures allow cursors to be re-used efficiently, thereby avoiding server overhead, and also -allow cursors to be named with character strings (actually Tk_Uids). +allow cursors to be named with character strings. .PP -\fBTk_GetCursor\fR takes as argument a Tk_Uid describing a cursor, -and returns an opaque Tk identifier for a cursor corresponding to the -description. -It re-uses an existing cursor if possible and -creates a new one otherwise. \fINameId\fR must be a standard Tcl +.VS 8.1 +\fBTk_AllocCursorFromObj\fR takes as argument an object describing a +cursor, and returns an opaque Tk identifier for a cursor corresponding +to the description. It re-uses an existing cursor if possible and +creates a new one otherwise. \fBTk_AllocCursorFromObj\fR caches +information about the return value in \fIobjPtr\fR, which speeds up +future calls to procedures such as \fBTk_AllocCursorFromObj\fR and +\fBTk_GetCursorFromObj\fR. If an error occurs in creating the cursor, +such as when \fIobjPtr\fR refers to a non-existent file, then \fBNone\fR +is returned and an error message will be stored in \fIinterp\fR's result +if \fIinterp\fR isn't NULL. \fIObjPtr\fR must contain a standard Tcl list with one of the following forms: +.VE .TP \fIname\fR\0[\fIfgColor\fR\0[\fIbgColor\fR]] -\fIName\fR is the name of a cursor in the standard X cursor font, -i.e., any of the names defined in \fBcursorfont.h\fR, without +\fIName\fR is the name of a cursor in the standard X cursor cursor, +i.e., any of the names defined in \fBcursorcursor.h\fR, without the \fBXC_\fR. Some example values are \fBX_cursor\fR, \fBhand2\fR, or \fBleft_ptr\fR. Appendix B of ``The X Window System'' by Scheifler & Gettys has illustrations showing what each of these @@ -86,9 +111,10 @@ will be no background color: the background will be transparent. If no colors are specified, then the cursor will use black for its foreground color and white for its background color. - -The Macintosh version of Tk also supports all of the X cursors. -Tk on the Mac will also accept any of the standard Mac cursors +.RS +.PP +The Macintosh version of Tk supports all of the X cursors and +will also accept any of the standard Mac cursors including \fBibeam\fR, \fBcrosshair\fR, \fBwatch\fR, \fBplus\fR, and \fBarrow\fR. In addition, Tk will load Macintosh cursor resources of the types \fBcrsr\fR (color) and \fBCURS\fR (black and white) by the @@ -96,11 +122,12 @@ name of the of the resource. The application and all its open dynamic library's resource files will be searched for the named cursor. If there are conflicts color cursors will always be loaded in preference to black and white cursors. +.RE .TP \fB@\fIsourceName\0maskName\0fgColor\0bgColor\fR In this form, \fIsourceName\fR and \fImaskName\fR are the names of -files describing bitmaps for the cursor's source bits and mask. -Each file must be in standard X11 or X10 bitmap format. +files describing cursors for the cursor's source bits and mask. +Each file must be in standard X11 or X10 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 @@ -112,10 +139,27 @@ used as mask also. This means that the cursor's background is transparent. This form of the command will not work on Macintosh or Windows computers. .PP +.VS 8.1 +\fBTk_GetCursor\fR is identical to \fBTk_AllocCursorFromObj\fR except +that the description of the cursor is specified with a string instead +of an object. This prevents \fBTk_GetCursor\fR from caching the +return value, so \fBTk_GetCursor\fR is less efficient than +\fBTk_AllocCursorFromObj\fR. +.PP +\fBTk_GetCursorFromObj\fR returns the token for an existing cursor, given +the window and description used to create the cursor. +\fBTk_GetCursorFromObj\fR doesn't actually create the cursor; the cursor +must already have been created with a previous call to +\fBTk_AllocCursorFromObj\fR or \fBTk_GetCursor\fR. The return +value is cached in \fIobjPtr\fR, which speeds up +future calls to \fBTk_GetCursorFromObj\fR with the same \fIobjPtr\fR +and \fItkwin\fR. +.VE +.PP \fBTk_GetCursorFromData\fR allows cursors to be created from -in-memory descriptions of their source and mask bitmaps. \fISource\fR -points to standard bitmap data for the cursor's source bits, and -\fImask\fR points to standard bitmap data describing +in-memory descriptions of their source and mask cursors. \fISource\fR +points to standard cursor data for the cursor's source bits, and +\fImask\fR points to standard cursor data describing which pixels of \fIsource\fR are to be drawn and which are to be considered transparent. \fIWidth\fR and \fIheight\fR give the dimensions of the cursor, \fIxHot\fR and \fIyHot\fR indicate the @@ -135,24 +179,26 @@ cursor = Tk_GetCursorFromData(interp, tkwin, source_bits, source_y_hot, Tk_GetUid("red"), Tk_GetUid("blue")); .CE .PP -Under normal conditions, \fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR +Under normal conditions \fBTk_GetCursorFromData\fR will return an identifier for the requested cursor. If an error -occurs in creating the cursor, such as when \fInameId\fR refers -to a non-existent file, then \fBNone\fR is returned and an error -message will be stored in \fIinterp->result\fR. +occurs in creating the cursor then \fBNone\fR is returned and an error +message will be stored in \fIinterp\fR's result. .PP -\fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR maintain a +\fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, and +\fBTk_GetCursorFromData\fR maintain a database of all the cursors they have created. Whenever possible, -a call to \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR will +a call to \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, or +\fBTk_GetCursorFromData\fR will return an existing cursor rather than creating a new one. This approach can substantially reduce server overhead, so the Tk procedures should generally be used in preference to Xlib procedures like \fBXCreateFontCursor\fR or \fBXCreatePixmapCursor\fR, which -create a new cursor on each call. +create a new cursor on each call. The Tk procedures are also more +portable than the lower-level X procedures. .PP The procedure \fBTk_NameOfCursor\fR is roughly the inverse of \fBTk_GetCursor\fR. If its \fIcursor\fR argument was created -by \fBTk_GetCursor\fR, then the return value is the \fInameId\fR +by \fBTk_GetCursor\fR, then the return value is the \fIname\fR argument that was passed to \fBTk_GetCursor\fR to create the cursor. If \fIcursor\fR was created by a call to \fBTk_GetCursorFromData\fR, or by any other mechanism, then the return value is a hexadecimal string @@ -162,17 +208,24 @@ only guaranteed to persist until the next call to \fBTk_NameOfCursor\fR. Also, this call is not portable except for cursors returned by \fBTk_GetCursor\fR. .PP -When a cursor returned by \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR -is no longer needed, \fBTk_FreeCursor\fR should be called to release it. +.VS 8.1 +When a cursor returned by \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, +or \fBTk_GetCursorFromData\fR +is no longer needed, \fBTk_FreeCursorFromObj\fR or +\fBTk_FreeCursor\fR should be called to release it. +For \fBTk_FreeCursorFromObj\fR the cursor to release is specified +with the same information used to create it; for +\fBTk_FreeCursor\fR the cursor to release is specified +with its Tk_Cursor token. There should be exactly one call to \fBTk_FreeCursor\fR for -each call to \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR. -When a cursor is no longer in use anywhere (i.e. it has been freed as -many times as it has been gotten) \fBTk_FreeCursor\fR will release -it to the X server and remove it from the database. +each call to \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, +or \fBTk_GetCursorFromData\fR. +.VE .SH BUGS In determining whether an existing cursor can be used to satisfy -a new request, \fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR +a new request, \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, +and \fBTk_GetCursorFromData\fR consider only the immediate values of their arguments. For example, when a file name is passed to \fBTk_GetCursor\fR, \fBTk_GetCursor\fR will assume it is safe to re-use an existing diff --git a/doc/GetFont.3 b/doc/GetFont.3 index 8971913..f052935 100644 --- a/doc/GetFont.3 +++ b/doc/GetFont.3 @@ -1,74 +1,122 @@ '\" '\" Copyright (c) 1990-1992 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: GetFont.3,v 1.2 1998/09/14 18:22:49 stanton Exp $ +'\" RCS: @(#) $Id: GetFont.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetFont 3 "" Tk "Tk Library Procedures" +.TH Tk_AllocFontFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetFont, Tk_NameOfFont, Tk_FreeFont \- maintain database of fonts +Tk_AllocFontFromObj, Tk_GetFont, Tk_GetFontFromObj, Tk_NameOfFont, Tk_FreeFontFromObj, Tk_FreeFont \- maintain database of fonts .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp +.VS 8.1 Tk_Font -\fBTk_GetFont(\fIinterp, tkwin, string\fB)\fR +\fBTk_AllocFontFromObj(\fIinterp, tkwin, objPtr\fB)\fR +.sp +Tk_Font +\fBTk_GetFont(\fIinterp, tkwin, string\fB)\fR +.sp +Tk_Font +\fBTk_GetFontFromObj(\fItkwin, objPtr\fB)\fR +.VE .sp char * \fBTk_NameOfFont(\fItkfont\fB)\fR .sp +.VS 8.1 +Tk_Font +\fBTk_FreeFontFromObj(\fItkwin, objPtr\fB)\fR +.VE +.sp void \fBTk_FreeFont(\fItkfont\fB)\fR .SH ARGUMENTS .AS "const char" *tkfont .AP "Tcl_Interp" *interp in -Interpreter to use for error reporting. +Interpreter to use for error reporting. If NULL, then no error +messages are left after errors. .AP Tk_Window tkwin in -Token for window on the display in which font will be used. +Token for window in which font will be used. +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +Gives name or description of font. See documentation +for the \fBfont\fR command for details on acceptable formats. +Internal rep will be modified to cache corresponding Tk_Font. .AP "const char" *string in -Name or description of desired font. See documentation for the \fBfont\fR -command for details on acceptable formats. +Same as \fIobjPtr\fR except description of font is passed as a string and +resulting Tk_Font isn't cached. +.VE .AP Tk_Font tkfont in Opaque font token. .BE .SH DESCRIPTION .PP -\fBTk_GetFont\fR finds the font indicated by \fIstring\fR and returns a -token that represents the font. The return value can be used in subsequent -calls to procedures such as \fBTk_FontMetrics\fR, \fBTk_MeasureChars\fR, and -\fBTk_FreeFont\fR. The token returned by \fBTk_GetFont\fR will remain -valid until \fBTk_FreeFont\fR is called to release it. \fIString\fR can -be either a symbolic name or a font description; see the documentation for -the \fBfont\fR command for a description of the valid formats. If -\fBTk_GetFont\fR is unsuccessful (because, for example, \fIstring\fR was -not a valid font specification) then it returns \fBNULL\fR and stores an -error message in \fIinterp->result\fR. +.VS 8.1 +\fBTk_AllocFontFromObj\fR finds the font indicated by \fIobjPtr\fR and +returns a token that represents the font. The return value can be used +in subsequent calls to procedures such as \fBTk_FontMetrics\fR, +\fBTk_MeasureChars\fR, and \fBTk_FreeFont\fR. The Tk_Font token +will remain valid until +\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR is called to release it. +\fIObjPtr\fR can contain either a symbolic name or a font description; see +the documentation for the \fBfont\fR command for a description of the +valid formats. If \fBTk_AllocFontFromObj\fR is unsuccessful (because, +for example, \fIobjPtr\fR did not contain a valid font specification) then it +returns \fBNULL\fR and leaves an error message in \fIinterp\fR's result +if \fIinterp\fR isn't NULL. \fBTk_AllocFontFromObj\fR caches +information about the return +value in \fIobjPtr\fR, which speeds up future calls to procedures +such as \fBTk_AllocFontFromObj\fR and \fBTk_GetFontFromObj\fR. +.PP +\fBTk_GetFont\fR is identical to \fBTk_AllocFontFromObj\fR except +that the description of the font is specified with a string instead +of an object. This prevents \fBTk_GetFont\fR from caching the +matching Tk_Font, so \fBTk_GetFont\fR is less efficient than +\fBTk_AllocFontFromObj\fR. +.PP +\fBTk_GetFontFromObj\fR returns the token for an existing font, given +the window and description used to create the font. +\fBTk_GetFontFromObj\fR doesn't actually create the font; the font +must already have been created with a previous call to +\fBTk_AllocFontFromObj\fR or \fBTk_GetFont\fR. The return +value is cached in \fIobjPtr\fR, which speeds up +future calls to \fBTk_GetFontFromObj\fR with the same \fIobjPtr\fR +and \fItkwin\fR. +.VE .PP -\fBTk_GetFont\fR maintains a database of all fonts it has allocated. If -the same \fIstring\fR is requested multiple times (e.g. by different -windows or for different purposes), then additional calls for the same -\fIstring\fR will be handled without involving the platform-specific -graphics server. +\fBTk_AllocFontFromObj\fR and \fBTk_GetFont\fR maintain +a database of all fonts they have allocated. If +the same font is requested multiple times (e.g. by different +windows or for different purposes), then a single Tk_Font will be +shared for all uses. The underlying resources will be freed automatically +when no-one is using the font anymore. .PP The procedure \fBTk_NameOfFont\fR is roughly the inverse of \fBTk_GetFont\fR. Given a \fItkfont\fR that was created by -\fBTk_GetFont\fR, the return value is the \fIstring\fR argument that was +\fBTk_GetFont\fR (or \fBTk_AllocFontFromObj\fR), the return value is +the \fIstring\fR argument that was passed to \fBTk_GetFont\fR to create the font. The string returned by \fBTk_NameOfFont\fR is only guaranteed to persist until the \fItkfont\fR is deleted. The caller must not modify this string. .PP -When a font returned by \fBTk_GetFont\fR is no longer needed, -\fBTk_FreeFont\fR should be called to release it. There should be -exactly one call to \fBTk_FreeFont\fR for each call to \fBTk_GetFont\fR. -When a font is no longer in use anywhere (i.e. it has been freed as many -times as it has been gotten) \fBTk_FreeFont\fR will release any -platform-specific storage and delete it from the database. +.VS 8.1 +When a font is no longer needed, +\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR should be called to +release it. For \fBTk_FreeFontFromObj\fR the font to release is specified +with the same information used to create it; for +\fBTk_FreeFont\fR the font to release is specified +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. +.VE .SH KEYWORDS font diff --git a/doc/GetJustify.3 b/doc/GetJustify.3 index 6b12be1..68dced7 100644 --- a/doc/GetJustify.3 +++ b/doc/GetJustify.3 @@ -1,22 +1,26 @@ '\" '\" Copyright (c) 1990-1994 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: GetJustify.3,v 1.2 1998/09/14 18:22:49 stanton Exp $ +'\" RCS: @(#) $Id: GetJustify.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetJustify 3 4.0 Tk "Tk Library Procedures" +.TH Tk_GetJustifyFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetJustify, Tk_NameOfJustify \- translate between strings and justification styles +Tk_GetJustifyFromObj, Tk_GetJustify, Tk_NameOfJustify \- translate between strings and justification styles .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp -Tk_Justify +.VS 8.1 +int +\fBTk_GetJustifyFromObj(\fIinterp, objPtr, justifyPtr\fB)\fR +.sp +int \fBTk_GetJustify(\fIinterp, string, justifyPtr\fB)\fR .sp char * @@ -24,21 +28,30 @@ char * .SH ARGUMENTS .AS "Tk_Justify" *justifyPtr .AP Tcl_Interp *interp in -Interpreter to use for error reporting. +Interpreter to use for error reporting, or NULL. +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +String value contains name of justification style (\fBleft\fR, \fBright\fR, or +\fBcenter\fR). The +internal rep will be modified to cache corresponding justify value. .AP char *string in -String containing name of justification style (``left'', ``right'', or -``center''). +Same as \fIobjPtr\fR except description of justification style is passed as +a string. +.VE .AP int *justifyPtr out Pointer to location in which to store justify value corresponding to -\fIstring\fR. +\fIobjPtr\fR or \fIstring\fR. .AP Tk_Justify justify in Justification style (one of the values listed below). .BE .SH DESCRIPTION .PP -\fBTk_GetJustify\fR places in \fI*justifyPtr\fR the justify value -corresponding to \fIstring\fR. This value will be one of the following: +.VS 8.1 +\fBTk_GetJustifyFromObj\fR places in \fI*justifyPtr\fR the justify value +corresponding to \fIobjPtr\fR's value. +.VE +This value will be one of the following: .TP \fBTK_JUSTIFY_LEFT\fR Means that the text on each line should start at the left edge of @@ -52,12 +65,23 @@ the line; as a result, the left edges of lines may be ragged. Means that the text on each line should be centered; as a result, both the left and right edges of lines may be ragged. .PP +.VS 8.1 Under normal circumstances the return value is \fBTCL_OK\fR and \fIinterp\fR is unused. -If \fIstring\fR doesn't contain a valid justification 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 -\fI*justifyPtr\fR is unmodified. +If \fIobjPtr\fR doesn't contain a valid justification style +or an abbreviation of one of these names, \fBTCL_ERROR\fR is returned, +\fI*justifyPtr\fR is unmodified, and an error message is +stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL. +\fBTk_GetJustifyFromObj\fR caches information about the return +value in \fIobjPtr\fR, which speeds up future calls to +\fBTk_GetJustifyFromObj\fR with the same \fIobjPtr\fR. +.PP +\fBTk_GetJustify\fR is identical to \fBTk_GetJustifyFromObj\fR except +that the description of the justification is specified with a string instead +of an object. This prevents \fBTk_GetJustify\fR from caching the +return value, so \fBTk_GetJustify\fR is less efficient than +\fBTk_GetJustifyFromObj\fR. +.VE .PP \fBTk_NameOfJustify\fR is the logical inverse of \fBTk_GetJustify\fR. Given a justify value it returns a statically-allocated string diff --git a/doc/GetPixels.3 b/doc/GetPixels.3 index 6c271a7..3df2985 100644 --- a/doc/GetPixels.3 +++ b/doc/GetPixels.3 @@ -1,24 +1,34 @@ '\" '\" Copyright (c) 1990 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: GetPixels.3,v 1.2 1998/09/14 18:22:50 stanton Exp $ +'\" RCS: @(#) $Id: GetPixels.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetPixels 3 "" Tk "Tk Library Procedures" +.TH Tk_GetPixelsFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetPixels, Tk_GetScreenMM \- translate between strings and screen units +Tk_GetPixelsFromObj, Tk_GetPixels, Tk_GetMMFromObj, Tk_GetScreenMM \- translate between strings and screen units .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp +.VS 8.1 +int +\fBTk_GetPixelsFromObj(\fIinterp, tkwin, objPtr, intPtr\fB)\fR +.VE +.sp int \fBTk_GetPixels(\fIinterp, tkwin, string, intPtr\fB)\fR .sp +.VS 8.1 +int +\fBTk_GetMMFromObj(\fIinterp, tkwin, objPtr, doublePtr\fB)\fR +.VE +.sp int \fBTk_GetScreenMM(\fIinterp, tkwin, string, doublePtr\fB)\fR .SH ARGUMENTS @@ -27,9 +37,15 @@ int Interpreter to use for error reporting. .AP Tk_Window tkwin in Window whose screen geometry determines the conversion between absolute -units and pixels. +units and pixels. +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +String value specifies a distance on the screen; +internal rep will be modified to cache converted distance. .AP char *string in -String that specifies a distance on the screen. +Same as \fIobjPtr\fR except specification of distance is passed as +a string. +.VE .AP int *intPtr out Pointer to location in which to store converted distance in pixels. .AP double *doublePtr out @@ -38,10 +54,16 @@ Pointer to location in which to store converted distance in millimeters. .SH DESCRIPTION .PP -These two procedures take as argument a specification of distance on -the screen (\fIstring\fR) and compute the corresponding distance -either in integer pixels or floating-point millimeters. -In either case, \fIstring\fR specifies a screen distance as a +These procedures take as argument a specification of distance on +.VS 8.1 +the screen (\fIobjPtr\fR or \fIstring\fR) and compute the +.VE +corresponding distance either in integer pixels or floating-point millimeters. +In either case, +.VS 8.1 +\fIobjPtr\fR or \fIstring\fR +.VE +specifies a screen distance as a floating-point number followed by one of the following characters that indicates units: .TP @@ -61,16 +83,29 @@ The number specifies a distance in millimeters on the screen. The number specifies a distance in printer's points (1/72 inch) on the screen. .PP -\fBTk_GetPixels\fR converts \fIstring\fR to the nearest even -number of pixels and stores that value at \fI*intPtr\fR. -\fBTk_GetScreenMM\fR converts \fIstring\fR to millimeters and -stores the double-precision floating-point result at \fI*doublePtr\fR. -.PP -Both procedures return \fBTCL_OK\fR under normal circumstances. -If an error occurs (e.g. \fIstring\fR contains a number followed +.VS 8.1 +\fBTk_GetPixelsFromObj\fR converts the value of \fIobjPtr\fR to the +nearest even number of pixels and stores that value at \fI*intPtr\fR. +It returns \fBTCL_OK\fR under normal circumstances. +If an error occurs (e.g. \fIobjPtr\fR contains a number followed by a character that isn't one of the ones above) then \fBTCL_ERROR\fR is returned and an error message is left -in \fIinterp->result\fR. +in \fIinterp\fR's result if \fIinterp\fR isn't NULL. +\fBTk_GetPixelsFromObj\fR caches information about the return +value in \fIobjPtr\fR, which speeds up future calls to +\fBTk_GetPixelsFromObj\fR with the same \fIobjPtr\fR. +.PP +\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 +\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. +.VE .SH KEYWORDS centimeters, convert, inches, millimeters, pixels, points, screen units diff --git a/doc/GetRelief.3 b/doc/GetRelief.3 index 20d2933..a85280e 100644 --- a/doc/GetRelief.3 +++ b/doc/GetRelief.3 @@ -1,21 +1,26 @@ '\" '\" Copyright (c) 1990 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" 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. '\" -'\" RCS: @(#) $Id: GetRelief.3,v 1.2 1998/09/14 18:22:51 stanton Exp $ +'\" RCS: @(#) $Id: GetRelief.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_GetRelief 3 "" Tk "Tk Library Procedures" +.TH Tk_GetReliefFromObj 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME -Tk_GetRelief, Tk_NameOfRelief \- translate between strings and relief values +Tk_GetReliefFromObj, Tk_GetRelief, Tk_NameOfRelief \- translate between strings and relief values .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp +.VS 8.1 +int +\fBTk_GetReliefFromObj(\fIinterp, objPtr, reliefPtr\fB)\fR +.VE +.sp int \fBTk_GetRelief(\fIinterp, name, reliefPtr\fB)\fR .sp @@ -25,12 +30,18 @@ char * .AS "Tcl_Interp" *reliefPtr .AP Tcl_Interp *interp in Interpreter to use for error reporting. -.AP char *name in -String containing relief name (one of ``flat'', ``groove'', -``raised'', ``ridge'', ``solid'', or ``sunken''). +.VS 8.1 br +.AP Tcl_Obj *objPtr in/out +String value contains name of relief (one of \fBflat\fR, \fBgroove\fR, +\fBraised\fR, \fBridge\fR, \fBsolid\fR, or \fBsunken\fR); +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 +a string. +.VE .AP int *reliefPtr out Pointer to location in which to store relief value corresponding to -\fIname\fR. +\fIobjPtr\fR or \fIname\fR. .AP int relief in Relief value (one of TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN, TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE). @@ -38,20 +49,31 @@ TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE). .SH DESCRIPTION .PP -\fBTk_GetRelief\fR places in \fI*reliefPtr\fR the relief value -corresponding to \fIname\fR. This value will be one of +.VS 8.1 +\fBTk_GetReliefFromObj\fR places in \fI*reliefPtr\fR the relief value +corresponding to the value of \fIobjPtr\fR. This value will be one of TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN, TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE. Under normal circumstances the return value is TCL_OK and \fIinterp\fR is unused. -If \fIname\fR doesn't contain one of the valid relief names -or an abbreviation of one of them, then an error message -is stored in \fIinterp->result\fR, -TCL_ERROR is returned, and \fI*reliefPtr\fR is unmodified. +If \fIobjPtr\fR doesn't contain one of the valid relief names +or an abbreviation of one of them, then TCL_ERROR is returned, +\fI*reliefPtr\fR is unmodified, and an error message +is stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL. +\fBTk_GetReliefFromObj\fR caches information about the return +value in \fIobjPtr\fR, which speeds up future calls to +\fBTk_GetReliefFromObj\fR with the same \fIobjPtr\fR. +.PP +\fBTk_GetRelief\fR is identical to \fBTk_GetReliefFromObj\fR except +that the description of the relief is specified with a string instead +of an object. This prevents \fBTk_GetRelief\fR from caching the +return value, so \fBTk_GetRelief\fR is less efficient than +\fBTk_GetReliefFromObj\fR. +.VE .PP \fBTk_NameOfRelief\fR is the logical inverse of \fBTk_GetRelief\fR. -Given a relief value it returns the corresponding string (``flat'', -``raised'', ``sunken'', ``groove'', ``solid'', or ``ridge''). +Given a relief value it returns the corresponding string (\fBflat\fR, +\fBraised\fR, \fBsunken\fR, \fBgroove\fR, \fBsolid\fR, or \fBridge\fR). If \fIrelief\fR isn't a legal relief value, then ``unknown relief'' is returned. diff --git a/doc/MeasureChar.3 b/doc/MeasureChar.3 index 53baf88..2df934c 100644 --- a/doc/MeasureChar.3 +++ b/doc/MeasureChar.3 @@ -4,10 +4,10 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: MeasureChar.3,v 1.2 1998/09/14 18:22:52 stanton Exp $ +'\" RCS: @(#) $Id: MeasureChar.3,v 1.3 1999/04/16 01:51:08 stanton Exp $ '\" .so man.macros -.TH Tk_MeasureChars 3 "" Tk "Tk Library Procedures" +.TH Tk_MeasureChars 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME Tk_MeasureChars, Tk_TextWidth, Tk_DrawChars, Tk_UnderlineChars \- routines to measure and display simple single-line strings. @@ -16,16 +16,16 @@ Tk_MeasureChars, Tk_TextWidth, Tk_DrawChars, Tk_UnderlineChars \- routines to me \fB#include <tk.h>\fR .sp int -\fBTk_MeasureChars(\fItkfont, string, maxChars, maxPixels, flags, lengthPtr\fB)\fR +\fBTk_MeasureChars(\fItkfont, string, numBytes, maxPixels, flags, lengthPtr\fB)\fR .sp int -\fBTk_TextWidth(\fItkfont, string, numChars\fB)\fR +\fBTk_TextWidth(\fItkfont, string, numBytes\fB)\fR .sp void -\fBTk_DrawChars(\fIdisplay, drawable, gc, tkfont, string, numChars, x, y\fB)\fR +\fBTk_DrawChars(\fIdisplay, drawable, gc, tkfont, string, numBytes, x, y\fB)\fR .sp void -\fBTk_UnderlineChars(\fIdisplay, drawable, gc, tkfont, string, x, y, firstChar, lastChar\fB)\fR +\fBTk_UnderlineChars(\fIdisplay, drawable, gc, tkfont, string, x, y, firstByte, lastByte\fB)\fR .sp .SH ARGUMENTS .AS "const char" firstChar @@ -37,9 +37,11 @@ Text to be measured or displayed. Need not be null terminated. Any non-printing meta-characters in the string (such as tabs, newlines, and other control characters) will be measured or displayed in a platform-dependent manner. -.AP int maxChars in -The maximum number of characters to consider when measuring \fIstring\fR. -Must be greater than or equal to 0. +.VS 8.1 +.AP int numBytes in +The maximum number of bytes to consider when measuring or drawing +\fIstring\fR. Must be greater than or equal to 0. +.VE 8.1 .AP int maxPixels in If \fImaxPixels\fR is greater than 0, it specifies the longest permissible line length in pixels. Characters from \fIstring\fR are processed only @@ -59,9 +61,6 @@ letter will still be returned. .AP int *lengthPtr out Filled with the number of pixels occupied by the number of characters returned as the result of \fBTk_MeasureChars\fR. -.AP int numChars in -The total number of characters to measure or draw from \fIstring\fR. Must -be greater than or equal to 0. .AP Display *display in Display on which to draw. .AP Drawable drawable in @@ -72,13 +71,15 @@ must be the same as the \fItkfont\fR. .AP int "x, y" in Coordinates at which to place the left edge of the baseline when displaying \fIstring\fR. -.AP int firstChar in -The index of the first character to underline in the \fIstring\fR. -Underlining begins at the left edge of this character. -.AP int lastChar in -The index of the last character up to which the underline will -be drawn. The character specified by \fIlastChar\fR will not itself be -underlined. +.VS 8.1 +.AP int firstByte in +The index of the first byte of the first character to underline in the +\fIstring\fR. Underlining begins at the left edge of this character. +.AP int lastByte in +The index of the first byte of the last character up to which the +underline will be drawn. The character specified by \fIlastByte\fR +will not itself be underlined. +.VE 8.1 .BE .SH DESCRIPTION @@ -88,7 +89,13 @@ single-line, strings. To measure and display single-font, multi-line, justified text, refer to the documentation for \fBTk_ComputeTextLayout\fR. There is no programming interface in the core of Tk that supports multi-font, multi-line text; support for that behavior must be built on -top of simpler layers. +top of simpler layers. +.VS 8.1 +Note that the interfaces described here are +byte-oriented not character-oriented, so index values coming from Tcl +scripts need to be converted to byte offsets using the +\fBTcl_UtfAtIndex\fR and related routines. +.VE 8.1 .PP A glyph is the displayable picture of a letter, number, or some other symbol. Not all character codes in a given font have a glyph. @@ -103,10 +110,10 @@ newlines/returns into multi-line text. .PP \fBTk_MeasureChars\fR is used both to compute the length of a given string and to compute how many characters from a string fit in a given -amount of space. The return value is the number of characters from +amount of space. The return value is the number of bytes from \fIstring\fR that fit in the space specified by \fImaxPixels\fR subject to the conditions described by \fIflags\fR. If all characters fit, the return -value will be \fImaxChars\fR. \fI*lengthPtr\fR is filled with the computed +value will be \fInumBytes\fR. \fI*lengthPtr\fR is filled with the computed width, in pixels, of the portion of the string that was measured. For example, if the return value is 5, then \fI*lengthPtr\fR is filled with the distance between the left edge of \fIstring\fR[0] and the right edge of diff --git a/doc/SetOptions.3 b/doc/SetOptions.3 new file mode 100644 index 0000000..4a6a1a4 --- /dev/null +++ b/doc/SetOptions.3 @@ -0,0 +1,502 @@ +'\" +'\" Copyright (c) 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. +'\" +'\" RCS: @(#) $Id: SetOptions.3,v 1.2 1999/04/16 01:51:08 stanton Exp $ +'\" +.so man.macros +.TH Tk_SetOptions 3 8.1 Tk "Tk Library Procedures" +.BS +.SH NAME +Tk_CreateOptionTable, Tk_DeleteOptionTable, Tk_InitOptions, Tk_SetOptions, Tk_FreeSavedOptions, Tk_RestoreSavedOptions, Tk_GetOptionValue, Tk_GetOptionInfo, Tk_FreeConfigOptions, Tk_Offset \- process configuration options +.SH SYNOPSIS +.nf +\fB#include <tk.h>\fR +.sp +Tk_OptionTable +\fBTk_CreateOptionTable(\fIinterp, templatePtr\fB)\fR +.sp +\fBTk_DeleteOptionTable(\fIoptionTable\fB)\fR +.sp +int +\fBTk_InitOptions(\fIinterp, recordPtr, optionTable, tkwin\fB)\fR +.sp +int +\fBTk_SetOptions(\fIinterp, recordPtr, optionTable, objc, objv, tkwin, savePtr, maskPtr\fB)\fR +.sp +\fBTk_FreeSavedOptions(\fIsavedPtr\fB)\fR +.sp +\fBTk_RestoreSavedOptions(\fIsavedPtr\fB)\fR +.sp +Tcl_Obj * +\fBTk_GetOptionValue(\fIinterp, recordPtr, optionTable, namePtr, tkwin\fB)\fR +.sp +Tcl_Obj * +\fBTk_GetOptionInfo(\fIinterp, recordPtr, optionTable, namePtr, tkwin\fB)\fR +.sp +\fBTk_FreeConfigOptions(\fIrecordPtr, optionTable, tkwin\fB)\fR +.sp +int +\fBTk_Offset(\fItype, field\fB)\fR +.SH ARGUMENTS +.AS Tk_SavedOptions "*CONST objv[]" in/out +.AP Tcl_Interp *interp in +A Tcl interpreter. Most procedures use this only for returning error +messages; if it is NULL then no error messages are returned. For +\fBTk_CreateOptionTable\fR the value cannot be NULL; it gives the +interpreter in which the option table will be used. +.AP Tk_OptionSpec *templatePtr in +Points to an array of static information that describes the configuration +options that are supported. Used to build a Tk_OptionTable. The information +pointed to by this argument must exist for the lifetime of the Tk_OptionTable. +.AP Tk_OptionTable optionTable in +Token for an option table. Must have been returned by a previous call +to \fBTk_CreateOptionTable\fR. +.AP char *recordPtr in/out +Points to structure in which values of configuration options are stored; +fields of this record are modified by procedures such as \fBTk_SetOptions\fR +and read by procedures such as \fBTk_GetOptionValue\fR. +.AP Tk_Window tkwin in +For options such as TK_OPTION_COLOR, this argument indicates +the window in which the option will be used. If \fIoptionTable\fR uses +no window-dependent options, then a NULL value may be supplied for +this argument. +.AP int objc in +Number of values in \fIobjv\fR. +.AP Tcl_Obj "*CONST objv[]" in +Command-line arguments for setting configuring options. +.AP Tk_SavedOptions *savePtr out +If not NULL, the structure pointed to by this argument is filled +in with the old values of any options that were modified and old +values are restored automatically if an error occurs in \fBTk_SetOptions\fR. +.AP int *maskPtr out +If not NULL, the word pointed to by \fImaskPtr\fR is filled in with the +bit-wise OR of the \fItypeMask\fR fields for the options that +were modified. +.AP Tk_SavedOptions *savedPtr in/out +Points to a structure previously filled in by \fBTk_SetOptions\fR with +old values of modified options. +.AP Tcl_Obj *namePtr in +The value of this object is the name of a particular option. If NULL +is passed to \fBTk_GetOptionInfo\fR then information is returned for +all options. Must not be NULL when \fBTk_GetOptionValue\fR is called. +.AP "type name" type in +The name of the type of a record. +.AP "field name" field in +The name of a field in records of type \fItype\fR. +.BE +.SH DESCRIPTION +.PP +These procedures handle most of the details of parsing configuration +options such as those for Tk widgets. Given a description of what +options are supported, these procedures handle all the details of +parsing options and storing their values into a C structure associated +with the widget or object. The procedures were designed primarily for +widgets in Tk, but they can also be used for other kinds of objects that +have configuration options. In the rest of this manual page ``widget'' will +be used to refer to the object whose options are being managed; in +practice the object may not actually be a widget. The term ``widget +record'' is used to refer to the C-level structure in +which information about a particular widget or object is stored. +.PP +Note: the easiest way to learn how to use these procedures is to +look at a working example. In Tk, the simplest example is the code +that implements the button family of widgets, which is an \fBtkButton.c\fR. +Other examples are in \fBtkSquare.c\fR and \fBtkMenu.c\fR. +.PP +In order to use these procedures, the code that implements the widget +must contain a static array of Tk_OptionSpec structures. This is a +template that describes the various options supported by that class of +widget; there is a separate template for each kind of widget. The +template contains information such as the name of each option, its type, +its default value, and where the value of the option is stored in the +widget record. See TEMPLATES below for more detail. +.PP +In order to process configuration options efficiently, the static +template must be augmented with additional information that is available +only at runtime. The procedure \fBTk_CreateOptionTable\fR creates this +dynamic information from the template and returns a Tk_OptionTable token +that describes both the static and dynamic information. All of the +other procedures, such as \fBTk_SetOptions\fR, take a Tk_OptionTable +token as argument. Typically, \fBTk_CreateOptionTable\fR is called the +first time that a widget of a particular class is created and the +resulting Tk_OptionTable is used in the future for all widgets of that +class. A Tk_OptionTable may be used only in a single interpreter, given +by the \fIinterp\fR argument to \fBTk_CreateOptionTable\fR. When an +option table is no longer needed \fBTk_DeleteOptionTable\fR should be +called to free all of its resources. All of the option tables +for a Tcl interpreter are freed automatically if the interpreter is deleted. +.PP +\fBTk_InitOptions\fR is invoked when a new widget is created to set +the default values for all of the widget's configuration options. +\fBTk_InitOptions\fR is passed a token for an option table (\fIoptionTable\fR) +and a pointer to a widget record (\fIrecordPtr\fR), which is the C +structure that holds information about this widget. \fBTk_InitOptions\fR +uses the information in the option table to +choose an appropriate default for each option, then it stores the default +value directly into the widget record, overwriting any information that +was already present in the widget record. \fBTk_InitOptions\fR normally +returns TCL_OK. If an error occurred while setting the default values +(e.g., because a default value was erroneous) then TCL_ERROR is returned +and an error message is left in \fIinterp\fR's result if \fIinterp\fR +isn't NULL. +.PP +\fBTk_SetOptions\fR is invoked to modify configuration options based +on information specified in a Tcl command. The command might be one that +creates a new widget, or a command that modifies options on an existing +widget. The \fIobjc\fR and \fIobjv\fR arguments describe the +values of the arguments from the Tcl command. \fIObjv\fR must contain +an even number of objects: the first object of each pair gives the name of +an option and the second object gives the new value for that option. +\fBTk_SetOptions\fR looks up each name in \fIoptionTable\fR, checks that +the new value of the option conforms to the type in \fIoptionTable\fR, +and stores the value of the option into the widget record given by +\fIrecordPtr\fR. \fBTk_SetOptions\fR normally returns TCL_OK. If +an error occurred (such as an unknown option name or an illegal option +value) then TCL_ERROR is returned and an error message is left in +\fIinterp\fR's result if \fIinterp\fR isn't NULL. +.PP +\fBTk_SetOptions\fR has two additional features. First, if the +\fImaskPtr\fR argument isn't NULL then it points to an integer +value that is filled in with information about the options that were +modified. For each option in the template passed to +\fBTk_CreateOptionTable\fR there is a \fItypeMask\fR field. The +bits of this field are defined by the code that implements the widget; +for example, each bit might correspond to a particular configuration option. +Alternatively, bits might be used functionally. For example, one bit might +be used for redisplay: all options that affect the widget's display, such +that changing the option requires the widget to be redisplayed, might have +that bit set. Another bit might indicate that the geometry of the widget +must be recomputed, and so on. \fBTk_SetOptions\fR OR's together the +\fItypeMask\fR fields from all the options that were modified and returns +this value at *\fImaskPtr\fR; the caller can then use this information +to optimize itself so that, for example, it doesn't redisplay the widget +if the modified options don't affect the widget's appearance. +.PP +The second additional feature of \fBTk_SetOptions\fR has to do with error +recovery. If an error occurs while processing configuration options, this +feature makes it possible to restore all the configuration options to their +previous values. Errors can occur either while processing options in +\fBTk_SetOptions\fR or later in the caller. In many cases the caller does +additional processing after \fBTk_SetOptions\fR returns; for example, it +might use an option value to set a trace on a variable and may detect +an error if the variable is an array instead of a scalar. Error recovery +is enabled by passing in a non-NULL value for the \fIsavePtr\fR argument +to \fBTk_SetOptions\fR; this should be a pointer to an uninitialized +Tk_SavedOptions structure on the caller's stack. \fBTk_SetOptions\fR +overwrites the structure pointed to by \fIsavePtr\fR with information +about the old values of any options modified by the procedure. +If \fBTk_SetOptions\fR returns successfully, the +caller uses the structure in one of two ways. If the caller completes +its processing of the new options without any errors, then it must pass +the structure to \fBTk_FreeSavedOptions\fR so that the old values can be +freed. If the caller detects an error in its processing of the new +options, then it should pass the structure to \fBTk_RestoreSavedOptions\fR, +which will copy the old values back into the widget record and free +the new values. +If \fBTk_SetOptions\fR detects an error then it automatically restores +any options that had already been modified and leaves *\fIsavePtr\fR in +an empty state: the caller need not call either \fBTk_FreeSavedOptions\fR or +\fBTk_RestoreSavedOptions\fR. +If the \fIsavePtr\fR argument to \fBTk_SetOptions\fR is NULL then +\fBTk_SetOptions\fR frees each old option value immediately when it sets a new +value for the option. In this case, if an error occurs in the third +option, the old values for the first two options cannot be restored. +.PP +\fBTk_GetOptionValue\fR returns the current value of a configuration option +for a particular widget. The \fInamePtr\fR argument contains the name of +an option; \fBTk_GetOptionValue\fR uses \fIoptionTable\fR +to lookup the option and extract its value from the widget record +pointed to by \fIrecordPtr\fR, then it returns an object containing +that value. If an error occurs (e.g., because \fInamePtr\fR contains an +unknown option name) then NULL is returned and an error message is left +in \fIinterp\fR's result unless \fIinterp\fR is NULL. +.PP +\fBTk_GetOptionInfo\fR returns information about configuration options in +a form suitable for \fBconfigure\fR widget commands. If the \fInamePtr\fR +argument is not NULL, it points to an object that gives the name of a +configuration option; \fBTk_GetOptionInfo\fR returns an object containing +a list with five elements, which are the name of the option, the name and +class used for the option in the option database, the default value for +the option, and the current value for the option. If the \fInamePtr\fR +argument is NULL, then \fBTk_GetOptionInfo\fR returns information about +all options in the form of a list of lists; each sublist describes one +option. Synonym options are handled differently depending on whether +\fInamePtr\fR is NULL: if \fInamePtr\fR is NULL then the sublist for +each synonym option has only two elements, which are the name of the +option and the name of the other option that it refers to; if \fInamePtr\fR +is non-NULL and names a synonym option then the object returned +is the five-element list +for the other option that the synonym refers to. If an error occurs +(e.g., because \fInamePtr\fR contains an unknown option name) then NULL +is returned and an error message is left in \fIinterp\fR's result unless +\fIinterp\fR is NULL. +.PP +\fBTk_FreeConfigOptions\fR must be invoked when a widget is deleted. +It frees all of the resources associated with any of the configuration +options defined in \fIrecordPtr\fR by \fIoptionTable\fR. +.PP +The \fBTk_Offset\fR macro is provided as a safe way of generating the +\fIobjOffset\fR and \fIinternalOffset\fR values for entries in +Tk_OptionSpec 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 "TEMPLATES" +.PP +The array of Tk_OptionSpec structures passed to \fBTk_CreateOptionTable\fR +via its \fItemplatePtr\fR argument describes the configuration options +supported by a particular class of widgets. Each structure specifies +one configuration option and has the following fields: +.CS +typedef struct { + Tk_OptionType \fItype\fR; + char *\fIoptionName\fR; + char *\fIdbName\fR; + char *\fIdbClass\fR; + char *\fIdefValue\fR; + int \fIobjOffset\fR; + int \fIinternalOffset\fR; + int \fIflags\fR; + ClientData \fIclientData\fR; + int \fItypeMask\fR; +} Tk_OptionSpec; +.CE +The \fItype\fR field indicates what kind of configuration option this is +(e.g. TK_OPTION_COLOR for a color value, or TK_OPTION_INT for +an integer value). \fIType\fR determines how the +value of the option is parsed (more on this below). +The \fIoptionName\fR field is a string such as \fB\-font\fR or \fB\-bg\fR; +it is the name used for the option in Tcl commands and passed to +procedures via the \fIobjc\fR or \fInamePtr\fR arguments. +The \fIdbName\fR and \fIdbClass\fR fields are used by \fBTk_InitOptions\fR +to look up a default value for this option in the option database; if +\fIdbName\fR is NULL then the option database is not used by +\fBTk_InitOptions\fR for this option. The \fIdefValue\fR field +specifies a default value for this configuration option if no +value is specified in the option database. The \fIobjOffset\fR and +\fIinternalOffset\fR fields indicate where to store the value of this +option in widget records (more on this below); values for the \fIobjOffset\fR +and \fIinternalOffset\fR fields should always be generated with the +\fBTk_Offset\fR macro. +The \fIflags\fR field contains additional information +to control the processing of this configuration option (see below +for details). +\fIClientData\fR provides additional type-specific data needed +by certain types. For instance, for TK_OPTION_COLOR types, +\fIclientData\fR is a string giving the default value to use on +monochrome displays. See the descriptions of the different types +below for details. +The last field, \fItypeMask\fR, is used by \fBTk_SetOptions\fR to +return information about which options were modified; see the description +of \fBTk_SetOptions\fR above for details. +.PP +When \fBTk_InitOptions\fR and \fBTk_SetOptions\fR store the value of an +option into the widget record, they can do it in either of two ways. +If the \fIobjOffset\fR field of the Tk_OptionSpec is greater than +or equal to zero, then the value of the option is stored as a +(Tcl_Obj *) at the location in the widget record given by \fIobjOffset\fR. +If the \fIinternalOffset\fR field of the Tk_OptionSpec is +greater than or equal to zero, then the value of the option is stored +in a type-specific internal form at the location in the widget record +given by \fIinternalOffset\fR. For example, if the option's type is +TK_OPTION_INT then the internal form is an integer. If the +\fIobjOffset\fR or \fIinternalOffset\fR field is negative then the +value is not stored in that form. At least one of the offsets must be +greater than or equal to zero. +.PP +The \fIflags\fR field consists of one or more bits ORed together. At +present only a single flag is supported: TK_OPTION_NULL_OK. If +this bit is set for an option then an empty string will be accepted as +the value for the option and the resulting internal form will be a +NULL pointer or \fBNone\fR, depending on the type of the option. +If the flag is not set then empty strings will result +in errors. +TK_OPTION_NULL_OK is typically used to allow a +feature to be turned off entirely, e.g. set a cursor value to +\fBNone\fR so that a window simply inherits its parent's cursor. +Not all option types support the TK_OPTION_NULL_OK +flag; for those that do, there is an explicit indication of that fact +in the descriptions below. +.PP +The \fItype\fR field of each Tk_OptionSpec structure determines +how to parse the value of that configuration option. The +legal value for \fItype\fR, and the corresponding actions, are +described below. If the type requires a \fItkwin\fR value to be +passed into procedures like \fBTk_SetOptions\fR, or if it uses +the \fIclientData\fR field of the Tk_OptionSpec, then it is indicated +explicitly; if not mentioned, the type requires neither \fItkwin\fR +nor \fIclientData\fR. +.TP +\fBTK_OPTION_ANCHOR\fR +The value must be a standard anchor position such as \fBne\fR or +\fBcenter\fR. The internal form is a Tk_Anchor value like the ones +returned by \fBTk_GetAnchorFromObj\fR. +.TP +\fBTK_OPTION_BITMAP\fR +The value must be a standard Tk bitmap name. The internal form is a +Pixmap token like the ones returned by \fBTk_AllocBitmapFromObj\fR. +This option type requires \fItkwin\fR to be supplied to procedures +such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag. +.TP +\fBTK_OPTION_BOOLEAN\fR +The value must be a standard boolean value such as \fBtrue\fR or +\fBno\fR. The internal form is an integer with value 0 or 1. +.TP +\fBTK_OPTION_BORDER\fR +The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR. +The internal form is a Tk_3DBorder token like the ones returned +by \fBTk_Alloc3DBorderFromObj\fR. +This option type requires \fItkwin\fR to be supplied to procedures +such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag. +.TP +\fBTK_OPTION_COLOR\fR +The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR. +The internal form is an (XColor *) token like the ones returned by +\fBTk_AllocColorFromObj\fR. +This option type requires \fItkwin\fR to be supplied to procedures +such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag. +.TP +\fBTK_OPTION_CURSOR\fR +The value must be a standard cursor name such as \fBcross\fR or \fB@foo\fR. +The internal form is a Tk_Cursor token like the ones returned by +\fBTk_AllocCursorFromObj\fR. +This option type requires \fItkwin\fR to be supplied to procedures +such as \fBTk_SetOptions\fR, and when the option is set the cursor +for the window is changed by calling \fBXDefineCursor\fR. This +option type also supports the TK_OPTION_NULL_OK flag. +.TP +\fBTK_OPTION_DOUBLE\fR +The string value must be a floating-point number in +the format accepted by \fBstrtol\fR. The internal form is a C +\fBdouble\fR value. +.TP +\fBTK_OPTION_END\fR +Marks the end of the template. There must be a Tk_OptionSpec structure +with \fItype\fR TK_OPTION_END at the end of each template. If the +\fIclientData\fR field of this structure isn't NULL, then it points to +an additional array of Tk_OptionSpec's, which is itself terminated by +another TK_OPTION_END entry. Templates may be chained arbitrarily +deeply. This feature allows common options to be shared by several +widget classes. +.TP +\fBTK_OPTION_FONT\fR +The value must be a standard font name such as \fBTimes 16\fR. +The internal form is a Tk_Font handle like the ones returned by +\fBTk_AllocFontFromObj\fR. +This option type requires \fItkwin\fR to be supplied to procedures +such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag. +.TP +\fBTK_OPTION_INT\fR +The string value must be an integer in the format accepted by +\fBstrtol\fR (e.g. \fB0\fR and \fB0x\fR prefixes may be used to +specify octal or hexadecimal numbers, respectively). The internal +form is a C \fBint\fR value. +.TP +\fBTK_OPTION_JUSTIFY\fR +The value must be a standard justification value such as \fBleft\fR. +The internal form is a Tk_Justify like the values returned by +\fBTk_GetJustifyFromObj\fR. +.TP +\fBTK_OPTION_PIXELS\fR +The value must specify a screen distance such as \fB2i\fR or \fB6.4\fR. +The internal form is an integer value giving a +distance in pixels, like the values returned by +\fBTk_GetPixelsFromObj\fR. Note: if the \fIobjOffset\fR field isn't +used then information about the original value of this option will be lost. +See \fBOBJOFFSET VS. INTERNALOFFSET\fR below for details. +.TP +\fBTK_OPTION_RELIEF\fR +The value must be standard relief such as \fBraised\fR. +The internal form is an integer relief value such as +TK_RELIEF_RAISED. +.TP +\fBTK_OPTION_STRING\fR +The value may be any string. The internal form is a (char *) pointer +that points to a dynamically allocated copy of the value. +This option type supports the TK_OPTION_NULL_OK flag. +.TP +\fBTK_OPTION_STRING_TABLE\fR +For this type, \fIclientData\fR is a pointer to an array of strings +suitable for passing to \fBTcl_GetIndexFromObj\fR. The value must +be one of the strings in the table, or a unique abbreviation of +one of the strings. The internal form is an integer giving the index +into the table of the matching string, like the return value +from \fBTcl_GetStringFromObj\fR. +.TP +\fBTK_OPTION_SYNONYM\fR +This type is used to provide alternative names for an option (for +example, \fB\-bg\fR is often used as a synonym for \fB\-background\fR). +The \fBclientData\fR field is a (char *) pointer that gives +the name of another option in the same table. Whenever the +synonym option is used, the information from the other option +will be used instead. +.TP +\fBTK_OPTION_WINDOW\fR +The value must be a window path name. The internal form is a +\fBTk_Window\fR token for the window. +This option type requires \fItkwin\fR to be supplied to procedures +such as \fBTk_SetOptions\fR (in order to identify the application), +and it supports the TK_OPTION_NULL_OK flag. + +.SH "STORAGE MANAGEMENT ISSUES" +.PP +If a field of a widget record has its offset stored in the \fIobjOffset\fR +or \fIinternalOffset\fR field of a Tk_OptionSpec structure then the +procedures described here will handle all of the storage allocation and +resource management issues associated with the field. When the value +of an option is changed, \fBTk_SetOptions\fR (or \fBTk_FreeSavedOptions\fR +will automatically free any resources associated with the old value, such as +Tk_Fonts for TK_OPTION_FONT options or dynamically allocated memory for +TK_OPTION_STRING options. For an option stored as an object using the +\fIobjOffset\fR field of a Tk_OptionSpec, the widget record shares the +object pointed to by the \fIobjv\fR value from the call to +\fBTk_SetOptions\fR. The reference count for this object is incremented +when a pointer to it is stored in the widget record and decremented when +the option is modified. When the widget is deleted +\fBTk_FreeConfigOptions\fR should be invoked; it will free the resources +associated with all options and decrement reference counts for any +objects. +.PP +However, the widget code is responsible for storing NULL or \fBNone\fR in +all pointer and token fields before invoking \fBTk_InitOptions\fR. +This is needed to allow proper cleanup in the rare case where +an error occurs in \fBTk_InitOptions\fR. + +.SH "OBJOFFSET VS. INTERNALOFFSET" +.PP +In most cases it is simplest to use the \fIinternalOffset\fR field of +a Tk_OptionSpec structure and not the \fIobjOffset\fR field. This +makes the internal form of the value immediately available to the +widget code so the value doesn't have to be extracted from an object +each time it is used. However, there are two cases where the +\fIobjOffset\fR field is useful. The first case is for +TK_OPTION_PIXELS options. In this case, the internal form is +an integer pixel value that is valid only for a particular screen. +If the value of the option is retrieved, it will be returned as a simple +number. For example, after the command \fB.b configure \-borderwidth 2m\fR, +the command \fB.b configure \-borderwidth\fR might return 7, which is the +integer pixel value corresponding to \fB2m\fR. Unfortunately, this loses +the original screen-independent value. Thus for TK_OPTION_PIXELS options +it is better to use the \fIobjOffset\fR field. In this case the original +value of the option is retained in the object and can be returned when +the option is retrieved. In most cases it is convenient to use the +\fIinternalOffset\fR field field as well, so that the integer value is +immediately available for use in the widget code (alternatively, +\fBTk_GetPixelsFromObj\fR can be used to extract the integer value from +the object whenever it is needed). Note: the problem of losing information +on retrievals exists only for TK_OPTION_PIXELS options. +.PP +The second reason to use the \fIobjOffset\fR field is in order to +implement new types of options not supported by these procedures. +To implement a new type of option, use TK_OPTION_STRING as +the type in the Tk_OptionSpec structure and set the \fIobjOffset\fR field +but not the \fIinternalOffset\fR field. Then, after calling +\fBTk_SetOptions\fR, convert the object to internal form yourself. + +.SH KEYWORDS +anchor, bitmap, boolean, border, color, configuration option, +cursor, double, font, integer, justify, +pixels, relief, screen distance, synonym diff --git a/doc/TextLayout.3 b/doc/TextLayout.3 index 35eaf34..41b17af 100644 --- a/doc/TextLayout.3 +++ b/doc/TextLayout.3 @@ -4,10 +4,10 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: TextLayout.3,v 1.2 1998/09/14 18:22:54 stanton Exp $ +'\" RCS: @(#) $Id: TextLayout.3,v 1.3 1999/04/16 01:51:09 stanton Exp $ '\" .so man.macros -.TH Tk_ComputeTextLayout 3 "" Tk "Tk Library Procedures" +.TH Tk_ComputeTextLayout 3 8.1 Tk "Tk Library Procedures" .BS .SH NAME Tk_ComputeTextLayout, Tk_FreeTextLayout, Tk_DrawTextLayout, Tk_UnderlineTextLayout, Tk_PointToChar, Tk_CharBbox, Tk_DistanceToTextLayout, Tk_IntersectTextLayout, Tk_TextLayoutToPostscript \- routines to measure and display single-font, multi-line, justified text. @@ -55,7 +55,10 @@ lifetime of the text layout. .AP int numChars in The number of characters to consider from \fIstring\fR. If \fInumChars\fR is less than 0, then assumes \fIstring\fR is null -terminated and uses \fBstrlen(\fIstring\fB)\fR. +.VS 8.1 +terminated and uses \fBTcl_NumUtfChars\fR to determine the length of +\fIstring\fR. +.VE .AP int wrapLength in Longest permissible line length, in pixels. Lines in \fIstring\fR will automatically be broken at word boundaries and wrapped when they reach @@ -133,7 +136,14 @@ justified text. To measure and display simple single-font, single-line strings, refer to the documentation for \fBTk_MeasureChars\fR. There is no programming interface in the core of Tk that supports multi-font, multi-line text; support for that behavior must be built on top of -simpler layers. +simpler layers. +.VS 8.1 +Note that unlike the lower level text display routines, the functions +described here all operate on character-oriented lengths and indices +rather than byte-oriented values. See the description of +\fBTcl_UtfAtIndex\fR for more details on converting between character +and byte offsets. +.VE 8.1 .PP The routines described here are built on top of the programming interface described in the \fBTk_MeasureChars\fR documentation. Tab characters and diff --git a/doc/messageBox.n b/doc/messageBox.n index 927c120..d40dc17 100644 --- a/doc/messageBox.n +++ b/doc/messageBox.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. '\" -'\" RCS: @(#) $Id: messageBox.n,v 1.2 1998/09/14 18:22:58 stanton Exp $ +'\" RCS: @(#) $Id: messageBox.n,v 1.3 1999/04/16 01:51:09 stanton Exp $ '\" .so man.macros .TH tk_messageBox n 4.2 Tk "Tk Built-In Commands" @@ -80,7 +80,7 @@ and \fBcancel\fR. .SH EXAMPLE .CS set answer [tk_messageBox \-message "Really quit?" \-type yesno \-icon question] -case $answer { +switch -- $answer { yes exit no {tk_messageBox \-message "I know you like this application!" \-type ok} } @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: send.n,v 1.2 1998/09/14 18:23:00 stanton Exp $ +'\" RCS: @(#) $Id: send.n,v 1.3 1999/04/16 01:51:09 stanton Exp $ '\" .so man.macros .TH send n 4.0 Tk "Tk Built-In Commands" @@ -70,8 +70,8 @@ command. .SH SECURITY .PP -The \fBsend\fR command is potentially a serious security loophole, -since any application that can connect to your X server can send +The \fBsend\fR command is potentially a serious security loophole. On Unix, +any application that can connect to your X server can send scripts to your applications. These incoming scripts can use Tcl to read and write your files and invoke subprocesses under your name. @@ -87,6 +87,11 @@ list of enabled hosts is empty. This means that applications cannot connect to your server unless they use some other form of authorization such as that provide by \fBxauth\fR. - +.VS +Under Windows, \fBsend\fR is currently disabled. Most of the +functionality is provided by the \fBdde\fR command instead. +.VE .SH KEYWORDS -application, name, remote execution, security, send +.VS +application, dde, name, remote execution, security, send +.VE diff --git a/generic/prolog.ps b/generic/prolog.ps new file mode 100644 index 0000000..2971a8a --- /dev/null +++ b/generic/prolog.ps @@ -0,0 +1,284 @@ +%%BeginProlog +50 dict begin + +% This is a standard prolog for Postscript generated by Tk's canvas +% widget. +% RCS: @(#) $Id: prolog.ps,v 1.2 1999/04/16 01:51:09 stanton Exp $ + +% 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). + +/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 + +% Define the array ISOLatin1Encoding (which specifies how characters are +% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript +% level 2 is supposed to define it, but level 1 doesn't). + +systemdict /ISOLatin1Encoding known not { + /ISOLatin1Encoding [ + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /space /exclam /quotedbl /numbersign /dollar /percent /ampersand + /quoteright + /parenleft /parenright /asterisk /plus /comma /minus /period /slash + /zero /one /two /three /four /five /six /seven + /eight /nine /colon /semicolon /less /equal /greater /question + /at /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 /bracketleft /backslash /bracketright /asciicircum /underscore + /quoteleft /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 /braceleft /bar /braceright /asciitilde /space + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent + /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron + /space /exclamdown /cent /sterling /currency /yen /brokenbar /section + /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen + /registered /macron + /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph + /periodcentered + /cedillar /onesuperior /ordmasculine /guillemotright /onequarter + /onehalf /threequarters /questiondown + /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla + /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex + /Idieresis + /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply + /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn + /germandbls + /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla + /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex + /idieresis + /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide + /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn + /ydieresis + ] def +} if + +% font ISOEncode font +% This procedure changes the encoding of a font from the default +% Postscript encoding to ISOLatin1. It's typically invoked just +% before invoking "setfont". The body of this procedure comes from +% Section 5.6.1 of the Postscript book. + +/ISOEncode { + dup length dict begin + {1 index /FID ne {def} {pop pop} ifelse} forall + /Encoding ISOLatin1Encoding 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 + + % 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 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. + +/AdjustColor { + CL 2 lt { + currentgray + CL 0 eq { + .5 lt {0} {1} ifelse + } 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 { + stringwidth pop + dup lineLength gt {/lineLength exch def} {pop} ifelse + 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. + + strings { + dup stringwidth 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 + { + char 0 3 -1 roll put + currentpoint + gsave + char true charpath clip StippleText + grestore + char stringwidth translate + moveto + } forall + grestore + } {show} ifelse + 0 spacing neg translate + } forall +} bind def + +%%EndProlog diff --git a/generic/tk.decls b/generic/tk.decls index 6d301f5..9fb67fd 100644 --- a/generic/tk.decls +++ b/generic/tk.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tk.decls,v 1.2 1999/03/10 07:04:38 stanton Exp $ +# RCS: @(#) $Id: tk.decls,v 1.3 1999/04/16 01:51:09 stanton Exp $ library tk @@ -77,7 +77,7 @@ declare 8 generic { declare 9 generic { int Tk_CanvasGetCoord (Tcl_Interp *interp, \ - Tk_Canvas canvas, char *string, double *doublePtr) + Tk_Canvas canvas, char *str, double *doublePtr) } declare 10 generic { @@ -186,7 +186,7 @@ declare 30 generic { declare 31 generic { Tk_TextLayout Tk_ComputeTextLayout (Tk_Font font, \ - CONST char *string, int numChars, int wrapLength, \ + CONST char *str, int numChars, int wrapLength, \ Tk_Justify justify, int flags, int *widthPtr, \ int *heightPtr) } @@ -198,7 +198,7 @@ declare 32 generic { declare 33 generic { unsigned long Tk_CreateBinding (Tcl_Interp *interp, \ Tk_BindingTable bindingTable, ClientData object, \ - char *eventString, char *command, int append) + char *eventStr, char *command, int append) } declare 34 generic { @@ -251,8 +251,8 @@ declare 43 generic { } declare 44 generic { - int Tk_DefineBitmap (Tcl_Interp *interp, \ - Tk_Uid name, char *source, int width, int height) + int Tk_DefineBitmap (Tcl_Interp *interp, CONST char *name, char *source, \ + int width, int height) } declare 45 generic { @@ -266,7 +266,7 @@ declare 46 generic { declare 47 generic { int Tk_DeleteBinding (Tcl_Interp *interp, \ Tk_BindingTable bindingTable, ClientData object, \ - char *eventString) + char *eventStr) } declare 48 generic { @@ -315,22 +315,19 @@ declare 57 generic { } declare 58 generic { - void Tk_Draw3DRectangle (Tk_Window tkwin, \ - Drawable drawable, Tk_3DBorder border, int x, \ - int y, int width, int height, int borderWidth, \ - int relief) + void Tk_Draw3DRectangle (Tk_Window tkwin, Drawable drawable, \ + Tk_3DBorder border, int x, int y, int width, int height, \ + int borderWidth, int relief) } declare 59 generic { - void Tk_DrawChars (Display *display, \ - Drawable drawable, GC gc, Tk_Font tkfont, \ - CONST char *source, int numChars, int x, \ - int y) + void Tk_DrawChars (Display *display, Drawable drawable, GC gc, \ + Tk_Font tkfont, CONST char *source, int numBytes, int x, int y) } declare 60 generic { - void Tk_DrawFocusHighlight (Tk_Window tkwin, \ - GC gc, int width, Drawable drawable) + void Tk_DrawFocusHighlight (Tk_Window tkwin, GC gc, int width, \ + Drawable drawable) } declare 61 generic { @@ -430,7 +427,7 @@ declare 81 generic { declare 82 generic { int Tk_GetAnchor (Tcl_Interp *interp, \ - char *string, Tk_Anchor *anchorPtr) + char *str, Tk_Anchor *anchorPtr) } declare 83 generic { @@ -440,11 +437,11 @@ declare 83 generic { declare 84 generic { char * Tk_GetBinding (Tcl_Interp *interp, \ Tk_BindingTable bindingTable, ClientData object, \ - char *eventString) + char *eventStr) } declare 85 generic { - Pixmap Tk_GetBitmap (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid string) + Pixmap Tk_GetBitmap (Tcl_Interp *interp, Tk_Window tkwin, CONST char * str) } declare 86 generic { @@ -453,7 +450,7 @@ declare 86 generic { } declare 87 generic { - int Tk_GetCapStyle (Tcl_Interp *interp, char *string, int *capPtr) + int Tk_GetCapStyle (Tcl_Interp *interp, char *str, int *capPtr) } declare 88 generic { @@ -465,12 +462,12 @@ declare 89 generic { } declare 90 generic { - Colormap Tk_GetColormap (Tcl_Interp *interp, Tk_Window tkwin, char *string) + Colormap Tk_GetColormap (Tcl_Interp *interp, Tk_Window tkwin, char *str) } declare 91 generic { Tk_Cursor Tk_GetCursor (Tcl_Interp *interp, Tk_Window tkwin, \ - Tk_Uid string) + Tk_Uid str) } declare 92 generic { @@ -482,12 +479,11 @@ declare 92 generic { declare 93 generic { Tk_Font Tk_GetFont (Tcl_Interp *interp, \ - Tk_Window tkwin, CONST char *string) + Tk_Window tkwin, CONST char *str) } declare 94 generic { - Tk_Font Tk_GetFontFromObj (Tcl_Interp *interp, \ - Tk_Window tkwin, Tcl_Obj *objPtr) + Tk_Font Tk_GetFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) } declare 95 generic { @@ -513,12 +509,12 @@ declare 99 generic { } declare 100 generic { - int Tk_GetJoinStyle (Tcl_Interp *interp, char *string, int *joinPtr) + int Tk_GetJoinStyle (Tcl_Interp *interp, char *str, int *joinPtr) } declare 101 generic { int Tk_GetJustify (Tcl_Interp *interp, \ - char *string, Tk_Justify *justifyPtr) + char *str, Tk_Justify *justifyPtr) } declare 102 generic { @@ -531,7 +527,7 @@ declare 103 generic { declare 104 generic { int Tk_GetPixels (Tcl_Interp *interp, \ - Tk_Window tkwin, char *string, int *intPtr) + Tk_Window tkwin, char *str, int *intPtr) } declare 105 generic { @@ -554,7 +550,7 @@ declare 108 generic { declare 109 generic { int Tk_GetScreenMM (Tcl_Interp *interp, \ - Tk_Window tkwin, char *string, double *doublePtr) + Tk_Window tkwin, char *str, double *doublePtr) } declare 110 generic { @@ -564,12 +560,12 @@ declare 110 generic { } declare 111 generic { - Tk_Uid Tk_GetUid (CONST char *string) + Tk_Uid Tk_GetUid (CONST char *str) } declare 112 generic { Visual * Tk_GetVisual (Tcl_Interp *interp, \ - Tk_Window tkwin, char *string, int *depthPtr, \ + Tk_Window tkwin, char *str, int *depthPtr, \ Colormap *colormapPtr) } @@ -632,7 +628,7 @@ declare 125 generic { declare 126 generic { int Tk_MeasureChars (Tk_Font tkfont, \ - CONST char *source, int maxChars, int maxPixels, \ + CONST char *source, int numBytes, int maxPixels, \ int flags, int *lengthPtr) } @@ -850,7 +846,7 @@ declare 175 generic { } declare 176 generic { - int Tk_TextWidth (Tk_Font font, CONST char *string, int numChars) + int Tk_TextWidth (Tk_Font font, CONST char *str, int numBytes) } declare 177 generic { @@ -860,8 +856,8 @@ declare 177 generic { declare 178 generic { void Tk_UnderlineChars (Display *display, \ Drawable drawable, GC gc, Tk_Font tkfont, \ - CONST char *source, int x, int y, int firstChar, \ - int lastChar) + CONST char *source, int x, int y, int firstByte, \ + int lastByte) } declare 179 generic { @@ -890,6 +886,152 @@ declare 184 generic { void Tk_UpdatePointer (Tk_Window tkwin, int x, int y, int state) } +# new functions for 8.1 + +declare 185 generic { + Pixmap Tk_AllocBitmapFromObj (Tcl_Interp *interp, Tk_Window tkwin, \ + Tcl_Obj *objPtr) +} + +declare 186 generic { + Tk_3DBorder Tk_Alloc3DBorderFromObj (Tcl_Interp *interp, Tk_Window tkwin, \ + Tcl_Obj *objPtr) +} + +declare 187 generic { + XColor * Tk_AllocColorFromObj (Tcl_Interp *interp, Tk_Window tkwin, \ + Tcl_Obj *objPtr) +} + +declare 188 generic { + Tk_Cursor Tk_AllocCursorFromObj (Tcl_Interp *interp, Tk_Window tkwin, \ + Tcl_Obj *objPtr) +} + +declare 189 generic { + Tk_Font Tk_AllocFontFromObj (Tcl_Interp *interp, Tk_Window tkwin, \ + Tcl_Obj *objPtr) + +} + +declare 190 generic { + Tk_OptionTable Tk_CreateOptionTable (Tcl_Interp *interp, \ + CONST Tk_OptionSpec *templatePtr) +} + +declare 191 generic { + void Tk_DeleteOptionTable (Tk_OptionTable optionTable) +} + +declare 192 generic { + void Tk_Free3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 193 generic { + void Tk_FreeBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 194 generic { + void Tk_FreeColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 195 generic { + void Tk_FreeConfigOptions (char *recordPtr, Tk_OptionTable optionToken, \ + Tk_Window tkwin) + +} + +declare 196 generic { + void Tk_FreeSavedOptions (Tk_SavedOptions *savePtr) +} + +declare 197 generic { + void Tk_FreeCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 198 generic { + void Tk_FreeFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 199 generic { + Tk_3DBorder Tk_Get3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 200 generic { + int Tk_GetAnchorFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, \ + Tk_Anchor *anchorPtr) +} + +declare 201 generic { + Pixmap Tk_GetBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 202 generic { + XColor * Tk_GetColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 203 generic { + Tk_Cursor Tk_GetCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr) +} + +declare 204 generic { + Tcl_Obj * Tk_GetOptionInfo (Tcl_Interp *interp, \ + char *recordPtr, Tk_OptionTable optionTable, \ + Tcl_Obj *namePtr, Tk_Window tkwin) +} + +declare 205 generic { + Tcl_Obj * Tk_GetOptionValue (Tcl_Interp *interp, char *recordPtr, \ + Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin) +} + +declare 206 generic { + int Tk_GetJustifyFromObj (Tcl_Interp *interp, \ + Tcl_Obj *objPtr, Tk_Justify *justifyPtr) +} + +declare 207 generic { + int Tk_GetMMFromObj (Tcl_Interp *interp, \ + Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr) +} + +declare 208 generic { + int Tk_GetPixelsFromObj (Tcl_Interp *interp, \ + Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr) +} + +declare 209 generic { + int Tk_GetReliefFromObj (Tcl_Interp *interp, \ + Tcl_Obj *objPtr, int *resultPtr) +} + +declare 210 generic { + int Tk_GetScrollInfoObj (Tcl_Interp *interp, \ + int objc, Tcl_Obj *CONST objv[], double *dblPtr, int *intPtr) +} + +declare 211 generic { + int Tk_InitOptions ( + Tcl_Interp *interp, char *recordPtr, \ + Tk_OptionTable optionToken, Tk_Window tkwin) +} + +declare 212 generic { + void Tk_MainEx (int argc, char **argv, Tcl_AppInitProc *appInitProc, \ + Tcl_Interp *interp) +} + +declare 213 generic { + void Tk_RestoreSavedOptions (Tk_SavedOptions *savePtr) +} + +declare 214 generic { + 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) +} + # Define the platform specific public Tk interface. These functions are # only available on the designated platform. diff --git a/generic/tk.h b/generic/tk.h index 69ca6a7..11c0433 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -6,13 +6,13 @@ * * Copyright (c) 1989-1994 The Regents of the University of California. * Copyright (c) 1994 The Australian National University. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1994-1998 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. * - * RCS: @(#) $Id: tk.h,v 1.20 1999/03/10 07:04:38 stanton Exp $ + * RCS: @(#) $Id: tk.h,v 1.21 1999/04/16 01:51:09 stanton Exp $ */ #ifndef _TK @@ -22,39 +22,26 @@ * When version numbers change here, you must also go into the following files * and update the version numbers: * - * README * unix/configure.in * win/makefile.bc * win/makefile.vc - * win/README - * mac/README - * library/tk.tcl (Not for patch release updates) - * - * The release level should be 0 for alpha, 1 for beta, and 2 for - * final/patch. The release serial value is the number that follows the - * "a", "b", or "p" in the patch level; for example, if the patch level - * is 4.3b2, TK_RELEASE_SERIAL is 2. It restarts at 1 whenever the - * release level is changed, except for the final release, which should - * be 0. - * + * README + * library/tk.tcl (only if major.minor changes, not patchlevel) + * mac/README (only if major.minor changes, not patchlevel) + * win/README (only if major.minor changes, not patchlevel) + * unix/README (only if major.minor changes, not patchlevel) + * You may also need to update some of these files when the numbers change * for the version of Tcl that this release of Tk is compiled against. */ #define TK_MAJOR_VERSION 8 -#define TK_MINOR_VERSION 0 -#define TK_RELEASE_LEVEL 2 -#define TK_RELEASE_SERIAL 5 +#define TK_MINOR_VERSION 1 +#define TK_RELEASE_LEVEL TCL_BETA_RELEASE +#define TK_RELEASE_SERIAL 3 -#define TK_VERSION "8.0" -#define TK_PATCH_LEVEL "8.0.5" - -/* - * A special definition used to allow this header file to be included - * in resource files. - */ - -#ifndef RESOURCE_INCLUDED +#define TK_VERSION "8.1" +#define TK_PATCH_LEVEL "8.1b3" /* * The following definitions set up the proper options for Macintosh @@ -70,6 +57,14 @@ #ifndef _TCL # include <tcl.h> #endif + +/* + * A special definition used to allow this header file to be included + * in resource files. + */ + +#ifndef RESOURCE_INCLUDED + #ifndef _XLIB_H # ifdef MAC_TCL # include <Xlib.h> @@ -82,15 +77,9 @@ # include <stddef.h> #endif -#undef TCL_STORAGE_CLASS #ifdef BUILD_tk +# undef TCL_STORAGE_CLASS # define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TK_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif #endif /* @@ -112,6 +101,7 @@ typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler; typedef struct Tk_Font_ *Tk_Font; typedef struct Tk_Image__ *Tk_Image; typedef struct Tk_ImageMaster_ *Tk_ImageMaster; +typedef struct Tk_OptionTable_ *Tk_OptionTable; typedef struct Tk_TextLayout_ *Tk_TextLayout; typedef struct Tk_Window_ *Tk_Window; typedef struct Tk_3DBorder_ *Tk_3DBorder; @@ -123,54 +113,164 @@ typedef struct Tk_3DBorder_ *Tk_3DBorder; typedef char *Tk_Uid; /* - * Structure used to specify how to handle argv options. + * The enum below defines the valid types for Tk configuration options + * as implemented by Tk_InitOptions, Tk_SetOptions, etc. */ -typedef struct { - 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 option. */ -} Tk_ArgvInfo; +typedef enum { + TK_OPTION_BOOLEAN, + TK_OPTION_INT, + TK_OPTION_DOUBLE, + TK_OPTION_STRING, + TK_OPTION_STRING_TABLE, + TK_OPTION_COLOR, + TK_OPTION_FONT, + TK_OPTION_BITMAP, + TK_OPTION_BORDER, + TK_OPTION_RELIEF, + TK_OPTION_CURSOR, + TK_OPTION_JUSTIFY, + TK_OPTION_ANCHOR, + TK_OPTION_SYNONYM, + TK_OPTION_PIXELS, + TK_OPTION_WINDOW, + TK_OPTION_END +} Tk_OptionType; /* - * Legal values for the type field of a Tk_ArgvInfo: see the user - * documentation for details. + * Structures of the following type are used by widgets to specify + * their configuration options. Typically each widget has a static + * array of these structures, where each element of the array describes + * a single configuration option. The array is passed to + * Tk_CreateOptionTable. */ -#define TK_ARGV_CONSTANT 15 -#define TK_ARGV_INT 16 -#define TK_ARGV_STRING 17 -#define TK_ARGV_UID 18 -#define TK_ARGV_REST 19 -#define TK_ARGV_FLOAT 20 -#define TK_ARGV_FUNC 21 -#define TK_ARGV_GENFUNC 22 -#define TK_ARGV_HELP 23 -#define TK_ARGV_CONST_OPTION 24 -#define TK_ARGV_OPTION_VALUE 25 -#define TK_ARGV_OPTION_NAME_VALUE 26 -#define TK_ARGV_END 27 +typedef struct Tk_OptionSpec { + Tk_OptionType type; /* Type of option, such as TK_OPTION_COLOR; + * see definitions above. Last option in + * table must have type TK_OPTION_END. */ + char *optionName; /* Name used to specify option in Tcl + * commands. */ + char *dbName; /* Name for option in option database. */ + char *dbClass; /* Class for option in database. */ + char *defValue; /* Default value for option if not specified + * in command line, the option database, + * or the system. */ + int objOffset; /* Where in record to store a Tcl_Obj * that + * holds the value of this option, specified + * as an offset in bytes from the start of + * the record. Use the Tk_Offset macro to + * generate values for this. -1 means don't + * store the Tcl_Obj in the record. */ + int internalOffset; /* Where in record to store the internal + * representation of the value of this option, + * such as an int or XColor *. This field + * is specified as an offset in bytes + * from the start of the record. Use the + * Tk_Offset macro to generate values for it. + * -1 means don't store the internal + * representation in the record. */ + int flags; /* Any combination of the values defined + * below. */ + ClientData 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 manager; typically bits correspond + * to certain kinds of options such as all + * those that require a redisplay when they + * change. Tk_SetOptions returns the bit-wise + * OR of the typeMasks of all options that + * were changed. */ +} Tk_OptionSpec; /* - * Flag bits for passing to Tk_ParseArgv: + * Flag values for Tk_OptionSpec structures. These flags are shared by + * Tk_ConfigSpec structures, so be sure to coordinate any changes + * carefully. */ -#define TK_ARGV_NO_DEFAULTS 0x1 -#define TK_ARGV_NO_LEFTOVERS 0x2 -#define TK_ARGV_NO_ABBREV 0x4 -#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8 +#define TK_OPTION_NULL_OK 1 + +/* + * Macro to use to fill in "offset" fields of Tk_OptionSpecs. + * Computes number of bytes from beginning of structure to a + * given field. + */ + +#ifdef offsetof +#define Tk_Offset(type, field) ((int) offsetof(type, field)) +#else +#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field)) +#endif + +/* + * The following two structures are used for error handling. When + * configuration options are being modified, the old values are + * saved in a Tk_SavedOptions structure. If an error occurs, then the + * contents of the structure can be used to restore all of the old + * values. The contents of this structure are for the private use + * Tk. No-one outside Tk should ever read or write any of the fields + * of these structures. + */ + +typedef struct Tk_SavedOption { + struct TkOption *optionPtr; /* Points to information that describes + * the option. */ + Tcl_Obj *valuePtr; /* The old value of the option, in + * the form of a Tcl object; may be + * NULL if the value wasn't saved as + * an object. */ + double internalForm; /* The old value of the option, in + * some internal representation such + * as an int or (XColor *). Valid + * only if optionPtr->specPtr->objOffset + * is < 0. The space must be large + * enough to accommodate a double, a + * long, or a pointer; right now it + * looks like a double is big + * enough. Also, using a double + * guarantees that the field is + * properly aligned for storing large + * values. */ +} Tk_SavedOption; + +#ifdef TCL_MEM_DEBUG +# define TK_NUM_SAVED_OPTIONS 2 +#else +# define TK_NUM_SAVED_OPTIONS 20 +#endif + +typedef struct Tk_SavedOptions { + char *recordPtr; /* The data structure in which to + * restore configuration options. */ + Tk_Window tkwin; /* Window associated with recordPtr; + * needed to restore certain options. */ + int numItems; /* The number of valid items in + * items field. */ + Tk_SavedOption items[TK_NUM_SAVED_OPTIONS]; + /* Items used to hold old values. */ + struct Tk_SavedOptions *nextPtr; /* Points to next structure in list; + * needed if too many options changed + * to hold all the old values in a + * single structure. NULL means no + * more structures. */ +} Tk_SavedOptions; /* * Structure used to describe application-specific configuration * options: indicates procedures to call to parse an option and - * to return a text string describing an option. + * to return a text string describing an option. THESE ARE + * DEPRECATED; PLEASE USE THE NEW STRUCTURES LISTED ABOVE. + */ + +/* + * This is a temporary flag used while tkObjConfig and new widgets + * are in development. */ +#ifndef __NO_OLD_CONFIG + typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec, int offset)); @@ -224,40 +324,15 @@ typedef struct Tk_ConfigSpec { * documentation for details. */ -#define TK_CONFIG_BOOLEAN 1 -#define TK_CONFIG_INT 2 -#define TK_CONFIG_DOUBLE 3 -#define TK_CONFIG_STRING 4 -#define TK_CONFIG_UID 5 -#define TK_CONFIG_COLOR 6 -#define TK_CONFIG_FONT 7 -#define TK_CONFIG_BITMAP 8 -#define TK_CONFIG_BORDER 9 -#define TK_CONFIG_RELIEF 10 -#define TK_CONFIG_CURSOR 11 -#define TK_CONFIG_ACTIVE_CURSOR 12 -#define TK_CONFIG_JUSTIFY 13 -#define TK_CONFIG_ANCHOR 14 -#define TK_CONFIG_SYNONYM 15 -#define TK_CONFIG_CAP_STYLE 16 -#define TK_CONFIG_JOIN_STYLE 17 -#define TK_CONFIG_PIXELS 18 -#define TK_CONFIG_MM 19 -#define TK_CONFIG_WINDOW 20 -#define TK_CONFIG_CUSTOM 21 -#define TK_CONFIG_END 22 - -/* - * Macro to use to fill in "offset" fields of Tk_ConfigInfos. - * Computes number of bytes from beginning of structure to a - * given field. - */ - -#ifdef offsetof -#define Tk_Offset(type, field) ((int) offsetof(type, field)) -#else -#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field)) -#endif +typedef enum { + TK_CONFIG_BOOLEAN, TK_CONFIG_INT, TK_CONFIG_DOUBLE, TK_CONFIG_STRING, + TK_CONFIG_UID, TK_CONFIG_COLOR, TK_CONFIG_FONT, TK_CONFIG_BITMAP, + TK_CONFIG_BORDER, TK_CONFIG_RELIEF, TK_CONFIG_CURSOR, + TK_CONFIG_ACTIVE_CURSOR, TK_CONFIG_JUSTIFY, TK_CONFIG_ANCHOR, + TK_CONFIG_SYNONYM, TK_CONFIG_CAP_STYLE, TK_CONFIG_JOIN_STYLE, + TK_CONFIG_PIXELS, TK_CONFIG_MM, TK_CONFIG_WINDOW, TK_CONFIG_CUSTOM, + TK_CONFIG_END +} Tk_ConfigTypes; /* * Possible values for flags argument to Tk_ConfigureWidget: @@ -266,18 +341,62 @@ typedef struct Tk_ConfigSpec { #define TK_CONFIG_ARGV_ONLY 1 /* - * Possible flag values for Tk_ConfigInfo structures. Any bits at + * Possible flag values for Tk_ConfigSpec structures. Any bits at * or above TK_CONFIG_USER_BIT may be used by clients for selecting * certain entries. Before changing any values here, coordinate with - * tkConfig.c (internal-use-only flags are defined there). + * tkOldConfig.c (internal-use-only flags are defined there). */ -#define TK_CONFIG_COLOR_ONLY 1 -#define TK_CONFIG_MONO_ONLY 2 -#define TK_CONFIG_NULL_OK 4 +#define TK_CONFIG_NULL_OK 1 +#define TK_CONFIG_COLOR_ONLY 2 +#define TK_CONFIG_MONO_ONLY 4 #define TK_CONFIG_DONT_SET_DEFAULT 8 #define TK_CONFIG_OPTION_SPECIFIED 0x10 #define TK_CONFIG_USER_BIT 0x100 +#endif /* __NO_OLD_CONFIG */ + +/* + * Structure used to specify how to handle argv options. + */ + +typedef struct { + 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 option. */ +} Tk_ArgvInfo; + +/* + * Legal values for the type field of a Tk_ArgvInfo: see the user + * documentation for details. + */ + +#define TK_ARGV_CONSTANT 15 +#define TK_ARGV_INT 16 +#define TK_ARGV_STRING 17 +#define TK_ARGV_UID 18 +#define TK_ARGV_REST 19 +#define TK_ARGV_FLOAT 20 +#define TK_ARGV_FUNC 21 +#define TK_ARGV_GENFUNC 22 +#define TK_ARGV_HELP 23 +#define TK_ARGV_CONST_OPTION 24 +#define TK_ARGV_OPTION_VALUE 25 +#define TK_ARGV_OPTION_NAME_VALUE 26 +#define TK_ARGV_END 27 + +/* + * Flag bits for passing to Tk_ParseArgv: + */ + +#define TK_ARGV_NO_DEFAULTS 0x1 +#define TK_ARGV_NO_LEFTOVERS 0x2 +#define TK_ARGV_NO_ABBREV 0x4 +#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8 /* * Enumerated type for describing actions to be taken in response @@ -302,12 +421,12 @@ typedef enum { * Relief values returned by Tk_GetRelief: */ -#define TK_RELIEF_RAISED 1 -#define TK_RELIEF_FLAT 2 -#define TK_RELIEF_SUNKEN 4 -#define TK_RELIEF_GROOVE 8 -#define TK_RELIEF_RIDGE 16 -#define TK_RELIEF_SOLID 32 +#define TK_RELIEF_FLAT 0 +#define TK_RELIEF_GROOVE 1 +#define TK_RELIEF_RAISED 2 +#define TK_RELIEF_RIDGE 3 +#define TK_RELIEF_SOLID 4 +#define TK_RELIEF_SUNKEN 5 /* * "Which" argument values for Tk_3DBorderGC: @@ -740,6 +859,8 @@ typedef void Tk_ItemInsertProc _ANSI_ARGS_((Tk_Canvas canvas, typedef void Tk_ItemDCharsProc _ANSI_ARGS_((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 "line". */ @@ -793,6 +914,8 @@ typedef struct Tk_ItemType { char *reserved4; } Tk_ItemType; +#endif + /* * The following structure provides information about the selection and * the insertion cursor. It is needed by only a few items, such as @@ -811,16 +934,17 @@ typedef struct Tk_CanvasTextInfo { Tk_Item *selItemPtr; /* Pointer to selected item. NULL means * selection isn't in this canvas. * Writable by items. */ - int selectFirst; /* Index of first selected character. - * Writable by items. */ - int selectLast; /* Index of last selected character. - * Writable by items. */ + int selectFirst; /* Character index of first selected + * character. Writable by items. */ + int selectLast; /* Character index of last selected + * character. Writable by items. */ Tk_Item *anchorItemPtr; /* Item corresponding to "selectAnchor": * not necessarily selItemPtr. Read-only * to items. */ - int selectAnchor; /* Fixed end of selection (i.e. "select to" - * operation will use this as one end of the - * selection). Writable by items. */ + int selectAnchor; /* Character index of fixed end of + * selection (i.e. "select to" operation will + * use this as one end of the selection). + * Writable by items. */ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion * cursor. Read-only to items. */ int insertWidth; /* Total width of insertion cursor. Read-only @@ -1023,11 +1147,27 @@ struct Tk_PhotoImageFormat { #define Tk_DoWhenIdle Tcl_DoWhenIdle #define Tk_Sleep Tcl_Sleep +/* Additional stuff that has moved to Tcl: */ + +#define Tk_AfterCmd Tcl_AfterCmd #define Tk_EventuallyFree Tcl_EventuallyFree #define Tk_FreeProc Tcl_FreeProc #define Tk_Preserve Tcl_Preserve #define Tk_Release Tcl_Release -#define Tk_FileeventCmd Tcl_FileEventCmd + +/* Removed Tk_Main, use macro instead */ +#define Tk_Main(argc, argv, proc) \ + Tk_MainEx(argc, argv, proc, Tcl_CreateInterp()) + +char *Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version, int exact)); + +#ifndef USE_TK_STUBS + +#define Tk_InitStubs(interp, version, exact) \ + Tcl_PkgRequire(interp, "Tk", version, exact) + +#endif + /* *-------------------------------------------------------------- @@ -1051,32 +1191,20 @@ typedef Tk_RestrictAction (Tk_RestrictProc) _ANSI_ARGS_(( typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); - /* - * Public functions that are not accessible via the stubs table. + *-------------------------------------------------------------- + * + * Exported procedures and variables. + * + *-------------------------------------------------------------- */ -EXTERN void Tk_Main _ANSI_ARGS_((int argc, char **argv, - Tcl_AppInitProc *appInitProc)); -EXTERN void Tk_MainEx _ANSI_ARGS_((int argc, char **argv, - Tcl_AppInitProc *appInitProc, Tcl_Interp *interp)); +#include "tkDecls.h" /* - * Stubs initialization function. This function should be invoked before - * any other Tk functions in a stubs-aware extension. Tk_InitStubs is - * implemented in the stub library, not the main Tk library. In directly - * linked code, this function turns into a call to Tcl_PkgRequire(). + * Tcl commands exported by Tk: */ -EXTERN char * Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, - char *version, int exact)); - -#ifndef USE_TK_STUBS -#define Tk_InitStubs(interp, version, exact) \ - Tcl_PkgRequire(interp, "Tk", version, exact) -#endif - -#include "tkDecls.h" #endif /* RESOURCE_INCLUDED */ diff --git a/generic/tk3d.c b/generic/tk3d.c index ae049c9..cd5343a 100644 --- a/generic/tk3d.c +++ b/generic/tk3d.c @@ -10,36 +10,153 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tk3d.c,v 1.2 1998/09/14 18:23:02 stanton Exp $ + * RCS: @(#) $Id: tk3d.c,v 1.3 1999/04/16 01:51:10 stanton Exp $ */ -#include <tk3d.h> +#include "tk3d.h" /* - * Hash table to map from a border's values (color, etc.) to a - * Border structure for those values. + * The following table defines the string values for reliefs, which are + * used by Tk_GetReliefFromObj. */ -static Tcl_HashTable borderTable; -typedef struct { - Tk_Uid colorName; /* Color for border. */ - Colormap colormap; /* Colormap used for allocating border - * colors. */ - Screen *screen; /* Screen on which border will be drawn. */ -} BorderKey; - -static int initialized = 0; /* 0 means static structures haven't - * been initialized yet. */ +static char *reliefStrings[] = {"flat", "groove", "raised", "ridge", "solid", + "sunken", (char *) NULL}; /* * Forward declarations for procedures defined in this file: */ -static void BorderInit _ANSI_ARGS_((void)); +static void BorderInit _ANSI_ARGS_((TkDisplay *dispPtr)); +static void DupBorderObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr, + Tcl_Obj *dupObjPtr)); +static void FreeBorderObjProc _ANSI_ARGS_((Tcl_Obj *objPtr)); static int Intersect _ANSI_ARGS_((XPoint *a1Ptr, XPoint *a2Ptr, XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr)); +static void InitBorderObj _ANSI_ARGS_((Tcl_Obj *objPtr)); static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr, int distance, XPoint *p3Ptr)); + +/* + * The following structure defines the implementation of the "border" Tcl + * object, used for drawing. The border object remembers the hash table entry + * associated with a border. The actual allocation and deallocation of the + * border should be done by the configuration package when the border option + * is set. + */ + +static Tcl_ObjType borderObjType = { + "border", /* name */ + FreeBorderObjProc, /* freeIntRepProc */ + DupBorderObjProc, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +/* + *---------------------------------------------------------------------- + * + * Tk_Alloc3DBorderFromObj -- + * + * Given a Tcl_Obj *, map the value to a corresponding + * Tk_3DBorder structure based on the tkwin given. + * + * Results: + * The return value is a token for a data structure describing a + * 3-D border. This token may be passed to procedures such as + * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented + * the border from being created then NULL is returned and an error + * message will be left in the interp's result. + * + * Side effects: + * The border is added to an internal database with a reference + * count. For each call to this procedure, there should eventually + * be a call to Tk_FreeBorderFromObj so that the database is + * cleaned up when borders aren't in use anymore. + * + *---------------------------------------------------------------------- + */ + +Tk_3DBorder +Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr) + Tcl_Interp *interp; /* Interp for error results. */ + Tk_Window tkwin; /* Need the screen the border is used on.*/ + Tcl_Obj *objPtr; /* Object giving name of color for window + * background. */ +{ + TkBorder *borderPtr; + + if (objPtr->typePtr != &borderObjType) { + InitBorderObj(objPtr); + } + borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1; + + /* + * If the object currently points to a TkBorder, see if it's the + * one we want. If so, increment its reference count and return. + */ + + if (borderPtr != NULL) { + if (borderPtr->resourceRefCount == 0) { + /* + * This is a stale reference: it refers to a border that's + * no longer in use. Clear the reference. + */ + + FreeBorderObjProc(objPtr); + borderPtr = NULL; + } else if ((Tk_Screen(tkwin) == borderPtr->screen) + && (Tk_Colormap(tkwin) == borderPtr->colormap)) { + borderPtr->resourceRefCount++; + return (Tk_3DBorder) borderPtr; + } + } + + /* + * 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. + * + * If the value is not NULL, the internal rep is the value + * of the color the last time this object was accessed. Check + * the screen and colormap of the last access, and if they + * match, we are done. + */ + + if (borderPtr != NULL) { + TkBorder *firstBorderPtr = + (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr); + FreeBorderObjProc(objPtr); + for (borderPtr = firstBorderPtr ; borderPtr != NULL; + borderPtr = borderPtr->nextPtr) { + if ((Tk_Screen(tkwin) == borderPtr->screen) + && (Tk_Colormap(tkwin) == borderPtr->colormap)) { + borderPtr->resourceRefCount++; + borderPtr->objRefCount++; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr; + return (Tk_3DBorder) borderPtr; + } + } + } + + /* + * Still no luck. Call Tk_Get3DBorder to allocate a new border. + */ + + borderPtr = (TkBorder *) Tk_Get3DBorder(interp, tkwin, + Tcl_GetString(objPtr)); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr; + if (borderPtr != NULL) { + borderPtr->objRefCount++; + } + return (Tk_3DBorder) borderPtr; +} /* *-------------------------------------------------------------- @@ -49,12 +166,11 @@ static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr, * Create a data structure for displaying a 3-D border. * * Results: - * The return value is a token for a data structure - * describing a 3-D border. This token may be passed - * to Tk_Draw3DRectangle and Tk_Free3DBorder. If an - * error prevented the border from being created then - * NULL is returned and an error message will be left - * in interp->result. + * The return value is a token for a data structure describing a + * 3-D border. This token may be passed to procedures such as + * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented + * the border from being created then NULL is returned and an error + * message will be left in the interp's result. * * Side effects: * Data structures, graphics contexts, etc. are allocated. @@ -69,70 +185,75 @@ Tk_Get3DBorder(interp, tkwin, colorName) Tcl_Interp *interp; /* Place to store an error message. */ Tk_Window tkwin; /* Token for window in which border will * be drawn. */ - Tk_Uid colorName; /* String giving name of color + char *colorName; /* String giving name of color * for window background. */ { - BorderKey key; Tcl_HashEntry *hashPtr; - register TkBorder *borderPtr; + TkBorder *borderPtr, *existingBorderPtr; int new; XGCValues gcValues; + XColor *bgColorPtr; + TkDisplay *dispPtr; - if (!initialized) { - BorderInit(); - } - - /* - * First, check to see if there's already a border that will work - * for this request. - */ + dispPtr = ((TkWindow *) tkwin)->dispPtr; - key.colorName = colorName; - key.colormap = Tk_Colormap(tkwin); - key.screen = Tk_Screen(tkwin); + if (!dispPtr->borderInit) { + BorderInit(dispPtr); + } - hashPtr = Tcl_CreateHashEntry(&borderTable, (char *) &key, &new); + hashPtr = Tcl_CreateHashEntry(&dispPtr->borderTable, colorName, &new); if (!new) { - borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr); - borderPtr->refCount++; + existingBorderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr); + for (borderPtr = existingBorderPtr; borderPtr != NULL; + borderPtr = borderPtr->nextPtr) { + if ((Tk_Screen(tkwin) == borderPtr->screen) + && (Tk_Colormap(tkwin) == borderPtr->colormap)) { + borderPtr->resourceRefCount++; + return (Tk_3DBorder) borderPtr; + } + } } else { - XColor *bgColorPtr; + existingBorderPtr = NULL; + } - /* - * No satisfactory border exists yet. Initialize a new one. - */ - - bgColorPtr = Tk_GetColor(interp, tkwin, colorName); - if (bgColorPtr == NULL) { + /* + * No satisfactory border exists yet. Initialize a new one. + */ + + bgColorPtr = Tk_GetColor(interp, tkwin, colorName); + if (bgColorPtr == NULL) { + if (new) { Tcl_DeleteHashEntry(hashPtr); - return NULL; } - - borderPtr = TkpGetBorder(); - borderPtr->screen = Tk_Screen(tkwin); - borderPtr->visual = Tk_Visual(tkwin); - borderPtr->depth = Tk_Depth(tkwin); - borderPtr->colormap = key.colormap; - borderPtr->refCount = 1; - borderPtr->bgColorPtr = bgColorPtr; - borderPtr->darkColorPtr = NULL; - borderPtr->lightColorPtr = NULL; - borderPtr->shadow = None; - borderPtr->bgGC = None; - borderPtr->darkGC = None; - borderPtr->lightGC = None; - borderPtr->hashPtr = hashPtr; - Tcl_SetHashValue(hashPtr, borderPtr); - - /* - * Create the information for displaying the background color, - * but delay the allocation of shadows until they are actually - * needed for drawing. - */ - - gcValues.foreground = borderPtr->bgColorPtr->pixel; - borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues); + return NULL; } + + borderPtr = TkpGetBorder(); + borderPtr->screen = Tk_Screen(tkwin); + borderPtr->visual = Tk_Visual(tkwin); + borderPtr->depth = Tk_Depth(tkwin); + borderPtr->colormap = Tk_Colormap(tkwin); + borderPtr->resourceRefCount = 1; + borderPtr->objRefCount = 0; + borderPtr->bgColorPtr = bgColorPtr; + borderPtr->darkColorPtr = NULL; + borderPtr->lightColorPtr = NULL; + borderPtr->shadow = None; + borderPtr->bgGC = None; + borderPtr->darkGC = None; + borderPtr->lightGC = None; + borderPtr->hashPtr = hashPtr; + borderPtr->nextPtr = existingBorderPtr; + Tcl_SetHashValue(hashPtr, borderPtr); + + /* + * Create the information for displaying the background color, + * but delay the allocation of shadows until they are actually + * needed for drawing. + */ + + gcValues.foreground = borderPtr->bgColorPtr->pixel; + borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues); return (Tk_3DBorder) borderPtr; } @@ -208,7 +329,7 @@ Tk_NameOf3DBorder(border) { TkBorder *borderPtr = (TkBorder *) border; - return ((BorderKey *) borderPtr->hashPtr->key.words)->colorName; + return borderPtr->hashPtr->key.string; } /* @@ -303,34 +424,51 @@ void Tk_Free3DBorder(border) Tk_3DBorder border; /* Token for border to be released. */ { - register TkBorder *borderPtr = (TkBorder *) border; + TkBorder *borderPtr = (TkBorder *) border; Display *display = DisplayOfScreen(borderPtr->screen); + TkBorder *prevPtr; - borderPtr->refCount--; - if (borderPtr->refCount == 0) { - TkpFreeBorder(borderPtr); - if (borderPtr->bgColorPtr != NULL) { - Tk_FreeColor(borderPtr->bgColorPtr); - } - if (borderPtr->darkColorPtr != NULL) { - Tk_FreeColor(borderPtr->darkColorPtr); - } - if (borderPtr->lightColorPtr != NULL) { - Tk_FreeColor(borderPtr->lightColorPtr); - } - if (borderPtr->shadow != None) { - Tk_FreeBitmap(display, borderPtr->shadow); - } - if (borderPtr->bgGC != None) { - Tk_FreeGC(display, borderPtr->bgGC); - } - if (borderPtr->darkGC != None) { - Tk_FreeGC(display, borderPtr->darkGC); + borderPtr->resourceRefCount--; + if (borderPtr->resourceRefCount > 0) { + return; + } + + prevPtr = (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr); + TkpFreeBorder(borderPtr); + if (borderPtr->bgColorPtr != NULL) { + Tk_FreeColor(borderPtr->bgColorPtr); + } + if (borderPtr->darkColorPtr != NULL) { + Tk_FreeColor(borderPtr->darkColorPtr); + } + if (borderPtr->lightColorPtr != NULL) { + Tk_FreeColor(borderPtr->lightColorPtr); + } + if (borderPtr->shadow != None) { + Tk_FreeBitmap(display, borderPtr->shadow); + } + if (borderPtr->bgGC != None) { + Tk_FreeGC(display, borderPtr->bgGC); + } + if (borderPtr->darkGC != None) { + Tk_FreeGC(display, borderPtr->darkGC); + } + if (borderPtr->lightGC != None) { + Tk_FreeGC(display, borderPtr->lightGC); + } + if (prevPtr == borderPtr) { + if (borderPtr->nextPtr == NULL) { + Tcl_DeleteHashEntry(borderPtr->hashPtr); + } else { + Tcl_SetHashValue(borderPtr->hashPtr, borderPtr->nextPtr); } - if (borderPtr->lightGC != None) { - Tk_FreeGC(display, borderPtr->lightGC); + } else { + while (prevPtr->nextPtr != borderPtr) { + prevPtr = prevPtr->nextPtr; } - Tcl_DeleteHashEntry(borderPtr->hashPtr); + prevPtr->nextPtr = borderPtr->nextPtr; + } + if (borderPtr->objRefCount == 0) { ckfree((char *) borderPtr); } } @@ -338,6 +476,105 @@ Tk_Free3DBorder(border) /* *---------------------------------------------------------------------- * + * Tk_Free3DBorderFromObj -- + * + * This procedure is called to release a border allocated by + * Tk_Alloc3DBorderFromObj. It does not throw away the Tcl_Obj *; + * it only gets rid of the hash table entry for this border + * and clears the cached value that is normally stored in the object. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with the border represented by + * objPtr is decremented, and the border's resources are released + * to X if there are no remaining uses for it. + * + *---------------------------------------------------------------------- + */ + +void +Tk_Free3DBorderFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window this border lives in. Needed + * for the screen and colormap values. */ + Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */ +{ + Tk_Free3DBorder(Tk_Get3DBorderFromObj(tkwin, objPtr)); +} + +/* + *--------------------------------------------------------------------------- + * + * FreeBorderObjProc -- + * + * 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 borderPtr needs to be changed. + * + * Results: + * None. + * + * Side effects: + * The object reference count is decremented. When both it + * and the hash ref count go to zero, the border's resources + * are released. + * + *--------------------------------------------------------------------------- + */ + +static void +FreeBorderObjProc(objPtr) + Tcl_Obj *objPtr; /* The object we are releasing. */ +{ + TkBorder *borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1; + + if (borderPtr != NULL) { + borderPtr->objRefCount--; + if ((borderPtr->objRefCount == 0) + && (borderPtr->resourceRefCount == 0)) { + ckfree((char *) borderPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; + } +} + +/* + *--------------------------------------------------------------------------- + * + * DupBorderObjProc -- + * + * When a cached border object is duplicated, this is called to + * update the internal reps. + * + * Results: + * None. + * + * Side effects: + * The border's objRefCount is incremented and the internal rep + * of the copy is set to point to it. + * + *--------------------------------------------------------------------------- + */ + +static void +DupBorderObjProc(srcObjPtr, dupObjPtr) + 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; + + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr; + + if (borderPtr != NULL) { + borderPtr->objRefCount++; + } +} + +/* + *---------------------------------------------------------------------- + * * Tk_SetBackgroundFromBorder -- * * Change the background of a window to one appropriate for a given @@ -365,6 +602,35 @@ Tk_SetBackgroundFromBorder(tkwin, border) /* *---------------------------------------------------------------------- * + * Tk_GetReliefFromObj -- + * + * Return an integer value based on the value of the objPtr. + * + * Results: + * The return value is a standard Tcl result. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * The object gets converted by Tcl_GetIndexFromObj. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetReliefFromObj(interp, objPtr, resultPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + Tcl_Obj *objPtr; /* The object we are trying to get the + * value from. */ + int *resultPtr; /* Where to place the answer. */ +{ + return Tcl_GetIndexFromObj(interp, objPtr, reliefStrings, "relief", 0, + resultPtr); +} + +/* + *---------------------------------------------------------------------- + * * Tk_GetRelief -- * * Parse a relief description and return the corresponding @@ -407,8 +673,11 @@ Tk_GetRelief(interp, name, reliefPtr) } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) { *reliefPtr = TK_RELIEF_SUNKEN; } else { - sprintf(interp->result, "bad relief type \"%.50s\": must be %s", + 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); return TCL_ERROR; } return TCL_OK; @@ -782,10 +1051,11 @@ Tk_Fill3DPolygon(tkwin, drawable, border, pointPtr, numPoints, */ static void -BorderInit() +BorderInit(dispPtr) + TkDisplay * dispPtr; /* Used to access thread-specific data. */ { - initialized = 1; - Tcl_InitHashTable(&borderTable, sizeof(BorderKey)/sizeof(int)); + dispPtr->borderInit = 1; + Tcl_InitHashTable(&dispPtr->borderTable, TCL_STRING_KEYS); } /* @@ -947,3 +1217,170 @@ Intersect(a1Ptr, a2Ptr, b1Ptr, b2Ptr, iPtr) } return 0; } + +/* + *---------------------------------------------------------------------- + * + * Tk_Get3DBorderFromObj -- + * + * Returns the border referred to by a Tcl object. The border must + * already have been allocated via a call to Tk_Alloc3DBorderFromObj + * or Tk_Get3DBorder. + * + * Results: + * Returns the Tk_3DBorder that matches the tkwin and the string rep + * of the name of the border given in objPtr. + * + * Side effects: + * If the object is not already a border, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +Tk_3DBorder +Tk_Get3DBorderFromObj(tkwin, objPtr) + Tk_Window tkwin; + Tcl_Obj *objPtr; /* The object whose string value selects + * a border. */ +{ + TkBorder *borderPtr = NULL; + Tcl_HashEntry *hashPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + if (objPtr->typePtr != &borderObjType) { + InitBorderObj(objPtr); + } + + borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1; + if (borderPtr != NULL) { + if ((borderPtr->resourceRefCount > 0) + && (Tk_Screen(tkwin) == borderPtr->screen) + && (Tk_Colormap(tkwin) == borderPtr->colormap)) { + /* + * The object already points to the right border structure. + * Just return it. + */ + + return (Tk_3DBorder) borderPtr; + } + hashPtr = borderPtr->hashPtr; + FreeBorderObjProc(objPtr); + } else { + hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, + Tcl_GetString(objPtr)); + if (hashPtr == NULL) { + goto error; + } + } + + /* + * At this point we've got a hash table entry, off of which hang + * one or more TkBorder structures. See if any of them will work. + */ + + for (borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr); + (borderPtr != NULL); borderPtr = borderPtr->nextPtr) { + if ((Tk_Screen(tkwin) == borderPtr->screen) + && (Tk_Colormap(tkwin) == borderPtr->colormap)) { + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr; + borderPtr->objRefCount++; + return (Tk_3DBorder) borderPtr; + } + } + + error: + panic("Tk_Get3DBorderFromObj called with non-existent border!"); + /* + * The following code isn't reached; it's just there to please compilers. + */ + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * InitBorderObj -- + * + * Attempt to generate a border internal form for the Tcl object + * "objPtr". + * + * Results: + * The return value is a standard Tcl result. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * If no error occurs, a blank internal format for a border value + * is intialized. The final form cannot be done without a Tk_Window. + * + *---------------------------------------------------------------------- + */ + +static void +InitBorderObj(objPtr) + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + + /* + * Free the old internalRep before setting the new one. + */ + + Tcl_GetString(objPtr); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &borderObjType; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugBorder -- + * + * This procedure returns debugging information about a border. + * + * Results: + * The return value is a list with one sublist for each TkBorder + * corresponding to "name". Each sublist has two elements that + * contain the resourceRefCount and objRefCount fields from the + * TkBorder structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkDebugBorder(tkwin, name) + Tk_Window tkwin; /* The window in which the border will be + * used (not currently used). */ + char *name; /* Name of the desired color. */ +{ + TkBorder *borderPtr; + Tcl_HashEntry *hashPtr; + Tcl_Obj *resultPtr, *objPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + resultPtr = Tcl_NewObj(); + hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, name); + if (hashPtr != NULL) { + borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr); + if (borderPtr == NULL) { + panic("TkDebugBorder found empty hash table entry"); + } + for ( ; (borderPtr != NULL); borderPtr = borderPtr->nextPtr) { + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(borderPtr->resourceRefCount)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(borderPtr->objRefCount)); + Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); + } + } + return resultPtr; +} diff --git a/generic/tk3d.h b/generic/tk3d.h index 1ec63d0..03ce97e 100644 --- a/generic/tk3d.h +++ b/generic/tk3d.h @@ -4,12 +4,12 @@ * Declarations of types and functions shared by the 3d border * module. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tk3d.h,v 1.4 1998/09/14 18:23:03 stanton Exp $ + * RCS: @(#) $Id: tk3d.h,v 1.5 1999/04/16 01:51:10 stanton Exp $ */ #ifndef _TK3D @@ -23,13 +23,13 @@ #endif /* - * One of the following data structures is allocated for - * each 3-D border currently in use. Structures of this - * type are indexed by borderTable, so that a single - * structure can be shared for several uses. + * One of the following data structures is allocated for each 3-D border + * currently in use. Structures of this type are indexed by + * borderTable, so that a single structure can be shared for several + * uses. */ -typedef struct { +typedef struct TkBorder { Screen *screen; /* Screen on which the border will be used. */ Visual *visual; /* Visual for all windows and pixmaps using * the border. */ @@ -37,8 +37,18 @@ typedef struct { * the border will be used. */ Colormap colormap; /* Colormap out of which pixels are * allocated. */ - int refCount; /* Number of different users of - * this border. */ + int resourceRefCount; /* Number of active uses of this color (each + * active use corresponds to a call to + * Tk_Alloc3DBorderFromObj or Tk_Get3DBorder). + * If this count is 0, then this structure + * is 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. */ + int objRefCount; /* The number of Tcl objects that reference + * this structure. */ XColor *bgColorPtr; /* Background color (intensity * between lightColorPtr and * darkColorPtr). */ @@ -63,6 +73,11 @@ typedef struct { * haven't been allocated yet. */ Tcl_HashEntry *hashPtr; /* Entry in borderTable (needed in * order to delete structure). */ + struct TkBorder *nextPtr; /* Points to the next TkBorder structure with + * the same color name. Borders with the + * same name but different screens or + * colormaps are chained together off a + * single entry in borderTable. */ } TkBorder; diff --git a/generic/tkArgv.c b/generic/tkArgv.c index 8d5d661..7f35368 100644 --- a/generic/tkArgv.c +++ b/generic/tkArgv.c @@ -5,12 +5,12 @@ * argv-argc parsing. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkArgv.c,v 1.2 1998/09/14 18:23:03 stanton Exp $ + * RCS: @(#) $Id: tkArgv.c,v 1.3 1999/04/16 01:51:10 stanton Exp $ */ #include "tkPort.h" @@ -45,7 +45,7 @@ static void PrintUsage _ANSI_ARGS_((Tcl_Interp *interp, * * Results: * The return value is a standard Tcl return value. If an - * error occurs then an error message is left in interp->result. + * error occurs then an error message is left in the interp's result. * Under normal conditions, both *argcPtr and *argv are modified * to return the arguments that couldn't be processed here (they * didn't match the option table, or followed an TK_ARGV_REST @@ -291,10 +291,14 @@ Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags) srcIndex += 2; argc -= 2; break; - default: - sprintf(interp->result, "bad argument type %d in Tk_ArgvInfo", + default: { + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "bad argument type %d in Tk_ArgvInfo", infoPtr->type); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; + } } } @@ -328,7 +332,7 @@ Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags) * Generate a help string describing command-line options. * * Results: - * Interp->result will be modified to hold a help string + * The interp's result will be modified to hold a help string * describing all the options in argTable, plus all those * in the default table unless TK_ARGV_NO_DEFAULTS is * specified in flags. @@ -353,7 +357,7 @@ PrintUsage(interp, argTable, flags) int width, i, numSpaces; #define NUM_SPACES 20 static char spaces[] = " "; - char tmp[30]; + char tmp[TCL_DOUBLE_SPACE]; /* * First, compute the width of the widest option key, so that we diff --git a/generic/tkBind.c b/generic/tkBind.c index 72bcd2e..e0daec8 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -5,13 +5,13 @@ * with X events or sequences of X events. * * Copyright (c) 1989-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkBind.c,v 1.5 1999/03/10 07:04:38 stanton Exp $ + * RCS: @(#) $Id: tkBind.c,v 1.6 1999/04/16 01:51:10 stanton Exp $ */ #include "tkPort.h" @@ -344,6 +344,8 @@ typedef struct BindInfo { 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; /* @@ -378,6 +380,7 @@ static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */ */ static int initialized = 0; +TCL_DECLARE_MUTEX(bindMutex) /* * A hash table is kept to map from the string names of event @@ -578,6 +581,20 @@ static int flagArray[TK_LASTEVENT] = { }; /* + * The following table is used to map between the location where an + * generated event should be queued and the string used to specify the + * location. + */ + +static TkStateMap queuePosition[] = { + {-1, "now"}, + {TCL_QUEUE_HEAD, "head"}, + {TCL_QUEUE_MARK, "mark"}, + {TCL_QUEUE_TAIL, "tail"}, + {-2, NULL} +}; + +/* * The following tables are used as a two-way map between X's internal * numeric values for fields in an XEvent and the strings used in Tcl. The * tables are used both when constructing an XEvent from user input and @@ -651,7 +668,8 @@ static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp, static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp, char *virtString)); static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window main, int argc, char **argv)); + Tk_Window main, int objc, + Tcl_Obj *CONST objv[])); static void InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr)); static void InitVirtualEventTable _ANSI_ARGS_(( VirtualEventTable *vetPtr)); @@ -659,9 +677,14 @@ static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr, BindingTable *bindPtr, PatSeq *psPtr, PatSeq *bestPtr, ClientData *objectPtr, PatSeq **sourcePtrPtr)); +static int NameToWindow _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window main, Tcl_Obj *objPtr, + Tk_Window *tkwinPtr)); static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp, char **eventStringPtr, Pattern *patPtr, unsigned long *eventMaskPtr)); +static void SetKeycodeAndState _ANSI_ARGS_((Tk_Window tkwin, + KeySym keySym, XEvent *eventPtr)); /* * The following define is used as a short circuit for the callback @@ -709,37 +732,41 @@ TkBindInit(mainPtr) */ if (!initialized) { - Tcl_HashEntry *hPtr; - ModInfo *modPtr; - EventInfo *eiPtr; - int dummy; + Tcl_MutexLock(&bindMutex); + if (!initialized) { + Tcl_HashEntry *hPtr; + ModInfo *modPtr; + EventInfo *eiPtr; + int dummy; #ifdef REDO_KEYSYM_LOOKUP - KeySymInfo *kPtr; - - Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS); - Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS); - for (kPtr = keyArray; kPtr->name != NULL; kPtr++) { - hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy); - Tcl_SetHashValue(hPtr, kPtr->value); - hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value, - &dummy); - Tcl_SetHashValue(hPtr, kPtr->name); - } + KeySymInfo *kPtr; + + Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS); + for (kPtr = keyArray; kPtr->name != NULL; kPtr++) { + hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy); + Tcl_SetHashValue(hPtr, kPtr->value); + hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value, + &dummy); + Tcl_SetHashValue(hPtr, kPtr->name); + } #endif /* REDO_KEYSYM_LOOKUP */ - Tcl_InitHashTable(&modTable, TCL_STRING_KEYS); - for (modPtr = modArray; modPtr->name != NULL; modPtr++) { - hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy); - Tcl_SetHashValue(hPtr, modPtr); - } + Tcl_InitHashTable(&modTable, TCL_STRING_KEYS); + for (modPtr = modArray; modPtr->name != NULL; modPtr++) { + hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy); + Tcl_SetHashValue(hPtr, modPtr); + } - Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS); - for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { - hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy); - Tcl_SetHashValue(hPtr, eiPtr); + Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS); + for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { + hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy); + Tcl_SetHashValue(hPtr, eiPtr); + } + initialized = 1; } - initialized = 1; + Tcl_MutexUnlock(&bindMutex); } mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp); @@ -750,6 +777,7 @@ TkBindInit(mainPtr) bindInfoPtr->screenInfo.curScreenIndex = -1; bindInfoPtr->screenInfo.bindingDepth = 0; bindInfoPtr->pendingList = NULL; + bindInfoPtr->deleted = 0; mainPtr->bindInfo = (TkBindInfo) bindInfoPtr; TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable); @@ -783,6 +811,8 @@ TkBindFree(mainPtr) bindInfoPtr = (BindInfo *) mainPtr->bindInfo; DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable); + bindInfoPtr->deleted = 1; + Tcl_EventuallyFree((ClientData) bindInfoPtr, Tcl_Free); mainPtr->bindInfo = NULL; } @@ -897,7 +927,7 @@ Tk_DeleteBindingTable(bindingTable) * 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 interp->result. If all went well then the return + * 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 @@ -1002,7 +1032,7 @@ Tk_CreateBinding(interp, bindingTable, object, eventString, command, append) * 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 interp->result. If all went well then the return + * 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 @@ -1086,7 +1116,7 @@ TkCreateBindingProcedure(interp, bindingTable, object, eventString, * * Results: * The result is a standard Tcl return value. If an error - * occurs then interp->result will contain an error message. + * occurs then the interp's result will contain an error message. * * Side effects: * The binding given by object and eventString is removed @@ -1181,7 +1211,7 @@ Tk_DeleteBinding(interp, bindingTable, object, eventString) * 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 - * interp->result. The return value is semi-static: it + * the interp's result. The return value is semi-static: it * will persist until the binding is changed or deleted. * * Side effects: @@ -1224,7 +1254,7 @@ Tk_GetBinding(interp, bindingTable, object, eventString) * associated with a given object. * * Results: - * There is no return value. Interp->result is modified to + * There is no return value. The interp's result is modified to * hold a Tcl list with one entry for each binding associated * with object in bindingTable. Each entry in the list * contains the event string associated with one binding. @@ -1388,9 +1418,9 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) { BindingTable *bindPtr; TkDisplay *dispPtr; + ScreenInfo *screenPtr; BindInfo *bindInfoPtr; TkDisplay *oldDispPtr; - ScreenInfo *screenPtr; XEvent *ringPtr; PatSeq *vMatchDetailList, *vMatchNoDetailList; int flags, oldScreen, i, deferModal; @@ -1621,12 +1651,12 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) unsigned int oldSize, newSize; oldSize = sizeof(staticPending) - - sizeof(staticPending.matchArray) - + matchSpace * sizeof(PatSeq*); + - sizeof(staticPending.matchArray) + + matchSpace * sizeof(PatSeq*); matchSpace *= 2; newSize = sizeof(staticPending) - - sizeof(staticPending.matchArray) - + matchSpace * sizeof(PatSeq*); + - sizeof(staticPending.matchArray) + + matchSpace * sizeof(PatSeq*); new = (PendingBinding *) ckalloc(newSize); memcpy((VOID *) new, (VOID *) pendingPtr, oldSize); if (pendingPtr != &staticPending) { @@ -1657,7 +1687,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) * * There are two tricks here: * 1. Bindings can be invoked from in the middle of Tcl commands, - * where interp->result is significant (for example, a widget + * where the interp's result is significant (for example, a widget * might be deleted because of an error in creating it, so the * result contains an error message that is eventually going to * be returned by the creating command). To preserve the result, @@ -1688,6 +1718,13 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) } 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; @@ -1707,10 +1744,20 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) end = p + Tcl_DStringLength(&scripts); i = 0; + /* + * Be carefule 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); while (p < end) { int code; - screenPtr->bindingDepth++; + if (!bindInfoPtr->deleted) { + screenPtr->bindingDepth++; + } Tcl_AllowExceptions(interp); if (*p == '\0') { @@ -1736,7 +1783,10 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) p += strlen(p); } p++; - screenPtr->bindingDepth--; + + if (!bindInfoPtr->deleted) { + screenPtr->bindingDepth--; + } if (code != TCL_OK) { if (code == TCL_CONTINUE) { /* @@ -1766,8 +1816,8 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) } } - if ((screenPtr->bindingDepth != 0) && - ((oldDispPtr != screenPtr->curDispPtr) + if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0) + && ((oldDispPtr != screenPtr->curDispPtr) || (oldScreen != screenPtr->curScreenIndex))) { /* @@ -1784,19 +1834,27 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) Tcl_DStringFree(&scripts); if (matchCount > 0) { - PendingBinding **curPtrPtr; + 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; + for (curPtrPtr = &bindInfoPtr->pendingList; ; ) { + if (*curPtrPtr == pendingPtr) { + *curPtrPtr = pendingPtr->nextPtr; + break; + } + curPtrPtr = &(*curPtrPtr)->nextPtr; } - curPtrPtr = &(*curPtrPtr)->nextPtr; } if (pendingPtr != &staticPending) { ckfree((char *) pendingPtr); } } + Tcl_Release((ClientData) bindInfoPtr); } /* @@ -2171,7 +2229,8 @@ MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr) bestPtr = matchPtr; bestSourcePtr = sourcePtr; - nextSequence: continue; + nextSequence: + continue; } *sourcePtrPtr = bestSourcePtr; @@ -2215,8 +2274,11 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) int number, flags, length; #define NUM_SIZE 40 char *string; + Tcl_DString buf; char numStorage[NUM_SIZE+1]; + Tcl_DStringInit(&buf); + if (eventPtr->type < TK_LASTEVENT) { flags = flagArray[eventPtr->type]; } else { @@ -2250,8 +2312,10 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) number = eventPtr->xany.serial; goto doNumber; case 'a': - TkpPrintWindowId(numStorage, eventPtr->xconfigure.above); - string = numStorage; + if (flags & CONFIG) { + TkpPrintWindowId(numStorage, eventPtr->xconfigure.above); + string = numStorage; + } goto doString; case 'b': number = eventPtr->xbutton.button; @@ -2365,37 +2429,8 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) goto doNumber; case 'A': if (flags & KEY) { - int numChars; - - /* - * If we're using input methods and this is a keypress - * event, invoke XmbTkFindStateString. Otherwise just use - * the older XTkFindStateString. - */ - -#ifdef TK_USE_INPUT_METHODS - Status status; - if ((winPtr->inputContext != NULL) - && (eventPtr->type == KeyPress)) { - numChars = XmbLookupString(winPtr->inputContext, - &eventPtr->xkey, numStorage, NUM_SIZE, - (KeySym *) NULL, &status); - if ((status != XLookupChars) - && (status != XLookupBoth)) { - numChars = 0; - } - } else { - numChars = XLookupString(&eventPtr->xkey, numStorage, - NUM_SIZE, (KeySym *) NULL, - (XComposeStatus *) NULL); - } -#else /* TK_USE_INPUT_METHODS */ - numChars = XLookupString(&eventPtr->xkey, numStorage, - NUM_SIZE, (KeySym *) NULL, - (XComposeStatus *) NULL); -#endif /* TK_USE_INPUT_METHODS */ - numStorage[numChars] = '\0'; - string = numStorage; + Tcl_DStringFree(&buf); + string = TkpGetString(winPtr, eventPtr, &buf); } goto doString; case 'B': @@ -2496,6 +2531,7 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) Tcl_DStringSetLength(dsPtr, length + spaceNeeded); before += 2; } + Tcl_DStringFree(&buf); } /* @@ -2528,7 +2564,7 @@ ChangeScreen(interp, dispName, screenIndex) { Tcl_DString cmd; int code; - char screen[30]; + char screen[TCL_INTEGER_SPACE]; Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16); @@ -2562,87 +2598,96 @@ ChangeScreen(interp, dispName, screenIndex) */ int -Tk_EventCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_EventObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int i; - size_t length; - char *option; + int index; Tk_Window tkwin; VirtualEventTable *vetPtr; TkBindInfo bindInfo; - - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg1?\"", (char *) NULL); - return TCL_ERROR; - } - - option = argv[1]; - length = strlen(option); - if (length == 0) { - goto badopt; - } + static char *optionStrings[] = { + "add", "delete", "generate", "info", + NULL + }; + enum options { + EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO + }; tkwin = (Tk_Window) clientData; bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo; vetPtr = &((BindInfo *) bindInfo)->virtualEventTable; - if (strncmp(option, "add", length) == 0) { - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " add virtual sequence ?sequence ...?\"", (char *) NULL); - return TCL_ERROR; - } - for (i = 3; i < argc; i++) { - if (CreateVirtualEvent(interp, vetPtr, argv[2], argv[i]) - != TCL_OK) { + 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) { + return TCL_ERROR; + } + + switch ((enum options) index) { + case EVENT_ADD: { + int i; + char *name, *event; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "virtual sequence ?sequence ...?"); return TCL_ERROR; } + name = Tcl_GetStringFromObj(objv[2], NULL); + for (i = 3; i < objc; i++) { + event = Tcl_GetStringFromObj(objv[i], NULL); + if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) { + return TCL_ERROR; + } + } + break; } - } else if (strncmp(option, "delete", length) == 0) { - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " delete virtual ?sequence sequence ...?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - return DeleteVirtualEvent(interp, vetPtr, argv[2], NULL); - } - for (i = 3; i < argc; i++) { - if (DeleteVirtualEvent(interp, vetPtr, argv[2], argv[i]) - != TCL_OK) { + case EVENT_DELETE: { + int i; + char *name, *event; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, + "virtual ?sequence sequence ...?"); return TCL_ERROR; } + name = Tcl_GetStringFromObj(objv[2], NULL); + if (objc == 3) { + return DeleteVirtualEvent(interp, vetPtr, name, NULL); + } + for (i = 3; i < objc; i++) { + event = Tcl_GetStringFromObj(objv[i], NULL); + if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) { + return TCL_ERROR; + } + } + break; } - } else if (strncmp(option, "generate", length) == 0) { - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " generate window event ?options?\"", (char *) NULL); - return TCL_ERROR; + case EVENT_GENERATE: { + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?"); + return TCL_ERROR; + } + return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2); } - return HandleEventGenerate(interp, tkwin, argc - 2, argv + 2); - } else if (strncmp(option, "info", length) == 0) { - if (argc == 2) { - GetAllVirtualEvents(interp, vetPtr); - return TCL_OK; - } else if (argc == 3) { - return GetVirtualEvent(interp, vetPtr, argv[2]); - } else { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " info ?virtual?\"", (char *) NULL); - return TCL_ERROR; + case EVENT_INFO: { + if (objc == 2) { + GetAllVirtualEvents(interp, vetPtr); + return TCL_OK; + } else if (objc == 3) { + return GetVirtualEvent(interp, vetPtr, + Tcl_GetStringFromObj(objv[2], NULL)); + } else { + Tcl_WrongNumArgs(interp, 2, objv, "?virtual?"); + return TCL_ERROR; + } } - } else { - badopt: - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": should be add, delete, generate, info", (char *) NULL); - return TCL_ERROR; } return TCL_OK; } @@ -2729,8 +2774,8 @@ DeleteVirtualEventTable(vetPtr) * Results: * The return value is TCL_ERROR if an error occured while * creating the virtual binding. In this case, an error message - * will be left in interp->result. If all went well then the return - * value is TCL_OK. + * will be left in the interp's result. If all went well then the + * return value is TCL_OK. * * Side effects: * The virtual event may cause future calls to Tk_BindEvent to @@ -2835,7 +2880,7 @@ CreateVirtualEvent(interp, vetPtr, virtString, eventString) * * Results: * The result is a standard Tcl return value. If an error - * occurs then interp->result will contain an error message. + * occurs then the interp's result will contain an error message. * It is not an error to attempt to delete a virtual event that * does not exist or a definition that does not exist. * @@ -2887,7 +2932,10 @@ DeleteVirtualEvent(interp, vetPtr, virtString, eventString) eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString, 0, 0, &eventMask); if (eventPSPtr == NULL) { - return (interp->result[0] != '\0') ? TCL_ERROR : TCL_OK; + char *string; + + string = Tcl_GetStringResult(interp); + return (string[0] != '\0') ? TCL_ERROR : TCL_OK; } } @@ -2989,12 +3037,12 @@ DeleteVirtualEvent(interp, vetPtr, virtString, eventString) * given virtual event. * * Results: - * The return value is TCL_OK and interp->result is filled with the + * The return value is TCL_OK and the interp's result is filled with the * string representation of the physical events associated with the * virtual event; if there are no physical events for the given virtual - * event, interp->result is filled with and empty string. If the + * event, the interp's result is filled with and empty string. If the * virtual event string is improperly formed, then TCL_ERROR is - * returned and an error message is left in interp->result. + * returned and an error message is left in the interp's result. * * Side effects: * None. @@ -3046,7 +3094,7 @@ GetVirtualEvent(interp, vetPtr, virtString) * event defined. * * Results: - * There is no return value. Interp->result is modified to + * There is no return value. The interp's result is modified to * hold a Tcl list with one entry for each virtual event in * nameTable. * @@ -3115,56 +3163,72 @@ GetAllVirtualEvents(interp, vetPtr) *--------------------------------------------------------------------------- */ static int -HandleEventGenerate(interp, mainwin, argc, argv) - Tcl_Interp *interp; /* Interp for error messages and name lookup. */ - Tk_Window mainwin; /* Main window associated with interp. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ +HandleEventGenerate(interp, mainWin, objc, objv) + Tcl_Interp *interp; /* Interp for errors return and name lookup. */ + Tk_Window mainWin; /* Main window associated with interp. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { + XEvent event; + char *name, *p; + int count, flags, synch, i, number; + Tcl_QueuePosition pos; Pattern pat; - Tk_Window tkwin; - char *p; + Tk_Window tkwin, tkwin2; + TkWindow *mainPtr; unsigned long eventMask; - int count, i, state, flags, synch; - Tcl_QueuePosition pos; - XEvent event; + static char *fieldStrings[] = { + "-when", "-above", "-borderwidth", "-button", + "-count", "-delta", "-detail", "-focus", + "-height", + "-keycode", "-keysym", "-mode", "-override", + "-place", "-root", "-rootx", "-rooty", + "-sendevent", "-serial", "-state", "-subwindow", + "-time", "-width", "-window", "-x", + "-y", NULL + }; + enum field { + EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON, + EVENT_COUNT, EVENT_DELTA, EVENT_DETAIL, EVENT_FOCUS, + EVENT_HEIGHT, + EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE, + EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY, + EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW, + EVENT_TIME, EVENT_WIDTH, EVENT_WINDOW, EVENT_X, + EVENT_Y + }; + + if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) { + return TCL_ERROR; + } - if (argv[0][0] == '.') { - tkwin = Tk_NameToWindow(interp, argv[0], mainwin); - if (tkwin == NULL) { - return TCL_ERROR; - } - } else { - if (TkpScanWindowId(NULL, argv[0], &i) != TCL_OK) { - Tcl_AppendResult(interp, "bad window name/identifier \"", - argv[0], "\"", (char *) NULL); - return TCL_ERROR; - } - tkwin = Tk_IdToWindow(Tk_Display(mainwin), (Window) i); - if ((tkwin == NULL) || (((TkWindow *) mainwin)->mainPtr - != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendResult(interp, "window id \"", argv[0], - "\" doesn't exist in this application", (char *) NULL); - return TCL_ERROR; - } + mainPtr = (TkWindow *) mainWin; + if ((tkwin == NULL) + || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { + char *name; + + name = Tcl_GetStringFromObj(objv[0], NULL); + Tcl_AppendResult(interp, "window id \"", name, + "\" doesn't exist in this application", (char *) NULL); + return TCL_ERROR; } - p = argv[1]; + name = Tcl_GetStringFromObj(objv[1], NULL); + + p = name; + eventMask = 0; count = ParseEventDescription(interp, &p, &pat, &eventMask); if (count == 0) { return TCL_ERROR; } if (count != 1) { - interp->result = "Double or Triple modifier not allowed"; + Tcl_SetResult(interp, "Double or Triple modifier not allowed", + TCL_STATIC); return TCL_ERROR; } if (*p != '\0') { - interp->result = "only one event specification allowed"; - return TCL_ERROR; - } - if (argc & 1) { - Tcl_AppendResult(interp, "value for \"", argv[argc - 1], - "\" missing", (char *) NULL); + Tcl_SetResult(interp, "only one event specification allowed", + TCL_STATIC); return TCL_ERROR; } @@ -3179,34 +3243,7 @@ HandleEventGenerate(interp, mainwin, argc, argv) if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { event.xkey.state = pat.needMods; if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) { - /* - * When mapping from a keysym to a keycode, need information about - * the modifier state that should be used so that when they call - * XKeycodeToKeysym taking into account the xkey.state, they will - * get back the original keysym. - */ - - if (pat.detail.keySym == NoSymbol) { - event.xkey.keycode = 0; - } else { - event.xkey.keycode = XKeysymToKeycode(event.xany.display, - pat.detail.keySym); - } - if (event.xkey.keycode != 0) { - for (state = 0; state < 4; state++) { - if (XKeycodeToKeysym(event.xany.display, - event.xkey.keycode, state) == pat.detail.keySym) { - if (state & 1) { - event.xkey.state |= ShiftMask; - } - if (state & 2) { - TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - event.xkey.state |= dispPtr->modeModMask; - } - break; - } - } - } + SetKeycodeAndState(tkwin, pat.detail.keySym, &event); } else if (flags & BUTTON) { event.xbutton.button = pat.detail.button; } else if (flags & VIRTUAL) { @@ -3224,375 +3261,407 @@ HandleEventGenerate(interp, mainwin, argc, argv) synch = 1; pos = TCL_QUEUE_TAIL; - for (i = 2; i < argc; i += 2) { - char *field, *value; - Tk_Window tkwin2; - int number; - KeySym keysym; + for (i = 2; i < objc; i += 2) { + Tcl_Obj *optionPtr, *valuePtr; + int index; - field = argv[i]; - value = argv[i+1]; - - if (strcmp(field, "-when") == 0) { - if (strcmp(value, "now") == 0) { - synch = 1; - } else if (strcmp(value, "head") == 0) { - pos = TCL_QUEUE_HEAD; - synch = 0; - } else if (strcmp(value, "mark") == 0) { - pos = TCL_QUEUE_MARK; - synch = 0; - } else if (strcmp(value, "tail") == 0) { - pos = TCL_QUEUE_TAIL; + optionPtr = objv[i]; + valuePtr = objv[i + 1]; + + if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option", + TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + if (objc & 1) { + /* + * This test occurs after Tcl_GetIndexFromObj() so that + * "event generate <Button> -xyz" will return the error message + * that "-xyz" is a bad option, rather than that the value + * for "-xyz" is missing. + */ + + Tcl_AppendResult(interp, "value for \"", + Tcl_GetStringFromObj(optionPtr, NULL), "\" missing", + (char *) NULL); + return TCL_ERROR; + } + + switch ((enum field) index) { + case EVENT_WHEN: { + pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr, + queuePosition, valuePtr); + if ((int) pos < -1) { + return TCL_ERROR; + } synch = 0; - } else { - Tcl_AppendResult(interp, "bad position \"", value, - "\": should be now, head, mark, tail", (char *) NULL); - return TCL_ERROR; + if ((int) pos == -1) { + synch = 1; + } + break; } - } else if (strcmp(field, "-above") == 0) { - if (value[0] == '.') { - tkwin2 = Tk_NameToWindow(interp, value, mainwin); - if (tkwin2 == NULL) { + case EVENT_ABOVE: { + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { return TCL_ERROR; } - number = Tk_WindowId(tkwin2); - } else if (TkpScanWindowId(interp, value, &number) - != TCL_OK) { - return TCL_ERROR; - } - if (flags & CONFIG) { - event.xconfigure.above = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-borderwidth") == 0) { - if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) { - return TCL_ERROR; - } - if (flags & (CREATE|CONFIG)) { - event.xcreatewindow.border_width = number; - } else { - goto badopt; + if (flags & CONFIG) { + event.xconfigure.above = Tk_WindowId(tkwin2); + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-button") == 0) { - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { - return TCL_ERROR; + case EVENT_BORDER: { + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & (CREATE|CONFIG)) { + event.xcreatewindow.border_width = number; + } else { + goto badopt; + } + break; } - if (flags & BUTTON) { - event.xbutton.button = number; - } else { - goto badopt; + case EVENT_BUTTON: { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & BUTTON) { + event.xbutton.button = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-count") == 0) { - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { - return TCL_ERROR; + case EVENT_COUNT: { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & EXPOSE) { + event.xexpose.count = number; + } else { + goto badopt; + } + break; } - if (flags & EXPOSE) { - event.xexpose.count = number; - } else { - goto badopt; + case EVENT_DELTA: { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) { + event.xkey.keycode = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-delta") == 0) { - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { - return TCL_ERROR; + case EVENT_DETAIL: { + number = TkFindStateNumObj(interp, optionPtr, notifyDetail, + valuePtr); + if (number < 0) { + return TCL_ERROR; + } + if (flags & FOCUS) { + event.xfocus.detail = number; + } else if (flags & CROSSING) { + event.xcrossing.detail = number; + } else { + goto badopt; + } + break; } - if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) { - event.xkey.keycode = number; - } else { - goto badopt; + case EVENT_FOCUS: { + if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & CROSSING) { + event.xcrossing.focus = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-detail") == 0) { - number = TkFindStateNum(interp, field, notifyDetail, value); - if (number < 0) { - return TCL_ERROR; + case EVENT_HEIGHT: { + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & EXPOSE) { + event.xexpose.height = number; + } else if (flags & CONFIG) { + event.xconfigure.height = number; + } else { + goto badopt; + } + break; } - if (flags & FOCUS) { - event.xfocus.detail = number; - } else if (flags & CROSSING) { - event.xcrossing.detail = number; - } else { - goto badopt; + case EVENT_KEYCODE: { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) { + event.xkey.keycode = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-focus") == 0) { - if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) { - return TCL_ERROR; + case EVENT_KEYSYM: { + KeySym keysym; + char *value; + + value = Tcl_GetStringFromObj(valuePtr, NULL); + keysym = TkStringToKeysym(value); + if (keysym == NoSymbol) { + Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", + (char *) NULL); + return TCL_ERROR; + } + + SetKeycodeAndState(tkwin, keysym, &event); + if (event.xkey.keycode == 0) { + Tcl_AppendResult(interp, "no keycode for keysym \"", value, + "\"", (char *) NULL); + return TCL_ERROR; + } + if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) { + goto badopt; + } + break; } - if (flags & CROSSING) { - event.xcrossing.focus = number; - } else { - goto badopt; + case EVENT_MODE: { + number = TkFindStateNumObj(interp, optionPtr, notifyMode, + valuePtr); + if (number < 0) { + return TCL_ERROR; + } + if (flags & CROSSING) { + event.xcrossing.mode = number; + } else if (flags & FOCUS) { + event.xfocus.mode = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-height") == 0) { - if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) { - return TCL_ERROR; + case EVENT_OVERRIDE: { + if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & CREATE) { + event.xcreatewindow.override_redirect = number; + } else if (flags & MAP) { + event.xmap.override_redirect = number; + } else if (flags & REPARENT) { + event.xreparent.override_redirect = number; + } else if (flags & CONFIG) { + event.xconfigure.override_redirect = number; + } else { + goto badopt; + } + break; } - if (flags & EXPOSE) { - event.xexpose.height = number; - } else if (flags & CONFIG) { - event.xconfigure.height = number; - } else { - goto badopt; + case EVENT_PLACE: { + number = TkFindStateNumObj(interp, optionPtr, circPlace, + valuePtr); + if (number < 0) { + return TCL_ERROR; + } + if (flags & CIRC) { + event.xcirculate.place = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-keycode") == 0) { - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { - return TCL_ERROR; + case EVENT_ROOT: { + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { + return TCL_ERROR; + } + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + event.xkey.root = Tk_WindowId(tkwin2); + } else { + goto badopt; + } + break; } - if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) { - event.xkey.keycode = number; - } else { - goto badopt; + case EVENT_ROOTX: { + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + event.xkey.x_root = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-keysym") == 0) { - keysym = TkStringToKeysym(value); - if (keysym == NoSymbol) { - Tcl_AppendResult(interp, "unknown keysym \"", value, - "\"", (char *) NULL); - return TCL_ERROR; + case EVENT_ROOTY: { + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + event.xkey.y_root = number; + } else { + goto badopt; + } + break; } - /* - * When mapping from a keysym to a keycode, need information about - * the modifier state that should be used so that when they call - * XKeycodeToKeysym taking into account the xkey.state, they will - * get back the original keysym. - */ + case EVENT_SEND: { + CONST char *value; - number = XKeysymToKeycode(event.xany.display, keysym); - if (number == 0) { - Tcl_AppendResult(interp, "no keycode for keysym \"", value, - "\"", (char *) NULL); - return TCL_ERROR; - } - for (state = 0; state < 4; state++) { - if (XKeycodeToKeysym(event.xany.display, (unsigned) number, - state) == keysym) { - if (state & 1) { - event.xkey.state |= ShiftMask; + value = Tcl_GetStringFromObj(valuePtr, NULL); + if (isdigit(UCHAR(value[0]))) { + /* + * Allow arbitrary integer values for the field; they + * are needed by a few of the tests in the Tk test suite. + */ + + if (Tcl_GetIntFromObj(interp, valuePtr, &number) + != TCL_OK) { + return TCL_ERROR; } - if (state & 2) { - TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - event.xkey.state |= dispPtr->modeModMask; + } else { + if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) + != TCL_OK) { + return TCL_ERROR; } - break; } - } - if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) { - event.xkey.keycode = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-mode") == 0) { - number = TkFindStateNum(interp, field, notifyMode, value); - if (number < 0) { - return TCL_ERROR; - } - if (flags & CROSSING) { - event.xcrossing.mode = number; - } else if (flags & FOCUS) { - event.xfocus.mode = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-override") == 0) { - if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) { - return TCL_ERROR; - } - if (flags & CREATE) { - event.xcreatewindow.override_redirect = number; - } else if (flags & MAP) { - event.xmap.override_redirect = number; - } else if (flags & REPARENT) { - event.xreparent.override_redirect = number; - } else if (flags & CONFIG) { - event.xconfigure.override_redirect = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-place") == 0) { - number = TkFindStateNum(interp, field, circPlace, value); - if (number < 0) { - return TCL_ERROR; - } - if (flags & CIRC) { - event.xcirculate.place = number; - } else { - goto badopt; + event.xany.send_event = number; + break; } - } else if (strcmp(field, "-root") == 0) { - if (value[0] == '.') { - tkwin2 = Tk_NameToWindow(interp, value, mainwin); - if (tkwin2 == NULL) { + case EVENT_SERIAL: { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } - number = Tk_WindowId(tkwin2); - } else if (TkpScanWindowId(interp, value, &number) - != TCL_OK) { - return TCL_ERROR; - } - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - event.xkey.root = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-rootx") == 0) { - if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) { - return TCL_ERROR; - } - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - event.xkey.x_root = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-rooty") == 0) { - if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) { - return TCL_ERROR; + event.xany.serial = number; + break; } - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - event.xkey.y_root = number; - } else { - goto badopt; + case EVENT_STATE: { + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) + != TCL_OK) { + return TCL_ERROR; + } + if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { + event.xkey.state = number; + } else { + event.xcrossing.state = number; + } + } else if (flags & VISIBILITY) { + number = TkFindStateNumObj(interp, optionPtr, visNotify, + valuePtr); + if (number < 0) { + return TCL_ERROR; + } + event.xvisibility.state = number; + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-sendevent") == 0) { - if (isdigit(UCHAR(value[0]))) { - /* - * Allow arbitrary integer values for the field; they - * are needed by a few of the tests in the Tk test suite. - */ - - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { + case EVENT_SUBWINDOW: { + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { return TCL_ERROR; } - } else { - if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) { - return TCL_ERROR; + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + event.xkey.subwindow = Tk_WindowId(tkwin2); + } else { + goto badopt; } + break; } - event.xany.send_event = number; - } else if (strcmp(field, "-serial") == 0) { - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { - return TCL_ERROR; - } - event.xany.serial = number; - } else if (strcmp(field, "-state") == 0) { - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { + case EVENT_TIME: { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } - if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { - event.xkey.state = number; + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + event.xkey.time = (Time) number; + } else if (flags & PROP) { + event.xproperty.time = (Time) number; } else { - event.xcrossing.state = number; + goto badopt; } - } else if (flags & VISIBILITY) { - number = TkFindStateNum(interp, field, visNotify, value); - if (number < 0) { + break; + } + case EVENT_WIDTH: { + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) + != TCL_OK) { return TCL_ERROR; } - event.xvisibility.state = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-subwindow") == 0) { - if (value[0] == '.') { - tkwin2 = Tk_NameToWindow(interp, value, mainwin); - if (tkwin2 == NULL) { - return TCL_ERROR; + if (flags & EXPOSE) { + event.xexpose.width = number; + } else if (flags & (CREATE|CONFIG)) { + event.xcreatewindow.width = number; + } else { + goto badopt; } - number = Tk_WindowId(tkwin2); - } else if (TkpScanWindowId(interp, value, &number) - != TCL_OK) { - return TCL_ERROR; - } - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - event.xkey.subwindow = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-time") == 0) { - if (Tcl_GetInt(interp, value, &number) != TCL_OK) { - return TCL_ERROR; - } - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - event.xkey.time = (Time) number; - } else if (flags & PROP) { - event.xproperty.time = (Time) number; - } else { - goto badopt; - } - } else if (strcmp(field, "-width") == 0) { - if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) { - return TCL_ERROR; - } - if (flags & EXPOSE) { - event.xexpose.width = number; - } else if (flags & (CREATE|CONFIG)) { - event.xcreatewindow.width = number; - } else { - goto badopt; + break; } - } else if (strcmp(field, "-window") == 0) { - if (value[0] == '.') { - tkwin2 = Tk_NameToWindow(interp, value, mainwin); - if (tkwin2 == NULL) { + case EVENT_WINDOW: { + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { return TCL_ERROR; } - number = Tk_WindowId(tkwin2); - } else if (TkpScanWindowId(interp, value, &number) - != TCL_OK) { - return TCL_ERROR; - } - if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG - |GRAVITY|CIRC)) { - event.xcreatewindow.window = number; - } else { - goto badopt; - } - } else if (strcmp(field, "-x") == 0) { - int rootX, rootY; - if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) { - return TCL_ERROR; - } - Tk_GetRootCoords(tkwin, &rootX, &rootY); - rootX += number; - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - event.xkey.x = number; - event.xkey.x_root = rootX; - } else if (flags & EXPOSE) { - event.xexpose.x = number; - } else if (flags & (CREATE|CONFIG|GRAVITY)) { - event.xcreatewindow.x = number; - } else if (flags & REPARENT) { - event.xreparent.x = number; - } else { - goto badopt; + if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG + |GRAVITY|CIRC)) { + event.xcreatewindow.window = Tk_WindowId(tkwin2); + } else { + goto badopt; + } + break; } - } else if (strcmp(field, "-y") == 0) { - int rootX, rootY; - if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) { - return TCL_ERROR; + case EVENT_X: { + int rootX, rootY; + + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) + != TCL_OK) { + return TCL_ERROR; + } + Tk_GetRootCoords(tkwin, &rootX, &rootY); + rootX += number; + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + event.xkey.x = number; + event.xkey.x_root = rootX; + } else if (flags & EXPOSE) { + event.xexpose.x = number; + } else if (flags & (CREATE|CONFIG|GRAVITY)) { + event.xcreatewindow.x = number; + } else if (flags & REPARENT) { + event.xreparent.x = number; + } else { + goto badopt; + } + break; } - Tk_GetRootCoords(tkwin, &rootX, &rootY); - rootY += number; - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { - event.xkey.y = number; - event.xkey.y_root = rootY; - } else if (flags & EXPOSE) { - event.xexpose.y = number; - } else if (flags & (CREATE|CONFIG|GRAVITY)) { - event.xcreatewindow.y = number; - } else if (flags & REPARENT) { - event.xreparent.y = number; - } else { - goto badopt; + case EVENT_Y: { + int rootX, rootY; + + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) + != TCL_OK) { + return TCL_ERROR; + } + Tk_GetRootCoords(tkwin, &rootX, &rootY); + rootY += number; + if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + event.xkey.y = number; + event.xkey.y_root = rootY; + } else if (flags & EXPOSE) { + event.xexpose.y = number; + } else if (flags & (CREATE|CONFIG|GRAVITY)) { + event.xcreatewindow.y = number; + } else if (flags & REPARENT) { + event.xreparent.y = number; + } else { + goto badopt; + } + break; } - } else { - badopt: - Tcl_AppendResult(interp, "bad option to ", argv[1], - " event: \"", field, "\"", (char *) NULL); - return TCL_ERROR; } + continue; + + badopt: + Tcl_AppendResult(interp, name, " event doesn't accept \"", + Tcl_GetStringFromObj(optionPtr, NULL), "\" option", NULL); + return TCL_ERROR; } - if (synch != 0) { Tk_HandleEvent(&event); } else { @@ -3600,6 +3669,79 @@ HandleEventGenerate(interp, mainwin, argc, argv) } Tcl_ResetResult(interp); return TCL_OK; + +} +static int +NameToWindow(interp, mainWin, objPtr, tkwinPtr) + Tcl_Interp *interp; /* Interp for error return and name lookup. */ + Tk_Window mainWin; /* Main window of application. */ + Tcl_Obj *objPtr; /* Contains name or id string of window. */ + Tk_Window *tkwinPtr; /* Filled with token for window. */ +{ + char *name; + Tk_Window tkwin; + int id; + + name = Tcl_GetStringFromObj(objPtr, NULL); + if (name[0] == '.') { + tkwin = Tk_NameToWindow(interp, name, mainWin); + if (tkwin == NULL) { + return TCL_ERROR; + } + *tkwinPtr = tkwin; + } else { + if (TkpScanWindowId(NULL, name, &id) != TCL_OK) { + Tcl_AppendResult(interp, "bad window name/identifier \"", + name, "\"", (char *) NULL); + return TCL_ERROR; + } + *tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), (Window) id); + } + return TCL_OK; +} + +/* + * When mapping from a keysym to a keycode, need + * information about the modifier state that should be used + * so that when they call XKeycodeToKeysym taking into + * account the xkey.state, they will get back the original + * keysym. + */ + +static void +SetKeycodeAndState(tkwin, keySym, eventPtr) + Tk_Window tkwin; + KeySym keySym; + XEvent *eventPtr; +{ + Display *display; + int state; + KeyCode keycode; + + display = Tk_Display(tkwin); + + if (keySym == NoSymbol) { + keycode = 0; + } else { + keycode = XKeysymToKeycode(display, keySym); + } + if (keycode != 0) { + for (state = 0; state < 4; state++) { + if (XKeycodeToKeysym(display, keycode, state) == keySym) { + if (state & 1) { + eventPtr->xkey.state |= ShiftMask; + } + if (state & 2) { + TkDisplay *dispPtr; + + dispPtr = ((TkWindow *) tkwin)->dispPtr; + eventPtr->xkey.state |= dispPtr->modeModMask; + } + break; + } + } + } + eventPtr->xkey.keycode = keycode; } /* @@ -3613,7 +3755,7 @@ HandleEventGenerate(interp, mainwin, argc, argv) * Results: * The return value is NULL if the virtual event string was * not in the proper format. In this case, an error message - * will be left in interp->result. Otherwise the return + * will be left in the interp's result. Otherwise the return * value is a Tk_Uid that represents the virtual event. * * Side effects: @@ -3659,7 +3801,7 @@ GetVirtualEventUid(interp, virtString) * in patternTable that corresponds to eventString. If an error * was found while parsing eventString, or if "create" is 0 and * no pattern sequence previously existed, then NULL is returned - * and interp->result contains a message describing the problem. + * and the interp's result contains a message describing the problem. * If no pattern sequence previously existed for eventString, then * a new one is created with a NULL command field. In a successful * return, *maskPtr is filled in with a mask of the event types @@ -3735,8 +3877,9 @@ FindSequence(interp, patternTablePtr, object, eventString, create, if (eventMask & VirtualEventMask) { if (allowVirtual == 0) { - interp->result = - "virtual event not allowed in definition of another virtual event"; + Tcl_SetResult(interp, + "virtual event not allowed in definition of another virtual event", + TCL_STATIC); return NULL; } virtualFound = 1; @@ -3767,11 +3910,12 @@ FindSequence(interp, patternTablePtr, object, eventString, create, */ if (numPats == 0) { - interp->result = "no events specified in binding"; + Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC); return NULL; } if ((numPats > 1) && (virtualFound != 0)) { - interp->result = "virtual events may not be composed"; + Tcl_SetResult(interp, "virtual events may not be composed", + TCL_STATIC); return NULL; } @@ -3797,6 +3941,14 @@ FindSequence(interp, patternTablePtr, object, eventString, create, if (new) { Tcl_DeleteHashEntry(hPtr); } + /* + * No binding exists for the sequence, so return an empty error. + * This is a special error that the caller will check for in order + * to silently ignore this case. This is a hack that maintains + * backward compatibility for Tk_GetBinding but the various "bind" + * commands silently ignore missing bindings. + */ + return NULL; } psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq) @@ -3886,8 +4038,10 @@ ParseEventDescription(interp, eventStringPtr, patPtr, if (isprint(UCHAR(*p))) { patPtr->detail.keySym = *p; } else { - sprintf(interp->result, - "bad ASCII character 0x%x", (unsigned char) *p); + char buf[64]; + + sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return 0; } } @@ -3927,11 +4081,13 @@ ParseEventDescription(interp, eventStringPtr, patPtr, char *field = p + 1; p = strchr(field, '>'); if (p == field) { - interp->result = "virtual event \"<<>>\" is badly formed"; + Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed", + TCL_STATIC); return 0; } if ((p == NULL) || (p[1] != '>')) { - interp->result = "missing \">\" in virtual binding"; + Tcl_SetResult(interp, "missing \">\" in virtual binding", + TCL_STATIC); return 0; } *p = '\0'; @@ -4018,7 +4174,8 @@ ParseEventDescription(interp, eventStringPtr, patPtr, } } } else if (eventFlags == 0) { - interp->result = "no event type or button # or keysym"; + Tcl_SetResult(interp, "no event type or button # or keysym", + TCL_STATIC); return 0; } @@ -4029,11 +4186,13 @@ ParseEventDescription(interp, eventStringPtr, patPtr, while (*p != '\0') { p++; if (*p == '>') { - interp->result = "extra characters after detail in binding"; + Tcl_SetResult(interp, + "extra characters after detail in binding", + TCL_STATIC); return 0; } } - interp->result = "missing \">\" in binding"; + Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); return 0; } p++; @@ -4108,7 +4267,7 @@ GetPatternString(psPtr, dsPtr) Tcl_DString *dsPtr; { Pattern *patPtr; - char c, buffer[10]; + char c, buffer[TCL_INTEGER_SPACE]; int patsLeft, needMods; ModInfo *modPtr; EventInfo *eiPtr; @@ -4529,7 +4688,7 @@ TkKeysymToString(keysym) * * Results: * Returns the result of evaluating script, including both a standard - * Tcl completion code and a string in interp->result. + * Tcl completion code and a string in the interp's result. * * Side effects: * None. diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index e7a14b9..6facc97 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -6,12 +6,12 @@ * also avoids interactions with the X server. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * 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. * - * RCS: @(#) $Id: tkBitmap.c,v 1.6 1998/09/14 18:23:03 stanton Exp $ + * RCS: @(#) $Id: tkBitmap.c,v 1.7 1999/04/16 01:51:10 stanton Exp $ */ #include "tkPort.h" @@ -51,69 +51,180 @@ * "nameTable". */ -typedef struct { +typedef struct TkBitmap { Pixmap bitmap; /* X identifier for bitmap. None means this * bitmap was created by Tk_DefineBitmap * and it isn't currently in use. */ int width, height; /* Dimensions of bitmap. */ Display *display; /* Display for which bitmap is valid. */ - int refCount; /* Number of active uses of bitmap. */ - Tcl_HashEntry *hashPtr; /* Entry in nameTable for this structure + int resourceRefCount; /* Number of active uses of this bitmap (each + * active use corresponds to a call to + * Tk_AllocBitmapFromObj or Tk_GetBitmap). + * If this count is 0, then this TkBitmap + * structure is no longer valid and it isn't + * present in nameTable: it is being kept + * around only because there are objects + * referring to it. The structure is freed + * when resourceRefCount and objRefCount + * are both 0. */ + int objRefCount; /* Number of Tcl_Obj's that reference + * this structure. */ + Tcl_HashEntry *nameHashPtr; /* Entry in nameTable for this structure + * (needed when deleting). */ + Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure * (needed when deleting). */ + struct TkBitmap *nextPtr; /* Points to the next TkBitmap structure with + * the same name. All bitmaps with the + * same name (but different displays) are + * chained together off a single entry in + * nameTable. */ } TkBitmap; -/* - * Hash table to map from a textual description of a bitmap to the - * TkBitmap record for the bitmap, and key structure used in that - * hash table: +/* + * Used in bitmapDataTable, stored in the TkDisplay structure, to map + * between in-core data about a bitmap to its TkBitmap structure. */ -static Tcl_HashTable nameTable; typedef struct { - Tk_Uid name; /* Textual name for desired bitmap. */ - Screen *screen; /* Screen on which bitmap will be used. */ -} NameKey; + char *source; /* Bitmap bits. */ + int width, height; /* Dimensions of bitmap. */ +} DataKey; + +typedef struct ThreadSpecificData { + int initialized; /* 0 means table below needs initializing. */ + Tcl_HashTable predefBitmapTable; + /* Hash table created by Tk_DefineBitmap + * to map from a name to a collection + * of in-core data about a bitmap. The + * table is indexed by the address of the + * data for the bitmap, and the entries + * contain pointers to TkPredefBitmap + * structures. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* - * Hash table that maps from <display + bitmap id> to the TkBitmap structure - * for the bitmap. This table is used by Tk_FreeBitmap. + * Forward declarations for procedures defined in this file: */ -static Tcl_HashTable idTable; -typedef struct { - Display *display; /* Display for which bitmap was allocated. */ - Pixmap pixmap; /* X identifier for pixmap. */ -} IdKey; +static void BitmapInit _ANSI_ARGS_((TkDisplay *dispPtr)); +static void DupBitmapObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr, + Tcl_Obj *dupObjPtr)); +static void FreeBitmap _ANSI_ARGS_((TkBitmap *bitmapPtr)); +static void FreeBitmapObjProc _ANSI_ARGS_((Tcl_Obj *objPtr)); +static TkBitmap * GetBitmap _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, CONST char *name)); +static TkBitmap * GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj *objPtr)); +static void InitBitmapObj _ANSI_ARGS_((Tcl_Obj *objPtr)); /* - * Hash table create by Tk_DefineBitmap to map from a name to a - * collection of in-core data about a bitmap. The table is - * indexed by the address of the data for the bitmap, and the entries - * contain pointers to TkPredefBitmap structures. + * The following structure defines the implementation of the "bitmap" Tcl + * object, which maps a string bitmap name to a TkBitmap object. The + * ptr1 field of the Tcl_Obj points to a TkBitmap object. */ -Tcl_HashTable tkPredefBitmapTable; - +static Tcl_ObjType bitmapObjType = { + "bitmap", /* name */ + FreeBitmapObjProc, /* freeIntRepProc */ + DupBitmapObjProc, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + /* - * Hash table used by Tk_GetBitmapFromData to map from a collection - * of in-core data about a bitmap to a Tk_Uid giving an automatically- - * generated name for the bitmap: + *---------------------------------------------------------------------- + * + * Tk_AllocBitmapFromObj -- + * + * Given a Tcl_Obj *, map the value to a corresponding + * Pixmap structure based on the tkwin given. + * + * Results: + * The return value is the X identifer for the desired bitmap + * (i.e. a Pixmap with a single plane), unless string couldn't be + * parsed correctly. In this case, None is returned and an error + * message is left in the interp's result. The caller should never + * modify the bitmap that is returned, and should eventually call + * Tk_FreeBitmapFromObj when the bitmap is no longer needed. + * + * Side effects: + * The bitmap is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeBitmapFromObj, so that the database can be cleaned up + * when bitmaps aren't needed anymore. + * + *---------------------------------------------------------------------- */ -static Tcl_HashTable dataTable; -typedef struct { - char *source; /* Bitmap bits. */ - int width, height; /* Dimensions of bitmap. */ -} DataKey; +Pixmap +Tk_AllocBitmapFromObj(interp, tkwin, objPtr) + Tcl_Interp *interp; /* Interp for error results. This may + * be NULL. */ + Tk_Window tkwin; /* Need the screen the bitmap is used on.*/ + Tcl_Obj *objPtr; /* Object describing bitmap; see manual + * entry for legal syntax of string value. */ +{ + TkBitmap *bitmapPtr; -static int initialized = 0; /* 0 means static structures haven't been - * initialized yet. */ + if (objPtr->typePtr != &bitmapObjType) { + InitBitmapObj(objPtr); + } + bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1; -/* - * Forward declarations for procedures defined in this file: - */ + /* + * If the object currently points to a TkBitmap, see if it's the + * one we want. If so, increment its reference count and return. + */ + + if (bitmapPtr != NULL) { + if (bitmapPtr->resourceRefCount == 0) { + /* + * This is a stale reference: it refers to a TkBitmap that's + * no longer in use. Clear the reference. + */ + + FreeBitmapObjProc(objPtr); + bitmapPtr = NULL; + } else if (Tk_Display(tkwin) == bitmapPtr->display) { + bitmapPtr->resourceRefCount++; + return bitmapPtr->bitmap; + } + } + + /* + * The object didn't point to the TkBitmap that we wanted. Search + * the list of TkBitmaps with the same name to see if one of the + * others is the right one. + */ + + if (bitmapPtr != NULL) { + TkBitmap *firstBitmapPtr = + (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr); + FreeBitmapObjProc(objPtr); + for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL; + bitmapPtr = bitmapPtr->nextPtr) { + if (Tk_Display(tkwin) == bitmapPtr->display) { + bitmapPtr->resourceRefCount++; + bitmapPtr->objRefCount++; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr; + return bitmapPtr->bitmap; + } + } + } + + /* + * Still no luck. Call GetBitmap to allocate a new TkBitmap object. + */ -static void BitmapInit _ANSI_ARGS_((void)); + bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr)); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr; + if (bitmapPtr == NULL) { + return None; + } + bitmapPtr->objRefCount++; + return bitmapPtr->bitmap; +} /* *---------------------------------------------------------------------- @@ -127,7 +238,7 @@ static void BitmapInit _ANSI_ARGS_((void)); * The return value is the X identifer for the desired bitmap * (i.e. a Pixmap with a single plane), unless string couldn't be * parsed correctly. In this case, None is returned and an error - * message is left in interp->result. The caller should never + * message is left in the interp's result. The caller should never * modify the bitmap that is returned, and should eventually call * Tk_FreeBitmap when the bitmap is no longer needed. * @@ -145,30 +256,78 @@ Tk_GetBitmap(interp, tkwin, string) Tcl_Interp *interp; /* Interpreter to use for error reporting, * this may be NULL. */ Tk_Window tkwin; /* Window in which bitmap will be used. */ - Tk_Uid string; /* Description of bitmap. See manual entry + CONST char *string; /* Description of bitmap. See manual entry * for details on legal syntax. */ { - NameKey nameKey; - IdKey idKey; - Tcl_HashEntry *nameHashPtr, *idHashPtr, *predefHashPtr; - register TkBitmap *bitmapPtr; + TkBitmap *bitmapPtr = GetBitmap(interp, tkwin, string); + if (bitmapPtr == NULL) { + return None; + } + return bitmapPtr->bitmap; +} + +/* + *---------------------------------------------------------------------- + * + * GetBitmap -- + * + * Given a string describing a bitmap, locate (or create if necessary) + * a bitmap that fits the description. This routine returns the + * internal data structure for the bitmap. This avoids extra + * hash table lookups in Tk_AllocBitmapFromObj. + * + * Results: + * The return value is the X identifer for the desired bitmap + * (i.e. a Pixmap with a single plane), unless string couldn't be + * parsed correctly. In this case, None is returned and an error + * message is left in the interp's result. The caller should never + * modify the bitmap that is returned, and should eventually call + * Tk_FreeBitmap when the bitmap is no longer needed. + * + * Side effects: + * The bitmap is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeBitmap or Tk_FreeBitmapFromObj, so that the database can + * be cleaned up when bitmaps aren't needed anymore. + * + *---------------------------------------------------------------------- + */ + +static TkBitmap * +GetBitmap(interp, tkwin, string) + Tcl_Interp *interp; /* Interpreter to use for error reporting, + * this may be NULL. */ + Tk_Window tkwin; /* Window in which bitmap will be used. */ + CONST char *string; /* Description of bitmap. See manual entry + * for details on legal syntax. */ +{ + Tcl_HashEntry *nameHashPtr, *predefHashPtr; + TkBitmap *bitmapPtr, *existingBitmapPtr; TkPredefBitmap *predefPtr; int new; Pixmap bitmap; int width, height; int dummy2; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (!initialized) { - BitmapInit(); + if (!dispPtr->bitmapInit) { + BitmapInit(dispPtr); } - nameKey.name = string; - nameKey.screen = Tk_Screen(tkwin); - nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new); + nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &new); if (!new) { - bitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr); - bitmapPtr->refCount++; - return bitmapPtr->bitmap; + existingBitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr); + for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL; + bitmapPtr = bitmapPtr->nextPtr) { + if (Tk_Display(tkwin) == bitmapPtr->display) { + bitmapPtr->resourceRefCount++; + return bitmapPtr; + } + } + } else { + existingBitmapPtr = NULL; } /* @@ -179,7 +338,7 @@ Tk_GetBitmap(interp, tkwin, string) * defined by a call to Tk_DefineBitmap. */ - if (*string == '@') { + if (*string == '@') { /* INTL: ISO char */ Tcl_DString buffer; int result; @@ -188,13 +347,19 @@ Tk_GetBitmap(interp, tkwin, string) " safe interpreter", (char *) NULL); goto error; } - - string = Tcl_TranslateFileName(interp, string + 1, &buffer); + + /* + * Note that we need to cast away the CONST from the string because + * Tcl_TranslateFileName is non const, even though it doesn't modify + * the string. + */ + + string = Tcl_TranslateFileName(interp, (char *) string + 1, &buffer); if (string == NULL) { goto error; } result = TkReadBitmapFile(Tk_Display(tkwin), - RootWindowOfScreen(nameKey.screen), string, + RootWindowOfScreen(Tk_Screen(tkwin)), string, (unsigned int *) &width, (unsigned int *) &height, &bitmap, &dummy2, &dummy2); if (result != BitmapSuccess) { @@ -207,7 +372,8 @@ Tk_GetBitmap(interp, tkwin, string) } Tcl_DStringFree(&buffer); } else { - predefHashPtr = Tcl_FindHashEntry(&tkPredefBitmapTable, string); + predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable, + string); if (predefHashPtr == NULL) { /* * The following platform specific call allows the user to @@ -236,7 +402,8 @@ Tk_GetBitmap(interp, tkwin, string) } } else { bitmap = XCreateBitmapFromData(Tk_Display(tkwin), - RootWindowOfScreen(nameKey.screen), predefPtr->source, + RootWindowOfScreen(Tk_Screen(tkwin)), + predefPtr->source, (unsigned) width, (unsigned) height); } } @@ -251,22 +418,24 @@ Tk_GetBitmap(interp, tkwin, string) bitmapPtr->width = width; bitmapPtr->height = height; bitmapPtr->display = Tk_Display(tkwin); - bitmapPtr->refCount = 1; - bitmapPtr->hashPtr = nameHashPtr; - idKey.display = bitmapPtr->display; - idKey.pixmap = bitmap; - idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, - &new); + bitmapPtr->resourceRefCount = 1; + bitmapPtr->objRefCount = 0; + bitmapPtr->nameHashPtr = nameHashPtr; + bitmapPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapIdTable, + (char *) bitmap, &new); if (!new) { panic("bitmap already registered in Tk_GetBitmap"); } + bitmapPtr->nextPtr = existingBitmapPtr; Tcl_SetHashValue(nameHashPtr, bitmapPtr); - Tcl_SetHashValue(idHashPtr, bitmapPtr); - return bitmapPtr->bitmap; + Tcl_SetHashValue(bitmapPtr->idHashPtr, bitmapPtr); + return bitmapPtr; error: - Tcl_DeleteHashEntry(nameHashPtr); - return None; + if (new) { + Tcl_DeleteHashEntry(nameHashPtr); + } + return NULL; } /* @@ -280,7 +449,7 @@ Tk_GetBitmap(interp, tkwin, string) * * Results: * A standard Tcl result. If an error occurs then TCL_ERROR is - * returned and a message is left in interp->result. + * returned and a message is left in the interp's result. * * Side effects: * "Name" is entered into the bitmap table and may be used from @@ -292,7 +461,7 @@ Tk_GetBitmap(interp, tkwin, string) int Tk_DefineBitmap(interp, name, source, width, height) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ - Tk_Uid name; /* Name to use for bitmap. Must not already + CONST char *name; /* Name to use for bitmap. Must not already * be defined as a bitmap. */ char *source; /* Address of bits for bitmap. */ int width; /* Width of bitmap. */ @@ -301,12 +470,23 @@ Tk_DefineBitmap(interp, name, source, width, height) int new; Tcl_HashEntry *predefHashPtr; TkPredefBitmap *predefPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * Initialize the Bitmap module if not initialized already for this + * thread. Since the current TkDisplay structure cannot be + * introspected from here, pass a NULL pointer to BitmapInit, + * which will know to initialize only the data in the + * ThreadSpecificData structure for the current thread. + */ - if (!initialized) { - BitmapInit(); + if (!tsdPtr->initialized) { + BitmapInit((TkDisplay *) NULL); } - predefHashPtr = Tcl_CreateHashEntry(&tkPredefBitmapTable, name, &new); + predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable, + name, &new); if (!new) { Tcl_AppendResult(interp, "bitmap \"", name, "\" is already defined", (char *) NULL); @@ -338,29 +518,27 @@ Tk_DefineBitmap(interp, name, source, width, height) *-------------------------------------------------------------- */ -Tk_Uid +char * Tk_NameOfBitmap(display, bitmap) Display *display; /* Display for which bitmap was * allocated. */ Pixmap bitmap; /* Bitmap whose name is wanted. */ { - IdKey idKey; Tcl_HashEntry *idHashPtr; TkBitmap *bitmapPtr; + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { + if (dispPtr == NULL || !dispPtr->bitmapInit) { unknown: panic("Tk_NameOfBitmap received unknown bitmap argument"); } - idKey.display = display; - idKey.pixmap = bitmap; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap); if (idHashPtr == NULL) { goto unknown; } bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr); - return ((NameKey *) bitmapPtr->hashPtr->key.words)->name; + return bitmapPtr->nameHashPtr->key.string; } /* @@ -390,18 +568,16 @@ Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr) int *widthPtr; /* Store bitmap width here. */ int *heightPtr; /* Store bitmap height here. */ { - IdKey idKey; Tcl_HashEntry *idHashPtr; TkBitmap *bitmapPtr; + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { + if (!dispPtr->bitmapInit) { unknownBitmap: panic("Tk_SizeOfBitmap received unknown bitmap argument"); } - idKey.display = display; - idKey.pixmap = bitmap; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap); if (idHashPtr == NULL) { goto unknownBitmap; } @@ -413,6 +589,56 @@ Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr) /* *---------------------------------------------------------------------- * + * FreeBitmap -- + * + * This procedure does all the work of releasing a bitmap allocated by + * Tk_GetBitmap or TkGetBitmapFromData. It is invoked by both + * Tk_FreeBitmap and Tk_FreeBitmapFromObj + * + * Results: + * None. + * + * Side effects: + * The reference count associated with bitmap is decremented, and + * it is officially deallocated if no-one is using it anymore. + * + *---------------------------------------------------------------------- + */ + +static void +FreeBitmap(bitmapPtr) + TkBitmap *bitmapPtr; /* Bitmap to be released. */ +{ + TkBitmap *prevPtr; + + bitmapPtr->resourceRefCount--; + if (bitmapPtr->resourceRefCount > 0) { + return; + } + + Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap); + Tcl_DeleteHashEntry(bitmapPtr->idHashPtr); + prevPtr = (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr); + if (prevPtr == bitmapPtr) { + if (bitmapPtr->nextPtr == NULL) { + Tcl_DeleteHashEntry(bitmapPtr->nameHashPtr); + } else { + Tcl_SetHashValue(bitmapPtr->nameHashPtr, bitmapPtr->nextPtr); + } + } else { + while (prevPtr->nextPtr != bitmapPtr) { + prevPtr = prevPtr->nextPtr; + } + prevPtr->nextPtr = bitmapPtr->nextPtr; + } + if (bitmapPtr->objRefCount == 0) { + ckfree((char *) bitmapPtr); + } +} + +/* + *---------------------------------------------------------------------- + * * Tk_FreeBitmap -- * * This procedure is called to release a bitmap allocated by @@ -435,26 +661,115 @@ Tk_FreeBitmap(display, bitmap) Pixmap bitmap; /* Bitmap to be released. */ { Tcl_HashEntry *idHashPtr; - register TkBitmap *bitmapPtr; - IdKey idKey; + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { + if (!dispPtr->bitmapInit) { panic("Tk_FreeBitmap called before Tk_GetBitmap"); } - idKey.display = display; - idKey.pixmap = bitmap; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap); if (idHashPtr == NULL) { panic("Tk_FreeBitmap received unknown bitmap argument"); } - bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr); - bitmapPtr->refCount--; - if (bitmapPtr->refCount == 0) { - Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap); - Tcl_DeleteHashEntry(idHashPtr); - Tcl_DeleteHashEntry(bitmapPtr->hashPtr); - ckfree((char *) bitmapPtr); + FreeBitmap((TkBitmap *) Tcl_GetHashValue(idHashPtr)); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_FreeBitmapFromObj -- + * + * This procedure is called to release a bitmap allocated by + * Tk_AllocBitmapFromObj. It does not throw away the Tcl_Obj *; + * it only gets rid of the hash table entry for this bitmap + * and clears the cached value that is normally stored in the object. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with the bitmap represented by + * objPtr is decremented, and the bitmap is released to X if there are + * no remaining uses for it. + * + *---------------------------------------------------------------------- + */ + +void +Tk_FreeBitmapFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window this bitmap lives in. Needed + * for the display value. */ + Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */ +{ + FreeBitmap(GetBitmapFromObj(tkwin, objPtr)); +} + +/* + *--------------------------------------------------------------------------- + * + * FreeBitmapObjProc -- + * + * 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 bitmapPtr needs to be changed. + * + * Results: + * None. + * + * Side effects: + * The object reference count is decremented. When both it + * and the hash ref count go to zero, the color's resources + * are released. + * + *--------------------------------------------------------------------------- + */ + +static void +FreeBitmapObjProc(objPtr) + Tcl_Obj *objPtr; /* The object we are releasing. */ +{ + TkBitmap *bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1; + + if (bitmapPtr != NULL) { + bitmapPtr->objRefCount--; + if ((bitmapPtr->objRefCount == 0) + && (bitmapPtr->resourceRefCount == 0)) { + ckfree((char *) bitmapPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; + } +} + +/* + *--------------------------------------------------------------------------- + * + * DupBitmapObjProc -- + * + * When a cached bitmap object is duplicated, this is called to + * update the internal reps. + * + * Results: + * None. + * + * Side effects: + * The color's objRefCount is incremented and the internal rep + * of the copy is set to point to it. + * + *--------------------------------------------------------------------------- + */ + +static void +DupBitmapObjProc(srcObjPtr, dupObjPtr) + 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; + + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr; + + if (bitmapPtr != NULL) { + bitmapPtr->objRefCount++; } } @@ -471,7 +786,7 @@ Tk_FreeBitmap(display, bitmap) * The return value is the X identifer for the desired bitmap * (a one-plane Pixmap), unless it couldn't be created properly. * In this case, None is returned and an error message is left in - * interp->result. The caller should never modify the bitmap that + * the interp's result. The caller should never modify the bitmap that * is returned, and should eventually call Tk_FreeBitmap when the * bitmap is no longer needed. * @@ -494,25 +809,24 @@ Tk_GetBitmapFromData(interp, tkwin, source, width, height) { DataKey nameKey; Tcl_HashEntry *dataHashPtr; - Tk_Uid name; int new; - char string[20]; - static int autoNumber = 0; + char string[16 + TCL_INTEGER_SPACE]; + char *name; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - BitmapInit(); - } + BitmapInit(dispPtr); nameKey.source = source; nameKey.width = width; nameKey.height = height; - dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &nameKey, &new); + dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable, + (char *) &nameKey, &new); if (!new) { - name = (Tk_Uid) Tcl_GetHashValue(dataHashPtr); + name = (char *) Tcl_GetHashValue(dataHashPtr); } else { - autoNumber++; - sprintf(string, "_tk%d", autoNumber); - name = Tk_GetUid(string); + dispPtr->bitmapAutoNumber++; + sprintf(string, "_tk%d", dispPtr->bitmapAutoNumber); + name = string; Tcl_SetHashValue(dataHashPtr, name); if (Tk_DefineBitmap(interp, name, source, width, height) != TCL_OK) { Tcl_DeleteHashEntry(dataHashPtr); @@ -525,63 +839,226 @@ Tk_GetBitmapFromData(interp, tkwin, source, width, height) /* *---------------------------------------------------------------------- * - * BitmapInit -- + * Tk_GetBitmapFromObj -- + * + * Returns the bitmap referred to by a Tcl object. The bitmap must + * already have been allocated via a call to Tk_AllocBitmapFromObj + * or Tk_GetBitmap. + * + * Results: + * Returns the Pixmap that matches the tkwin and the string rep + * of objPtr. * - * Initialize the structures used for bitmap management. + * Side effects: + * If the object is not already a bitmap, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +Pixmap +Tk_GetBitmapFromObj(tkwin, objPtr) + Tk_Window tkwin; + Tcl_Obj *objPtr; /* The object from which to get pixels. */ +{ + TkBitmap *bitmapPtr = GetBitmapFromObj(tkwin, objPtr); + return bitmapPtr->bitmap; +} + +/* + *---------------------------------------------------------------------- + * + * GetBitmapFromObj -- + * + * Returns the bitmap referred to by a Tcl object. The bitmap must + * already have been allocated via a call to Tk_AllocBitmapFromObj + * or Tk_GetBitmap. + * + * Results: + * Returns the TkBitmap * that matches the tkwin and the string rep + * of objPtr. + * + * Side effects: + * If the object is not already a bitmap, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +static TkBitmap * +GetBitmapFromObj(tkwin, objPtr) + Tk_Window tkwin; /* Window in which the bitmap will be used. */ + Tcl_Obj *objPtr; /* The object that describes the desired + * bitmap. */ +{ + TkBitmap *bitmapPtr; + Tcl_HashEntry *hashPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + if (objPtr->typePtr != &bitmapObjType) { + InitBitmapObj(objPtr); + } + + bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1; + if (bitmapPtr != NULL) { + if ((bitmapPtr->resourceRefCount > 0) + && (Tk_Display(tkwin) == bitmapPtr->display)) { + return bitmapPtr; + } + hashPtr = bitmapPtr->nameHashPtr; + FreeBitmapObjProc(objPtr); + } else { + hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, + Tcl_GetString(objPtr)); + if (hashPtr == NULL) { + goto error; + } + } + + /* + * At this point we've got a hash table entry, off of which hang + * one or more TkBitmap structures. See if any of them will work. + */ + + for (bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr); + bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) { + if (Tk_Display(tkwin) == bitmapPtr->display) { + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr; + bitmapPtr->objRefCount++; + return bitmapPtr; + } + } + + error: + panic("GetBitmapFromObj called with non-existent bitmap!"); + /* + * The following code isn't reached; it's just there to please compilers. + */ + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * InitBitmapObj -- + * + * Bookeeping procedure to change an objPtr to a bitmap type. * * Results: * None. * * Side effects: + * The old internal rep of the object is freed. The internal + * rep is cleared. The final form of the object is set + * by either Tk_AllocBitmapFromObj or GetBitmapFromObj. + * + *---------------------------------------------------------------------- + */ + +static void +InitBitmapObj(objPtr) + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + + /* + * Free the old internalRep before setting the new one. + */ + + Tcl_GetString(objPtr); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &bitmapObjType; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * BitmapInit -- + * Initializes hash tables used by this module. Initializes + * tables stored in TkDisplay structure if a TkDisplay pointer + * is passed in. Iinitializes the thread-local data + * in the current thread's ThreadSpecificData structure. + * + * Results: + * None. + * + * Side effects: * Read the code. * *---------------------------------------------------------------------- */ static void -BitmapInit() +BitmapInit(dispPtr) + TkDisplay *dispPtr; /* TkDisplay structure encapsulating + * thread-specific data used by this + * module, or NULL if unavailable. */ { Tcl_Interp *dummy; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * First initialize the data in the ThreadSpecificData strucuture, + * if needed. + */ - dummy = Tcl_CreateInterp(); - initialized = 1; - Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int)); - Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int)); - Tcl_InitHashTable(&tkPredefBitmapTable, TCL_ONE_WORD_KEYS); + if (!tsdPtr->initialized) { + tsdPtr->initialized = 1; + dummy = Tcl_CreateInterp(); + Tcl_InitHashTable(&tsdPtr->predefBitmapTable, TCL_STRING_KEYS); + + Tk_DefineBitmap(dummy, "error", (char *) error_bits, + error_width, error_height); + Tk_DefineBitmap(dummy, "gray75", (char *) gray75_bits, + gray75_width, gray75_height); + Tk_DefineBitmap(dummy, "gray50", (char *) gray50_bits, + gray50_width, gray50_height); + Tk_DefineBitmap(dummy, "gray25", (char *) gray25_bits, + gray25_width, gray25_height); + Tk_DefineBitmap(dummy, "gray12", (char *) gray12_bits, + gray12_width, gray12_height); + Tk_DefineBitmap(dummy, "hourglass", (char *) hourglass_bits, + hourglass_width, hourglass_height); + Tk_DefineBitmap(dummy, "info", (char *) info_bits, + info_width, info_height); + Tk_DefineBitmap(dummy, "questhead", (char *) questhead_bits, + questhead_width, questhead_height); + Tk_DefineBitmap(dummy, "question", (char *) question_bits, + question_width, question_height); + Tk_DefineBitmap(dummy, "warning", (char *) warning_bits, + warning_width, warning_height); + + TkpDefineNativeBitmaps(); + Tcl_DeleteInterp(dummy); + } /* - * The call below is tricky: can't use sizeof(IdKey) because it - * gets padded with extra unpredictable bytes on some 64-bit - * machines. + * Was a valid TkDisplay pointer passed? If so, initialize the + * Bitmap module tables in that structure. */ - Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Pixmap)) - /sizeof(int)); - - Tk_DefineBitmap(dummy, Tk_GetUid("error"), (char *) error_bits, - error_width, error_height); - Tk_DefineBitmap(dummy, Tk_GetUid("gray75"), (char *) gray75_bits, - gray75_width, gray75_height); - Tk_DefineBitmap(dummy, Tk_GetUid("gray50"), (char *) gray50_bits, - gray50_width, gray50_height); - Tk_DefineBitmap(dummy, Tk_GetUid("gray25"), (char *) gray25_bits, - gray25_width, gray25_height); - Tk_DefineBitmap(dummy, Tk_GetUid("gray12"), (char *) gray12_bits, - gray12_width, gray12_height); - Tk_DefineBitmap(dummy, Tk_GetUid("hourglass"), (char *) hourglass_bits, - hourglass_width, hourglass_height); - Tk_DefineBitmap(dummy, Tk_GetUid("info"), (char *) info_bits, - info_width, info_height); - Tk_DefineBitmap(dummy, Tk_GetUid("questhead"), (char *) questhead_bits, - questhead_width, questhead_height); - Tk_DefineBitmap(dummy, Tk_GetUid("question"), (char *) question_bits, - question_width, question_height); - Tk_DefineBitmap(dummy, Tk_GetUid("warning"), (char *) warning_bits, - warning_width, warning_height); - - TkpDefineNativeBitmaps(); - - Tcl_DeleteInterp(dummy); + if (dispPtr != NULL) { + dispPtr->bitmapInit = 1; + Tcl_InitHashTable(&dispPtr->bitmapNameTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&dispPtr->bitmapDataTable, sizeof(DataKey) + /sizeof(int)); + + /* + * The call below is tricky: can't use sizeof(IdKey) because it + * gets padded with extra unpredictable bytes on some 64-bit + * machines. + */ + + /* + * The comment above doesn't make sense... + */ + Tcl_InitHashTable(&dispPtr->bitmapIdTable, TCL_ONE_WORD_KEYS); + } } /* @@ -627,4 +1104,82 @@ TkReadBitmapFile(display, d, filename, width_return, height_return, ckfree(data); return BitmapSuccess; + } + +/* + *---------------------------------------------------------------------- + * + * TkDebugBitmap -- + * + * This procedure returns debugging information about a bitmap. + * + * Results: + * The return value is a list with one sublist for each TkBitmap + * corresponding to "name". Each sublist has two elements that + * contain the resourceRefCount and objRefCount fields from the + * TkBitmap structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkDebugBitmap(tkwin, name) + Tk_Window tkwin; /* The window in which the bitmap will be + * used (not currently used). */ + char *name; /* Name of the desired color. */ +{ + TkBitmap *bitmapPtr; + Tcl_HashEntry *hashPtr; + Tcl_Obj *resultPtr, *objPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + resultPtr = Tcl_NewObj(); + hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, name); + if (hashPtr != NULL) { + bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr); + if (bitmapPtr == NULL) { + panic("TkDebugBitmap found empty hash table entry"); + } + for ( ; (bitmapPtr != NULL); bitmapPtr = bitmapPtr->nextPtr) { + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(bitmapPtr->resourceRefCount)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(bitmapPtr->objRefCount)); + Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); + } + } + return resultPtr; +} + + +/* + *---------------------------------------------------------------------- + * + * TkGetBitmapPredefTable -- + * This procedure is used by tkMacBitmap.c to access the thread- + * specific predefBitmap table that maps from the names of + * the predefined bitmaps to data associated with those + * bitmaps. It is required because the table is allocated in + * thread-local storage and is not visible outside this file. + + * Results: + * Returns a pointer to the predefined bitmap hash table for + * the current thread. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +Tcl_HashTable * +TkGetBitmapPredefTable() +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return &tsdPtr->predefBitmapTable; } diff --git a/generic/tkButton.c b/generic/tkButton.c index aea1e58..dce66f9 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -3,199 +3,448 @@ * * This module implements a collection of button-like * widgets for the Tk toolkit. The widgets implemented - * include labels, buttons, check buttons, and radio - * buttons. + * include labels, buttons, checkbuttons, and radiobuttons. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * 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. * - * RCS: @(#) $Id: tkButton.c,v 1.2 1998/09/14 18:23:04 stanton Exp $ + * RCS: @(#) $Id: tkButton.c,v 1.3 1999/04/16 01:51:10 stanton Exp $ */ #include "tkButton.h" #include "default.h" /* - * Class names for buttons, indexed by one of the type values above. + * Class names for buttons, indexed by one of the type values defined + * in tkButton.h. */ static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"}; /* - * The class procedure table for the button widget. + * The following table defines the legal values for the -default option. + * It is used together with the "enum defaultValue" declaration in tkButton.h. */ -static int configFlags[] = {LABEL_MASK, BUTTON_MASK, - CHECK_BUTTON_MASK, RADIO_BUTTON_MASK}; +static char *defaultStrings[] = { + "active", "disabled", "normal", (char *) NULL +}; + +/* + * The following table defines the legal values for the -state option. + * It is used together with the "enum state" declaration in tkButton.h. + */ + +static char *stateStrings[] = { + "active", "disabled", "normal", (char *) NULL +}; /* - * Information used for parsing configuration specs: + * Information used for parsing configuration options. There is a + * separate table for each of the four widget classes. */ -Tk_ConfigSpec tkpButtonConfigSpecs[] = { - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_BUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkButton, activeBorder), - BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK - |TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_BUTTON_ACTIVE_BG_MONO, Tk_Offset(TkButton, activeBorder), - BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK - |TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", - DEF_BUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg), - BUTTON_MASK|TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", - DEF_CHKRAD_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", - DEF_BUTTON_ACTIVE_FG_MONO, Tk_Offset(TkButton, activeFg), - BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK - |TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", - DEF_BUTTON_ANCHOR, Tk_Offset(TkButton, anchor), ALL_MASK}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_BUTTON_BG_COLOR, Tk_Offset(TkButton, normalBorder), - ALL_MASK | TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_BUTTON_BG_MONO, Tk_Offset(TkButton, normalBorder), - ALL_MASK | TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, ALL_MASK}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, ALL_MASK}, - {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap", - DEF_BUTTON_BITMAP, Tk_Offset(TkButton, bitmap), - ALL_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidth), ALL_MASK}, - {TK_CONFIG_STRING, "-command", "command", "Command", - DEF_BUTTON_COMMAND, Tk_Offset(TkButton, command), - BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_BUTTON_CURSOR, Tk_Offset(TkButton, cursor), - ALL_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_UID, "-default", "default", "Default", - DEF_BUTTON_DEFAULT, Tk_Offset(TkButton, defaultState), BUTTON_MASK}, - {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", +static Tk_OptionSpec labelOptionSpecs[] = { + {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}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", + DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr), + Tk_Offset(TkButton, borderWidth), 0, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-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", + DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0}, + {TK_OPTION_STRING, "-height", "height", "Height", + DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0}, + {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR, + -1, Tk_Offset(TkButton, highlightBorder), 0, + (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_LABEL_HIGHLIGHT_WIDTH, + Tk_Offset(TkButton, highlightWidthPtr), + Tk_Offset(TkButton, highlightWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-image", "image", "Image", + DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr), + Tk_Offset(TkButton, padX), 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", "padY", "Pad", + DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr), + Tk_Offset(TkButton, padY), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-text", "text", "Text", + DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0}, + {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", + DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INT, "-underline", "underline", "Underline", + DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0}, + {TK_OPTION_STRING, "-width", "width", "Width", + DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0}, + {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", + DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr), + Tk_Offset(TkButton, wrapLength), 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0, 0, 0} +}; + +static 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}, + {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_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}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", + DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr), + Tk_Offset(TkButton, borderWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-command", "command", "Command", + DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1, + TK_OPTION_NULL_OK, 0, 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}, + {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", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-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", + DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0}, + {TK_OPTION_STRING, "-height", "height", "Height", + DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0}, + {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR, + -1, Tk_Offset(TkButton, highlightBorder), 0, + (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH, + Tk_Offset(TkButton, highlightWidthPtr), + Tk_Offset(TkButton, highlightWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-image", "image", "Image", + DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_BUTTON_PADX, Tk_Offset(TkButton, padXPtr), + Tk_Offset(TkButton, padX), 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", "padY", "Pad", + DEF_BUTTON_PADY, Tk_Offset(TkButton, padYPtr), + Tk_Offset(TkButton, padY), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_BUTTON_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}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-text", "text", "Text", + DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0}, + {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", + DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INT, "-underline", "underline", "Underline", + DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0}, + {TK_OPTION_STRING, "-width", "width", "Width", + DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0}, + {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", + DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr), + Tk_Offset(TkButton, wrapLength), 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, 0, 0} +}; + +static 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}, + {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_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}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", + DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr), + Tk_Offset(TkButton, borderWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-command", "command", "Command", + DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR, - Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK - |RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", - "DisabledForeground", DEF_BUTTON_DISABLED_FG_MONO, - Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK - |RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, ALL_MASK}, - {TK_CONFIG_FONT, "-font", "font", "Font", - DEF_BUTTON_FONT, Tk_Offset(TkButton, tkfont), - ALL_MASK}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_BUTTON_FG, Tk_Offset(TkButton, normalFg), LABEL_MASK|BUTTON_MASK}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_CHKRAD_FG, Tk_Offset(TkButton, normalFg), CHECK_BUTTON_MASK - |RADIO_BUTTON_MASK}, - {TK_CONFIG_STRING, "-height", "height", "Height", - DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightString), ALL_MASK}, - {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground", - "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG, - Tk_Offset(TkButton, highlightBorder), ALL_MASK}, - {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_BUTTON_HIGHLIGHT, Tk_Offset(TkButton, highlightColorPtr), - ALL_MASK}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", - "HighlightThickness", - DEF_LABEL_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth), - LABEL_MASK}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", - "HighlightThickness", - DEF_BUTTON_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth), - BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, - {TK_CONFIG_STRING, "-image", "image", "Image", - DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imageString), - ALL_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn", - DEF_BUTTON_INDICATOR, Tk_Offset(TkButton, indicatorOn), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, - {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", - DEF_BUTTON_JUSTIFY, Tk_Offset(TkButton, justify), ALL_MASK}, - {TK_CONFIG_STRING, "-offvalue", "offValue", "Value", - DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValue), - CHECK_BUTTON_MASK}, - {TK_CONFIG_STRING, "-onvalue", "onValue", "Value", - DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValue), - CHECK_BUTTON_MASK}, - {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", - DEF_BUTTON_PADX, Tk_Offset(TkButton, padX), BUTTON_MASK}, - {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", - DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padX), - LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, - {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", - DEF_BUTTON_PADY, Tk_Offset(TkButton, padY), BUTTON_MASK}, - {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", - DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padY), - LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_BUTTON_RELIEF, Tk_Offset(TkButton, relief), BUTTON_MASK}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_LABCHKRAD_RELIEF, Tk_Offset(TkButton, relief), - LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, - {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background", - DEF_BUTTON_SELECT_COLOR, Tk_Offset(TkButton, selectBorder), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background", - DEF_BUTTON_SELECT_MONO, Tk_Offset(TkButton, selectBorder), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-selectimage", "selectImage", "SelectImage", - DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImageString), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_UID, "-state", "state", "State", - DEF_BUTTON_STATE, Tk_Offset(TkButton, state), - BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus), - LABEL_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus), - BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-text", "text", "Text", - DEF_BUTTON_TEXT, Tk_Offset(TkButton, text), ALL_MASK}, - {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", - DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarName), - ALL_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_INT, "-underline", "underline", "Underline", - DEF_BUTTON_UNDERLINE, Tk_Offset(TkButton, underline), ALL_MASK}, - {TK_CONFIG_STRING, "-value", "value", "Value", - DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValue), - RADIO_BUTTON_MASK}, - {TK_CONFIG_STRING, "-variable", "variable", "Variable", - DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName), - RADIO_BUTTON_MASK}, - {TK_CONFIG_STRING, "-variable", "variable", "Variable", - DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName), - CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-width", "width", "Width", - DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthString), ALL_MASK}, - {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength", - DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLength), ALL_MASK}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} + -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK, + (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-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", + DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0}, + {TK_OPTION_STRING, "-height", "height", "Height", + DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0}, + {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR, + -1, Tk_Offset(TkButton, highlightBorder), 0, + (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH, + Tk_Offset(TkButton, highlightWidthPtr), + Tk_Offset(TkButton, highlightWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-image", "image", "Image", + DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn", + DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn), 0, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0}, + {TK_OPTION_STRING, "-offvalue", "offValue", "Value", + DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValuePtr), -1, 0, 0, 0}, + {TK_OPTION_STRING, "-onvalue", "onValue", "Value", + DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr), + Tk_Offset(TkButton, padX), 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", "padY", "Pad", + DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr), + Tk_Offset(TkButton, padY), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + 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_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}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-text", "text", "Text", + DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0}, + {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", + DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INT, "-underline", "underline", "Underline", + DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0}, + {TK_OPTION_STRING, "-variable", "variable", "Variable", + DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-width", "width", "Width", + DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0}, + {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", + DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr), + Tk_Offset(TkButton, wrapLength), 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, 0, 0} +}; + +static 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}, + {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_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}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", + DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr), + Tk_Offset(TkButton, borderWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-command", "command", "Command", + DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor), + TK_OPTION_NULL_OK, 0, 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", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-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", + DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0}, + {TK_OPTION_STRING, "-height", "height", "Height", + DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0}, + {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR, + -1, Tk_Offset(TkButton, highlightBorder), 0, + (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH, + Tk_Offset(TkButton, highlightWidthPtr), + Tk_Offset(TkButton, highlightWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-image", "image", "Image", + DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn", + DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn), + 0, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr), + Tk_Offset(TkButton, padX), 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", "padY", "Pad", + DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr), + Tk_Offset(TkButton, padY), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + 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_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}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-text", "text", "Text", + DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0}, + {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", + DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INT, "-underline", "underline", "Underline", + DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0}, + {TK_OPTION_STRING, "-value", "value", "Value", + DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0}, + {TK_OPTION_STRING, "-variable", "variable", "Variable", + DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1, + 0, 0, 0}, + {TK_OPTION_STRING, "-width", "width", "Width", + DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0}, + {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", + DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr), + Tk_Offset(TkButton, wrapLength), 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, 0, 0} }; /* - * String to print out in error messages, identifying options for - * widget commands for different types of labels or buttons: + * The following table maps from one of the type values defined in + * tkButton.h, such as TYPE_LABEL, to the option template for that + * class of widgets. */ -static char *optionStrings[] = { - "cget or configure", - "cget, configure, flash, or invoke", - "cget, configure, deselect, flash, invoke, select, or toggle", - "cget, configure, deselect, flash, invoke, or select" +static Tk_OptionSpec *optionSpecs[] = { + labelOptionSpecs, + buttonOptionSpecs, + checkbuttonOptionSpecs, + radiobuttonOptionSpecs +}; + +/* + * The following tables define the widget commands supported by + * each of the classes, and map the indexes into the string tables + * into a single enumerated type used to dispatch the widget command. + */ + +static char *commandNames[][8] = { + {"cget", "configure", (char *) NULL}, + {"cget", "configure", "flash", "invoke", (char *) NULL}, + {"cget", "configure", "deselect", "flash", "invoke", "select", + "toggle", (char *) NULL}, + {"cget", "configure", "deselect", "flash", "invoke", "select", + (char *) NULL} +}; +enum command { + COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH, + COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE +}; +static enum command map[][8] = { + {COMMAND_CGET, COMMAND_CONFIGURE}, + {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_FLASH, COMMAND_INVOKE}, + {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH, + COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE}, + {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH, + COMMAND_INVOKE, COMMAND_SELECT} }; /* @@ -205,8 +454,8 @@ static char *optionStrings[] = { static void ButtonCmdDeletedProc _ANSI_ARGS_(( ClientData clientData)); static int ButtonCreate _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv, - int type)); + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[], int type)); static void ButtonEventProc _ANSI_ARGS_((ClientData clientData, XEvent *eventPtr)); static void ButtonImageProc _ANSI_ARGS_((ClientData clientData, @@ -221,13 +470,13 @@ static char * ButtonTextVarProc _ANSI_ARGS_((ClientData clientData, static char * ButtonVarProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)); -static int ButtonWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +static int ButtonWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static int ConfigureButton _ANSI_ARGS_((Tcl_Interp *interp, - TkButton *butPtr, int argc, char **argv, - int flags)); + TkButton *butPtr, int objc, + Tcl_Obj *CONST objv[])); static void DestroyButton _ANSI_ARGS_((TkButton *butPtr)); - /* *-------------------------------------------------------------- @@ -249,47 +498,43 @@ static void DestroyButton _ANSI_ARGS_((TkButton *butPtr)); */ int -Tk_ButtonCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_ButtonObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { - return ButtonCreate(clientData, interp, argc, argv, TYPE_BUTTON); + return ButtonCreate(clientData, interp, objc, objv, TYPE_BUTTON); } int -Tk_CheckbuttonCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_CheckbuttonObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { - return ButtonCreate(clientData, interp, argc, argv, TYPE_CHECK_BUTTON); + return ButtonCreate(clientData, interp, objc, objv, TYPE_CHECK_BUTTON); } int -Tk_LabelCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_LabelObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { - return ButtonCreate(clientData, interp, argc, argv, TYPE_LABEL); + return ButtonCreate(clientData, interp, objc, objv, TYPE_LABEL); } int -Tk_RadiobuttonCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_RadiobuttonObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { - return ButtonCreate(clientData, interp, argc, argv, TYPE_RADIO_BUTTON); + return ButtonCreate(clientData, interp, objc, objv, TYPE_RADIO_BUTTON); } /* @@ -311,23 +556,42 @@ Tk_RadiobuttonCmd(clientData, interp, argc, argv) */ static int -ButtonCreate(clientData, interp, argc, argv, type) - ClientData clientData; /* Main window associated with - * interpreter. */ +ButtonCreate(clientData, interp, objc, objv, type) + ClientData clientData; /* Option table for this widget class, or + * NULL if not created yet. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ int type; /* Type of button to create: TYPE_LABEL, * TYPE_BUTTON, TYPE_CHECK_BUTTON, or * TYPE_RADIO_BUTTON. */ { - register TkButton *butPtr; - Tk_Window tkwin = (Tk_Window) clientData; - Tk_Window new; + TkButton *butPtr; + Tk_OptionTable optionTable; + Tk_Window tkwin; + + optionTable = (Tk_OptionTable) clientData; + if (optionTable == NULL) { + Tcl_CmdInfo info; + char *name; + + /* + * We haven't created the option table for this widget class + * yet. Do it now and save the table as the clientData for + * the command, so we'll have access to it in future + * invocations of the command. + */ - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + TkpButtonSetDefaults(optionSpecs[type]); + optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]); + name = Tcl_GetString(objv[0]); + Tcl_GetCommandInfo(interp, name, &info); + info.objClientData = (ClientData) optionTable; + Tcl_SetCommandInfo(interp, name, &info); + } + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } @@ -335,39 +599,43 @@ ButtonCreate(clientData, interp, argc, argv, type) * Create the new window. */ - new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL); - if (new == NULL) { + tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), + Tcl_GetString(objv[1]), (char *) NULL); + if (tkwin == NULL) { return TCL_ERROR; } - Tk_SetClass(new, classNames[type]); - butPtr = TkpCreateButton(new); + Tk_SetClass(tkwin, classNames[type]); + butPtr = TkpCreateButton(tkwin); - TkSetClassProcs(new, &tkpButtonProcs, (ClientData) butPtr); + TkSetClassProcs(tkwin, &tkpButtonProcs, (ClientData) butPtr); /* * Initialize the data structure for the button. */ - butPtr->tkwin = new; - butPtr->display = Tk_Display(new); - butPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(butPtr->tkwin), - ButtonWidgetCmd, (ClientData) butPtr, ButtonCmdDeletedProc); + butPtr->tkwin = tkwin; + butPtr->display = Tk_Display(tkwin); butPtr->interp = interp; + butPtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin), + ButtonWidgetObjCmd, (ClientData) butPtr, ButtonCmdDeletedProc); butPtr->type = type; - butPtr->text = NULL; + butPtr->optionTable = optionTable; + butPtr->textPtr = NULL; butPtr->underline = -1; - butPtr->textVarName = NULL; + butPtr->textVarNamePtr = NULL; butPtr->bitmap = None; - butPtr->imageString = NULL; + butPtr->imagePtr = NULL; butPtr->image = NULL; - butPtr->selectImageString = NULL; + butPtr->selectImagePtr = NULL; butPtr->selectImage = NULL; - butPtr->state = tkNormalUid; + butPtr->state = STATE_NORMAL; butPtr->normalBorder = NULL; butPtr->activeBorder = NULL; + butPtr->borderWidthPtr = NULL; butPtr->borderWidth = 0; butPtr->relief = TK_RELIEF_FLAT; + butPtr->highlightWidthPtr = NULL; butPtr->highlightWidth = 0; butPtr->highlightBorder = NULL; butPtr->highlightColorPtr = NULL; @@ -378,43 +646,53 @@ ButtonCreate(clientData, interp, argc, argv, type) butPtr->disabledFg = NULL; butPtr->normalTextGC = None; butPtr->activeTextGC = None; - butPtr->gray = None; butPtr->disabledGC = None; + butPtr->gray = None; butPtr->copyGC = None; - butPtr->widthString = NULL; - butPtr->heightString = NULL; + butPtr->widthPtr = NULL; butPtr->width = 0; + butPtr->heightPtr = NULL; butPtr->height = 0; + butPtr->wrapLengthPtr = NULL; butPtr->wrapLength = 0; + butPtr->padXPtr = NULL; butPtr->padX = 0; + butPtr->padYPtr = NULL; butPtr->padY = 0; butPtr->anchor = TK_ANCHOR_CENTER; butPtr->justify = TK_JUSTIFY_CENTER; - butPtr->textLayout = NULL; butPtr->indicatorOn = 0; butPtr->selectBorder = NULL; + butPtr->textWidth = 0; + butPtr->textHeight = 0; + butPtr->textLayout = NULL; butPtr->indicatorSpace = 0; butPtr->indicatorDiameter = 0; - butPtr->defaultState = tkDisabledUid; - butPtr->selVarName = NULL; - butPtr->onValue = NULL; - butPtr->offValue = NULL; + butPtr->defaultState = DEFAULT_DISABLED; + butPtr->selVarNamePtr = NULL; + butPtr->onValuePtr = NULL; + butPtr->offValuePtr = NULL; butPtr->cursor = None; - butPtr->command = NULL; - butPtr->takeFocus = NULL; + butPtr->takeFocusPtr = NULL; + butPtr->commandPtr = NULL; butPtr->flags = 0; Tk_CreateEventHandler(butPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, ButtonEventProc, (ClientData) butPtr); - if (ConfigureButton(interp, butPtr, argc - 2, argv + 2, - configFlags[type]) != TCL_OK) { + if (Tk_InitOptions(interp, (char *) butPtr, optionTable, tkwin) + != TCL_OK) { + Tk_DestroyWindow(butPtr->tkwin); + return TCL_ERROR; + } + if (ConfigureButton(interp, butPtr, objc - 2, objv + 2) != TCL_OK) { Tk_DestroyWindow(butPtr->tkwin); return TCL_ERROR; } - interp->result = Tk_PathName(butPtr->tkwin); + Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(butPtr->tkwin), + -1); return TCL_OK; } @@ -437,147 +715,155 @@ ButtonCreate(clientData, interp, argc, argv, type) */ static int -ButtonWidgetCmd(clientData, interp, argc, argv) +ButtonWidgetObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about button widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { - register TkButton *butPtr = (TkButton *) clientData; - int result = TCL_OK; - size_t length; - int c; - - if (argc < 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s option ?arg arg ...?\"", - argv[0]); + TkButton *butPtr = (TkButton *) clientData; + int index; + int result; + Tcl_Obj *objPtr; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } + result = Tcl_GetIndexFromObj(interp, objv[1], commandNames[butPtr->type], + "option", 0, &index); + if (result != TCL_OK) { + return result; + } Tcl_Preserve((ClientData) butPtr); - c = argv[1][0]; - length = strlen(argv[1]); - - 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\"", - (char *) NULL); - goto error; - } - result = Tk_ConfigureValue(interp, butPtr->tkwin, tkpButtonConfigSpecs, - (char *) butPtr, argv[2], configFlags[butPtr->type]); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, butPtr->tkwin, - tkpButtonConfigSpecs, (char *) butPtr, (char *) NULL, - configFlags[butPtr->type]); - } else if (argc == 3) { - result = Tk_ConfigureInfo(interp, butPtr->tkwin, - tkpButtonConfigSpecs, (char *) butPtr, argv[2], - configFlags[butPtr->type]); - } else { - result = ConfigureButton(interp, butPtr, argc-2, argv+2, - configFlags[butPtr->type] | TK_CONFIG_ARGV_ONLY); - } - } else if ((c == 'd') && (strncmp(argv[1], "deselect", length) == 0) - && (butPtr->type >= TYPE_CHECK_BUTTON)) { - if (argc > 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s deselect\"", - argv[0]); - goto error; - } - if (butPtr->type == TYPE_CHECK_BUTTON) { - if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; + + switch (map[butPtr->type][index]) { + case COMMAND_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); + goto error; } - } else if (butPtr->flags & SELECTED) { - if (Tcl_SetVar(interp, butPtr->selVarName, "", - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; - }; - } - } else if ((c == 'f') && (strncmp(argv[1], "flash", length) == 0) - && (butPtr->type != TYPE_LABEL)) { - int i; - - if (argc > 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s flash\"", - argv[0]); - goto error; - } - if (butPtr->state != tkDisabledUid) { - for (i = 0; i < 4; i++) { - butPtr->state = (butPtr->state == tkNormalUid) - ? tkActiveUid : tkNormalUid; - Tk_SetBackgroundFromBorder(butPtr->tkwin, - (butPtr->state == tkActiveUid) ? butPtr->activeBorder - : butPtr->normalBorder); - TkpDisplayButton((ClientData) butPtr); - - /* - * Special note: must cancel any existing idle handler - * for TkpDisplayButton; it's no longer needed, and TkpDisplayButton - * cleared the REDRAW_PENDING flag. - */ - - Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr); - XFlush(butPtr->display); - Tcl_Sleep(50); + objPtr = Tk_GetOptionValue(interp, (char *) butPtr, + butPtr->optionTable, objv[2], butPtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); } + break; } - } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0) - && (butPtr->type > TYPE_LABEL)) { - if (argc > 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s invoke\"", - argv[0]); - goto error; + + case COMMAND_CONFIGURE: { + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) butPtr, + butPtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + butPtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } + } else { + result = ConfigureButton(interp, butPtr, objc-2, objv+2); + } + break; } - if (butPtr->state != tkDisabledUid) { - result = TkInvokeButton(butPtr); + + case COMMAND_DESELECT: { + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "deselect"); + goto error; + } + if (butPtr->type == TYPE_CHECK_BUTTON) { + if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL, + butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { + goto error; + } + } else if (butPtr->flags & SELECTED) { + if (Tcl_ObjSetVar2(interp, + butPtr->selVarNamePtr, NULL, Tcl_NewObj(), + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { + goto error; + } + } + break; } - } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0) - && (butPtr->type >= TYPE_CHECK_BUTTON)) { - if (argc > 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s select\"", - argv[0]); - goto error; + + case COMMAND_FLASH: { + int i; + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "flash"); + goto error; + } + if (butPtr->state != STATE_DISABLED) { + for (i = 0; i < 4; i++) { + if (butPtr->state == STATE_NORMAL) { + butPtr->state = STATE_ACTIVE; + Tk_SetBackgroundFromBorder(butPtr->tkwin, + butPtr->activeBorder); + } else { + butPtr->state = STATE_NORMAL; + Tk_SetBackgroundFromBorder(butPtr->tkwin, + butPtr->normalBorder); + } + TkpDisplayButton((ClientData) butPtr); + + /* + * Special note: must cancel any existing idle handler + * for TkpDisplayButton; it's no longer needed, and + * TkpDisplayButton cleared the REDRAW_PENDING flag. + */ + + Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr); + XFlush(butPtr->display); + Tcl_Sleep(50); + } + } + break; } - if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; + + case COMMAND_INVOKE: { + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "invoke"); + goto error; + } + if (butPtr->state != STATE_DISABLED) { + result = TkInvokeButton(butPtr); + } + break; } - } else if ((c == 't') && (strncmp(argv[1], "toggle", length) == 0) - && (length >= 2) && (butPtr->type == TYPE_CHECK_BUTTON)) { - if (argc > 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s toggle\"", - argv[0]); - goto error; + + case COMMAND_SELECT: { + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "select"); + goto error; + } + if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL, + butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { + goto error; + } + break; } - if (butPtr->flags & SELECTED) { - if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; + + case COMMAND_TOGGLE: { + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "toggle"); + goto error; } - } else { - if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; + if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL, + (butPtr->flags & SELECTED) ? butPtr->offValuePtr + : butPtr->onValuePtr, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { + goto error; } + break; } - } else { - sprintf(interp->result, - "bad option \"%.50s\": must be %s", argv[1], - optionStrings[butPtr->type]); - goto error; } Tcl_Release((ClientData) butPtr); return result; @@ -592,15 +878,14 @@ ButtonWidgetCmd(clientData, interp, argc, argv) * * DestroyButton -- * - * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release - * to clean up the internal structure of a button at a safe time - * (when no-one is using it anymore). + * This procedure is invoked by ButtonEventProc to free all the + * resources of a button and clean up its state. * * Results: * None. * * Side effects: - * Everything associated with the widget is freed up. + * Everything associated with the widget is freed. * *---------------------------------------------------------------------- */ @@ -609,14 +894,22 @@ static void DestroyButton(butPtr) TkButton *butPtr; /* Info about button widget. */ { + TkpDestroyButton(butPtr); + + butPtr->flags |= BUTTON_DELETED; + if (butPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr); + } + /* * Free up all the stuff that requires special handling, then * let Tk_FreeOptions handle all the standard option-related * stuff. */ - if (butPtr->textVarName != NULL) { - Tcl_UntraceVar(butPtr->interp, butPtr->textVarName, + 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); } @@ -632,24 +925,27 @@ DestroyButton(butPtr) if (butPtr->activeTextGC != None) { Tk_FreeGC(butPtr->display, butPtr->activeTextGC); } - if (butPtr->gray != None) { - Tk_FreeBitmap(butPtr->display, butPtr->gray); - } if (butPtr->disabledGC != None) { Tk_FreeGC(butPtr->display, butPtr->disabledGC); } + if (butPtr->gray != None) { + Tk_FreeBitmap(butPtr->display, butPtr->gray); + } if (butPtr->copyGC != None) { Tk_FreeGC(butPtr->display, butPtr->copyGC); } - if (butPtr->selVarName != NULL) { - Tcl_UntraceVar(butPtr->interp, butPtr->selVarName, + if (butPtr->textLayout != NULL) { + 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); } - Tk_FreeTextLayout(butPtr->textLayout); - Tk_FreeOptions(tkpButtonConfigSpecs, (char *) butPtr, butPtr->display, - configFlags[butPtr->type]); - Tcl_EventuallyFree((ClientData)butPtr, TCL_DYNAMIC); + Tk_FreeConfigOptions((char *) butPtr, butPtr->optionTable, + butPtr->tkwin); + butPtr->tkwin = NULL; + Tcl_EventuallyFree((ClientData) butPtr, TCL_DYNAMIC); } /* @@ -657,13 +953,12 @@ DestroyButton(butPtr) * * ConfigureButton -- * - * This procedure is called to process an argv/argc list, plus - * the Tk option database, in order to configure (or - * reconfigure) a button widget. + * This procedure is called to process an objc/objv list to set + * configuration options for a button widget. * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then an error message is left in interp's result. * * Side effects: * Configuration information, such as text string, colors, font, @@ -674,199 +969,244 @@ DestroyButton(butPtr) */ static int -ConfigureButton(interp, butPtr, argc, argv, flags) +ConfigureButton(interp, butPtr, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ register TkButton *butPtr; /* Information about widget; may or may * not already have values for some fields. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ - int flags; /* Flags to pass to Tk_ConfigureWidget. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { + Tk_SavedOptions savedOptions; + Tcl_Obj *errorResult = NULL; + int error; Tk_Image image; /* * Eliminate any existing trace on variables monitored by the button. */ - if (butPtr->textVarName != NULL) { - Tcl_UntraceVar(interp, butPtr->textVarName, + if (butPtr->textVarNamePtr != NULL) { + Tcl_UntraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonTextVarProc, (ClientData) butPtr); } - if (butPtr->selVarName != NULL) { - Tcl_UntraceVar(interp, butPtr->selVarName, + if (butPtr->selVarNamePtr != NULL) { + Tcl_UntraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonVarProc, (ClientData) butPtr); } - - - if (Tk_ConfigureWidget(interp, butPtr->tkwin, tkpButtonConfigSpecs, - argc, argv, (char *) butPtr, flags) != TCL_OK) { - return TCL_ERROR; - } - /* - * A few options need special processing, such as setting the - * background from a 3-D border, or filling in complicated - * defaults that couldn't be specified to Tk_ConfigureWidget. + * The following loop is potentially executed twice. During the + * first pass configuration options get set to their new values. + * If there is an error in this pass, we execute a second pass + * to restore all the options to their previous values. */ - if ((butPtr->state == tkActiveUid) && !Tk_StrictMotif(butPtr->tkwin)) { - Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder); - } else { - Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder); - if ((butPtr->state != tkNormalUid) && (butPtr->state != tkActiveUid) - && (butPtr->state != tkDisabledUid)) { - Tcl_AppendResult(interp, "bad state value \"", butPtr->state, - "\": must be normal, active, or disabled", (char *) NULL); - butPtr->state = tkNormalUid; - return TCL_ERROR; - } - } + for (error = 0; error <= 1; error++) { + if (!error) { + /* + * First pass: set options to new values. + */ - if ((butPtr->defaultState != tkActiveUid) - && (butPtr->defaultState != tkDisabledUid) - && (butPtr->defaultState != tkNormalUid)) { - Tcl_AppendResult(interp, "bad -default value \"", butPtr->defaultState, - "\": must be normal, active, or disabled", (char *) NULL); - butPtr->defaultState = tkDisabledUid; - return TCL_ERROR; - } + if (Tk_SetOptions(interp, (char *) butPtr, + butPtr->optionTable, objc, objv, + butPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { + continue; + } + } else { + /* + * Second pass: restore options to old values. + */ - if (butPtr->highlightWidth < 0) { - butPtr->highlightWidth = 0; - } + errorResult = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(errorResult); + Tk_RestoreSavedOptions(&savedOptions); + } - if (butPtr->padX < 0) { - butPtr->padX = 0; - } - if (butPtr->padY < 0) { - butPtr->padY = 0; - } + /* + * A few options need special processing, such as setting the + * background from a 3-D border, or filling in complicated + * defaults that couldn't be specified to Tk_SetOptions. + */ - if (butPtr->type >= TYPE_CHECK_BUTTON) { - char *value; + if ((butPtr->state == STATE_ACTIVE) + && !Tk_StrictMotif(butPtr->tkwin)) { + Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder); + } else { + Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder); + } + if (butPtr->borderWidth < 0) { + butPtr->borderWidth = 0; + } + if (butPtr->highlightWidth < 0) { + butPtr->highlightWidth = 0; + } + if (butPtr->padX < 0) { + butPtr->padX = 0; + } + if (butPtr->padY < 0) { + butPtr->padY = 0; + } - if (butPtr->selVarName == NULL) { - butPtr->selVarName = (char *) ckalloc((unsigned) - (strlen(Tk_Name(butPtr->tkwin)) + 1)); - strcpy(butPtr->selVarName, Tk_Name(butPtr->tkwin)); + if (butPtr->type >= TYPE_CHECK_BUTTON) { + Tcl_Obj *valuePtr, *namePtr; + + if (butPtr->selVarNamePtr == NULL) { + butPtr->selVarNamePtr = Tcl_NewStringObj( + Tk_Name(butPtr->tkwin), -1); + Tcl_IncrRefCount(butPtr->selVarNamePtr); + } + namePtr = butPtr->selVarNamePtr; + + /* + * Select the button if the associated variable has the + * appropriate value, initialize the variable if it doesn't + * exist, then set a trace on the variable to monitor future + * changes to its value. + */ + + valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY); + butPtr->flags &= ~SELECTED; + if (valuePtr != NULL) { + if (strcmp(Tcl_GetString(valuePtr), + Tcl_GetString(butPtr->onValuePtr)) == 0) { + butPtr->flags |= SELECTED; + } + } else { + if (Tcl_ObjSetVar2(interp, namePtr, NULL, + (butPtr->type == TYPE_CHECK_BUTTON) + ? butPtr->offValuePtr : Tcl_NewObj(), + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { + continue; + } + } } /* - * Select the button if the associated variable has the - * appropriate value, initialize the variable if it doesn't - * exist, then set a trace on the variable to monitor future - * changes to its value. + * Get the images for the widget, if there are any. Allocate the + * new images before freeing the old ones, so that the reference + * counts don't go to zero and cause image data to be discarded. */ - - value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY); - butPtr->flags &= ~SELECTED; - if (value != NULL) { - if (strcmp(value, butPtr->onValue) == 0) { - butPtr->flags |= SELECTED; + + if (butPtr->imagePtr != NULL) { + image = Tk_GetImage(butPtr->interp, butPtr->tkwin, + Tcl_GetString(butPtr->imagePtr), ButtonImageProc, + (ClientData) butPtr); + if (image == NULL) { + continue; } } else { - if (Tcl_SetVar(interp, butPtr->selVarName, - (butPtr->type == TYPE_CHECK_BUTTON) ? butPtr->offValue : "", - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - return TCL_ERROR; + image = NULL; + } + if (butPtr->image != NULL) { + Tk_FreeImage(butPtr->image); + } + butPtr->image = image; + if (butPtr->selectImagePtr != NULL) { + image = Tk_GetImage(butPtr->interp, butPtr->tkwin, + Tcl_GetString(butPtr->selectImagePtr), + ButtonSelectImageProc, (ClientData) butPtr); + if (image == NULL) { + continue; } + } else { + image = NULL; } - Tcl_TraceVar(interp, butPtr->selVarName, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ButtonVarProc, (ClientData) butPtr); - } - - /* - * Get the images for the widget, if there are any. Allocate the - * new images before freeing the old ones, so that the reference - * counts don't go to zero and cause image data to be discarded. - */ - - if (butPtr->imageString != NULL) { - image = Tk_GetImage(butPtr->interp, butPtr->tkwin, - butPtr->imageString, ButtonImageProc, (ClientData) butPtr); - if (image == NULL) { - return TCL_ERROR; + if (butPtr->selectImage != NULL) { + Tk_FreeImage(butPtr->selectImage); } - } else { - image = NULL; - } - if (butPtr->image != NULL) { - Tk_FreeImage(butPtr->image); - } - butPtr->image = image; - if (butPtr->selectImageString != NULL) { - image = Tk_GetImage(butPtr->interp, butPtr->tkwin, - butPtr->selectImageString, ButtonSelectImageProc, - (ClientData) butPtr); - if (image == NULL) { - return TCL_ERROR; + butPtr->selectImage = image; + + if ((butPtr->imagePtr == NULL) && (butPtr->bitmap == None) + && (butPtr->textVarNamePtr != NULL)) { + /* + * The button must display the value of a variable: set up a trace + * on the variable's value, create the variable if it doesn't + * exist, and fetch its current value. + */ + + Tcl_Obj *valuePtr, *namePtr; + + namePtr = butPtr->textVarNamePtr; + valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY); + if (valuePtr == NULL) { + if (Tcl_ObjSetVar2(interp, namePtr, NULL, butPtr->textPtr, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { + continue; + } + } else { + if (butPtr->textPtr != NULL) { + Tcl_DecrRefCount(butPtr->textPtr); + } + butPtr->textPtr = valuePtr; + Tcl_IncrRefCount(butPtr->textPtr); + } } - } else { - image = NULL; - } - if (butPtr->selectImage != NULL) { - Tk_FreeImage(butPtr->selectImage); - } - butPtr->selectImage = image; - - if ((butPtr->image == NULL) && (butPtr->bitmap == None) - && (butPtr->textVarName != NULL)) { - /* - * The button must display the value of a variable: set up a trace - * on the variable's value, create the variable if it doesn't - * exist, and fetch its current value. - */ - - char *value; - - value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY); - if (value == NULL) { - if (Tcl_SetVar(interp, butPtr->textVarName, butPtr->text, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - return TCL_ERROR; + + if ((butPtr->bitmap != None) || (butPtr->imagePtr != NULL)) { + /* + * The button must display the contents of an image or + * bitmap. + */ + + if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->widthPtr, + &butPtr->width) != TCL_OK) { + widthError: + Tcl_AddErrorInfo(interp, "\n (processing -width option)"); + continue; + } + if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->heightPtr, + &butPtr->height) != TCL_OK) { + heightError: + Tcl_AddErrorInfo(interp, "\n (processing -height option)"); + continue; } } else { - if (butPtr->text != NULL) { - ckfree(butPtr->text); + /* + * The button displays an ordinary text string. + */ + + if (Tcl_GetIntFromObj(interp, butPtr->widthPtr, &butPtr->width) + != TCL_OK) { + goto widthError; + } + if (Tcl_GetIntFromObj(interp, butPtr->heightPtr, &butPtr->height) + != TCL_OK) { + goto heightError; } - butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); - strcpy(butPtr->text, value); } - Tcl_TraceVar(interp, butPtr->textVarName, + break; + } + if (!error) { + Tk_FreeSavedOptions(&savedOptions); + } + + /* + * Reestablish the variable traces, if they're needed. + */ + + if (butPtr->textVarNamePtr != NULL) { + Tcl_TraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonTextVarProc, (ClientData) butPtr); } - - if ((butPtr->bitmap != None) || (butPtr->image != NULL)) { - if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->widthString, - &butPtr->width) != TCL_OK) { - widthError: - Tcl_AddErrorInfo(interp, "\n (processing -width option)"); - return TCL_ERROR; - } - if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->heightString, - &butPtr->height) != TCL_OK) { - heightError: - Tcl_AddErrorInfo(interp, "\n (processing -height option)"); - return TCL_ERROR; - } - } else { - if (Tcl_GetInt(interp, butPtr->widthString, &butPtr->width) - != TCL_OK) { - goto widthError; - } - if (Tcl_GetInt(interp, butPtr->heightString, &butPtr->height) - != TCL_OK) { - goto heightError; - } + if (butPtr->selVarNamePtr != NULL) { + Tcl_TraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, (ClientData) butPtr); } TkButtonWorldChanged((ClientData) butPtr); - return TCL_OK; + if (error) { + Tcl_SetObjResult(interp, errorResult); + Tcl_DecrRefCount(errorResult); + return TCL_ERROR; + } else { + return TCL_OK; + } } /* @@ -921,7 +1261,6 @@ TkButtonWorldChanged(instanceData) butPtr->normalTextGC = newGC; if (butPtr->activeFg != NULL) { - gcValues.font = Tk_FontId(butPtr->tkfont); gcValues.foreground = butPtr->activeFg->pixel; gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel; mask = GCForeground | GCBackground | GCFont; @@ -933,17 +1272,15 @@ TkButtonWorldChanged(instanceData) } if (butPtr->type != TYPE_LABEL) { - gcValues.font = Tk_FontId(butPtr->tkfont); gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel; - if ((butPtr->disabledFg != NULL) && (butPtr->imageString == NULL)) { + if ((butPtr->disabledFg != NULL) && (butPtr->imagePtr == NULL)) { gcValues.foreground = butPtr->disabledFg->pixel; mask = GCForeground | GCBackground | GCFont; } else { gcValues.foreground = gcValues.background; mask = GCForeground; if (butPtr->gray == None) { - butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, - Tk_GetUid("gray50")); + butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, "gray50"); } if (butPtr->gray != None) { gcValues.fill_style = FillStippled; @@ -1008,14 +1345,6 @@ ButtonEventProc(clientData, eventPtr) goto redraw; } else if (eventPtr->type == DestroyNotify) { - TkpDestroyButton(butPtr); - if (butPtr->tkwin != NULL) { - butPtr->tkwin = NULL; - Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd); - } - if (butPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr); - } DestroyButton(butPtr); } else if (eventPtr->type == FocusIn) { if (eventPtr->xfocus.detail != NotifyInferior) { @@ -1064,18 +1393,16 @@ ButtonCmdDeletedProc(clientData) ClientData clientData; /* Pointer to widget record for widget. */ { TkButton *butPtr = (TkButton *) clientData; - Tk_Window tkwin = butPtr->tkwin; /* * This procedure could be invoked either because the window was - * destroyed and the command was then deleted (in which case tkwin - * is NULL) or because the command was deleted, and then this procedure - * destroys the widget. + * destroyed and the command was then deleted or because the command + * was deleted, and then this procedure destroys the widget. The + * BUTTON_DELETED flag distinguishes these cases. */ - if (tkwin != NULL) { - butPtr->tkwin = NULL; - Tk_DestroyWindow(tkwin); + if (!(butPtr->flags & BUTTON_DELETED)) { + Tk_DestroyWindow(butPtr->tkwin); } } @@ -1091,7 +1418,7 @@ ButtonCmdDeletedProc(clientData) * * Results: * A standard Tcl return value. Information is also left in - * interp->result. + * the interp's result. * * Side effects: * Depends on the button and its associated command. @@ -1101,28 +1428,34 @@ ButtonCmdDeletedProc(clientData) int TkInvokeButton(butPtr) - register TkButton *butPtr; /* Information about button. */ + TkButton *butPtr; /* Information about button. */ { + Tcl_Obj *namePtr = butPtr->selVarNamePtr; + if (butPtr->type == TYPE_CHECK_BUTTON) { if (butPtr->flags & SELECTED) { - if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->offValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL, + butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { return TCL_ERROR; } } else { - if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL, + butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { return TCL_ERROR; } } } else if (butPtr->type == TYPE_RADIO_BUTTON) { - if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL, butPtr->onValuePtr, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) + == NULL) { return TCL_ERROR; } } - if ((butPtr->type != TYPE_LABEL) && (butPtr->command != NULL)) { - return TkCopyAndGlobalEval(butPtr->interp, butPtr->command); + if ((butPtr->type != TYPE_LABEL) && (butPtr->commandPtr != NULL)) { + return Tcl_EvalObjEx(butPtr->interp, butPtr->commandPtr, + TCL_EVAL_GLOBAL); } return TCL_OK; } @@ -1156,7 +1489,10 @@ ButtonVarProc(clientData, interp, name1, name2, flags) int flags; /* Information about what happened. */ { register TkButton *butPtr = (TkButton *) clientData; - char *value; + char *name, *value; + Tcl_Obj *valuePtr; + + name = Tcl_GetString(butPtr->selVarNamePtr); /* * If the variable is being unset, then just re-establish the @@ -1166,7 +1502,7 @@ ButtonVarProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_UNSETS) { butPtr->flags &= ~SELECTED; if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_TraceVar(interp, butPtr->selVarName, + Tcl_TraceVar(interp, name, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonVarProc, clientData); } @@ -1178,11 +1514,13 @@ ButtonVarProc(clientData, interp, name1, name2, flags) * the button. */ - value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY); - if (value == NULL) { + valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY); + if (valuePtr == NULL) { value = ""; + } else { + value = Tcl_GetString(valuePtr); } - if (strcmp(value, butPtr->onValue) == 0) { + if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) { if (butPtr->flags & SELECTED) { return (char *) NULL; } @@ -1229,8 +1567,11 @@ ButtonTextVarProc(clientData, interp, name1, name2, flags) char *name2; /* Not used. */ int flags; /* Information about what happened. */ { - register TkButton *butPtr = (TkButton *) clientData; - char *value; + TkButton *butPtr = (TkButton *) clientData; + char *name; + Tcl_Obj *valuePtr; + + name = Tcl_GetString(butPtr->textVarNamePtr); /* * If the variable is unset, then immediately recreate it unless @@ -1239,24 +1580,22 @@ ButtonTextVarProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_SetVar(interp, butPtr->textVarName, butPtr->text, + Tcl_SetVar2Ex(interp, name, NULL, butPtr->textPtr, TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, butPtr->textVarName, + Tcl_TraceVar(interp, name, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonTextVarProc, clientData); } return (char *) NULL; } - value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY); - if (value == NULL) { - value = ""; - } - if (butPtr->text != NULL) { - ckfree(butPtr->text); + valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY); + if (valuePtr == NULL) { + valuePtr = Tcl_NewObj(); } - butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); - strcpy(butPtr->text, value); + Tcl_DecrRefCount(butPtr->textPtr); + butPtr->textPtr = valuePtr; + Tcl_IncrRefCount(butPtr->textPtr); TkpComputeButtonGeometry(butPtr); if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin) @@ -1273,7 +1612,7 @@ ButtonTextVarProc(clientData, interp, name1, name2, flags) * ButtonImageProc -- * * This procedure is invoked by the image code whenever the manager - * for an image does something that affects the size of contents + * for an image does something that affects the size or contents * of an image displayed in a button. * * Results: @@ -1311,7 +1650,7 @@ ButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight) * ButtonSelectImageProc -- * * This procedure is invoked by the image code whenever the manager - * for an image does something that affects the size of contents + * for an image does something that affects the size or contents * of the image displayed in a button when it is selected. * * Results: diff --git a/generic/tkButton.h b/generic/tkButton.h index a873dbe..ae24bae 100644 --- a/generic/tkButton.h +++ b/generic/tkButton.h @@ -4,12 +4,12 @@ * Declarations of types and functions used to implement * button-like widgets. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996-1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkButton.h,v 1.4 1998/09/14 18:23:04 stanton Exp $ + * RCS: @(#) $Id: tkButton.h,v 1.5 1999/04/16 01:51:11 stanton Exp $ */ #ifndef _TKBUTTON @@ -25,6 +25,22 @@ #endif /* + * Legal values for the "state" field of TkButton records. + */ + +enum state { + STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL +}; + +/* + * Legal values for the "defaultState" field of TkButton records. + */ + +enum defaultState { + DEFAULT_ACTIVE, DEFAULT_DISABLED, DEFAULT_NORMAL +}; + +/* * A data structure of the following type is kept for each * widget managed by this file: */ @@ -36,69 +52,88 @@ typedef struct { * free up resources after tkwin is gone. */ Tcl_Interp *interp; /* Interpreter associated with button. */ Tcl_Command widgetCmd; /* Token for button's widget command. */ - int type; /* Type of widget: restricts operations - * that may be performed on widget. See - * below for possible values. */ + int type; /* Type of widget, such as TYPE_LABEL: + * restricts operations that may be performed + * on widget. See below for legal values. */ + Tk_OptionTable optionTable; /* Table that defines configuration options + * available for this widget. */ /* * Information about what's in the button. */ - char *text; /* Text to display in button (malloc'ed) - * or NULL. */ - int underline; /* Index of character to underline. < 0 means + Tcl_Obj *textPtr; /* Value of -text option: specifies text to + * display in button. */ + int underline; /* Value of -underline option: specifies + * index of character to underline. < 0 means * don't underline anything. */ - char *textVarName; /* Name of variable (malloc'ed) or NULL. - * If non-NULL, button displays the contents - * of this variable. */ - Pixmap bitmap; /* Bitmap to display or None. If not None - * then text and textVar are ignored. */ - char *imageString; /* Name of image to display (malloc'ed), or - * NULL. If non-NULL, bitmap, text, and - * textVarName are ignored. */ - Tk_Image image; /* Image to display in window, or NULL if - * none. */ - char *selectImageString; /* Name of image to display when selected - * (malloc'ed), or NULL. */ - Tk_Image selectImage; /* Image to display in window when selected, - * or NULL if none. Ignored if image is + Tcl_Obj *textVarNamePtr; /* Value of -textvariable option: specifies + * name of variable or NULL. If non-NULL, + * button displays the contents of this + * variable. */ + Pixmap bitmap; /* Value of -bitmap option. If not None, + * specifies bitmap to display and text and + * textVar are ignored. */ + Tcl_Obj *imagePtr; /* Value of -image option: specifies image + * to display in window, or NULL if none. + * If non-NULL, bitmap, text, and textVarName + * are ignored.*/ + Tk_Image image; /* Derived from imagePtr by calling + * Tk_GetImage, or NULL if imagePtr is NULL. */ + Tcl_Obj *selectImagePtr; /* Value of -selectimage option: specifies + * image to display in window when selected, + * or NULL if none. Ignored if imagePtr is * NULL. */ + Tk_Image selectImage; /* Derived from selectImagePtr by calling + * Tk_GetImage, or NULL if selectImagePtr + * is NULL. */ /* * Information used when displaying widget: */ - Tk_Uid state; /* State of button for display purposes: - * normal, active, or disabled. */ - Tk_3DBorder normalBorder; /* Structure used to draw 3-D - * border and background when window - * isn't active. NULL means no such - * border exists. */ - Tk_3DBorder activeBorder; /* Structure used to draw 3-D - * border and background when window - * is active. NULL means no such - * border exists. */ - int borderWidth; /* Width of border. */ - int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */ - int highlightWidth; /* Width in pixels of highlight to draw - * around widget when it has the focus. + enum state state; /* Value of -state option: specifies + * state of button for display purposes.*/ + Tk_3DBorder normalBorder; /* Value of -background option: specifies + * color for background (and border) when + * window isn't active. */ + Tk_3DBorder activeBorder; /* Value of -activebackground option: + * this is the color used to draw 3-D border + * and background when widget is active. */ + Tcl_Obj *borderWidthPtr; /* Value of -borderWidth option: specifies + * width of border in pixels. */ + int borderWidth; /* Integer value corresponding to + * borderWidthPtr. Always >= 0. */ + int relief; /* Value of -relief option: specifies 3-d + * effect for border, such as + * TK_RELIEF_RAISED. */ + Tcl_Obj *highlightWidthPtr; /* Value of -highlightthickness option: + * specifies width in pixels of highlight to + * draw around widget when it has the focus. * <= 0 means don't draw a highlight. */ - Tk_3DBorder highlightBorder; - /* Structure used to draw 3-D default ring - * and focus highlight area when highlight - * is off. */ - XColor *highlightColorPtr; /* Color for drawing traversal highlight. */ - + int highlightWidth; /* Integer value corresponding to + * highlightWidthPtr. Always >= 0. */ + Tk_3DBorder highlightBorder;/* Value of -highlightbackground option: + * specifies background with which to draw 3-D + * default ring and focus highlight area when + * highlight is off. */ + XColor *highlightColorPtr; /* Value of -highlightcolor option: + * specifies color for drawing traversal + * highlight. */ int inset; /* Total width of all borders, including * traversal highlight and 3-D border. * Indicates how much interior stuff must * be offset from outside edges to leave * room for borders. */ - Tk_Font tkfont; /* Information about text font, or NULL. */ - XColor *normalFg; /* Foreground color in normal mode. */ - XColor *activeFg; /* Foreground color in active mode. NULL - * means use normalFg instead. */ - XColor *disabledFg; /* Foreground color when disabled. NULL + Tk_Font tkfont; /* Value of -font option: specifies font + * to use for display text. */ + XColor *normalFg; /* Value of -font option: specifies foreground + * color in normal mode. */ + XColor *activeFg; /* Value of -activeforeground option: + * foreground color in active mode. NULL + * means use -foreground instead. */ + XColor *disabledFg; /* Value of -disabledforeground option: + * foreground color when disabled. NULL * means use normalFg with a 50% stipple * instead. */ GC normalTextGC; /* GC for drawing text in normal mode. Also @@ -106,36 +141,47 @@ typedef struct { * screen. */ GC activeTextGC; /* GC for drawing text in active mode (NULL * means use normalTextGC). */ - Pixmap gray; /* Pixmap for displaying disabled text if - * disabledFg is NULL. */ GC disabledGC; /* Used to produce disabled effect. If * disabledFg isn't NULL, this GC is used to * draw button text or icon. Otherwise * text or icon is drawn with normalGC and * this GC is used to stipple background * across it. For labels this is None. */ + Pixmap gray; /* Pixmap for displaying disabled text if + * disabledFg is NULL. */ GC copyGC; /* Used for copying information from an * off-screen pixmap to the screen. */ - char *widthString; /* Value of -width option. Malloc'ed. */ - char *heightString; /* Value of -height option. Malloc'ed. */ - int width, height; /* If > 0, these specify dimensions to request - * for window, in characters for text and in - * pixels for bitmaps. In this case the actual - * size of the text string or bitmap is - * ignored in computing desired window size. */ - int wrapLength; /* Line length (in pixels) at which to wrap + Tcl_Obj *widthPtr; /* Value of -width option. */ + int width; /* Integer value corresponding to widthPtr. */ + Tcl_Obj *heightPtr; /* Value of -height option. */ + int height; /* Integer value corresponding to heightPtr. */ + Tcl_Obj *wrapLengthPtr; /* Value of -wraplength option: specifies + * line length (in pixels) at which to wrap * onto next line. <= 0 means don't wrap * except at newlines. */ - int padX, padY; /* Extra space around text (pixels to leave - * on each side). Ignored for bitmaps and + int wrapLength; /* Integer value corresponding to + * wrapLengthPtr. */ + Tcl_Obj *padXPtr; /* Value of -padx option: specifies how many + * pixels of extra space to leave on left and + * right of text. Ignored for bitmaps and * images. */ - Tk_Anchor anchor; /* Where text/bitmap should be displayed - * inside button region. */ - Tk_Justify justify; /* Justification to use for multi-line text. */ - int indicatorOn; /* True means draw indicator, false means - * don't draw it. */ - Tk_3DBorder selectBorder; /* For drawing indicator background, or perhaps - * widget background, when selected. */ + int padX; /* Integer value corresponding to padXPtr. */ + Tcl_Obj *padYPtr; /* Value of -padx option: specifies how many + * pixels of extra space to leave above and + * below text. Ignored for bitmaps and + * images. */ + int padY; /* Integer value corresponding to padYPtr. */ + Tk_Anchor anchor; /* Value of -anchor option: specifies where + * text/bitmap should be displayed inside + * button region. */ + Tk_Justify justify; /* Value of -justify option: specifies how + * to align lines of multi-line text. */ + int indicatorOn; /* Value of -indicatoron option: 1 means + * draw indicator in checkbuttons and + * radiobuttons, 0 means don't draw it. */ + Tk_3DBorder selectBorder; /* Value of -selectcolor option: specifies + * color for drawing indicator background, or + * perhaps widget background, when selected. */ int textWidth; /* Width needed to display text as requested, * in pixels. */ int textHeight; /* Height needed to display text as requested, @@ -144,36 +190,42 @@ typedef struct { int indicatorSpace; /* Horizontal space (in pixels) allocated for * display of indicator. */ int indicatorDiameter; /* Diameter of indicator, in pixels. */ - Tk_Uid defaultState; /* State of default ring: normal, active, or - * disabled. */ - + enum defaultState defaultState; + /* Value of -default option, such as + * DEFAULT_NORMAL: specifies state + * of default ring for buttons (normal, + * active, or disabled). NULL for other + * classes. */ + /* * For check and radio buttons, the fields below are used * to manage the variable indicating the button's state. */ - char *selVarName; /* Name of variable used to control selected - * state of button. Malloc'ed (if - * not NULL). */ - char *onValue; /* Value to store in variable when - * this button is selected. Malloc'ed (if - * not NULL). */ - char *offValue; /* Value to store in variable when this - * button isn't selected. Malloc'ed - * (if not NULL). Valid only for check - * buttons. */ + Tcl_Obj *selVarNamePtr; /* Value of -variable option: specifies name + * of variable used to control selected + * state of button. */ + Tcl_Obj *onValuePtr; /* Value of -offvalue option: specifies value + * to store in variable when this button is + * selected. */ + Tcl_Obj *offValuePtr; /* Value of -offvalue option: specifies value + * to store in variable when this button + * isn't selected. Used only by + * checkbuttons. */ /* * Miscellaneous information: */ - Tk_Cursor cursor; /* Current cursor for window, or None. */ - char *takeFocus; /* Value of -takefocus option; not used in + Tk_Cursor cursor; /* Value of -cursor option: if not None, + * specifies current cursor for window. */ + Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in * the C code, but used by keyboard traversal - * scripts. Malloc'ed, but may be NULL. */ - char *command; /* Command to execute when button is - * invoked; valid for buttons only. - * If not NULL, it's malloc-ed. */ + * scripts. */ + Tcl_Obj *commandPtr; /* Value of -command option: specifies script + * to execute when button is invoked. If + * widget is label or has no command, this + * is NULL. */ int flags; /* Various flags; see below for * definitions. */ } TkButton; @@ -200,36 +252,31 @@ typedef struct { * so special highlight should be drawn. * GOT_FOCUS: Non-zero means this button currently * has the input focus. + * BUTTON_DELETED: Non-zero needs that this button has been + * deleted, or is in the process of being + * deleted. */ #define REDRAW_PENDING 1 #define SELECTED 2 #define GOT_FOCUS 4 - -/* - * Mask values used to selectively enable entries in the - * configuration specs: - */ - -#define LABEL_MASK TK_CONFIG_USER_BIT -#define BUTTON_MASK TK_CONFIG_USER_BIT << 1 -#define CHECK_BUTTON_MASK TK_CONFIG_USER_BIT << 2 -#define RADIO_BUTTON_MASK TK_CONFIG_USER_BIT << 3 -#define ALL_MASK (LABEL_MASK | BUTTON_MASK \ - | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK) +#define BUTTON_DELETED 0x8 /* * Declaration of variables shared between the files in the button module. */ extern TkClassProcs tkpButtonProcs; -extern Tk_ConfigSpec tkpButtonConfigSpecs[]; /* * Declaration of procedures used in the implementation of the button * widget. */ +#ifndef TkpButtonSetDefaults +EXTERN void TkpButtonSetDefaults _ANSI_ARGS_(( + Tk_OptionSpec *specPtr)); +#endif EXTERN void TkButtonWorldChanged _ANSI_ARGS_(( ClientData instanceData)); EXTERN void TkpComputeButtonGeometry _ANSI_ARGS_(( diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index ab48720..1b9e4e9 100644 --- a/generic/tkCanvArc.c +++ b/generic/tkCanvArc.c @@ -4,12 +4,12 @@ * This file implements arc items for canvas widgets. * * Copyright (c) 1992-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvArc.c,v 1.3 1998/09/14 18:23:04 stanton Exp $ + * RCS: @(#) $Id: tkCanvArc.c,v 1.4 1999/04/16 01:51:11 stanton Exp $ */ #include <stdio.h> @@ -168,14 +168,6 @@ Tk_ItemType tkArcType = { # define PI 3.14159265358979323846 #endif -/* - * The uid's below comprise the legal values for the "-style" - * option for arcs. - */ - -static Tk_Uid arcUid = NULL; -static Tk_Uid chordUid = NULL; -static Tk_Uid pieSliceUid = NULL; /* *-------------------------------------------------------------- @@ -188,7 +180,7 @@ static Tk_Uid pieSliceUid = NULL; * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in - * interp->result; in this case itemPtr is + * the interp's result; in this case itemPtr is * left uninitialized, so it can be safely freed by the * caller. * @@ -218,16 +210,6 @@ CreateArc(interp, canvas, itemPtr, argc, argv) } /* - * Carry out once-only initialization. - */ - - if (arcUid == NULL) { - arcUid = Tk_GetUid("arc"); - chordUid = Tk_GetUid("chord"); - pieSliceUid = Tk_GetUid("pieslice"); - } - - /* * Carry out initialization that is needed in order to clean * up after errors during the the remainder of this procedure. */ @@ -241,7 +223,7 @@ CreateArc(interp, canvas, itemPtr, argc, argv) arcPtr->fillColor = NULL; arcPtr->fillStipple = None; arcPtr->outlineStipple = None; - arcPtr->style = pieSliceUid; + arcPtr->style = Tk_GetUid("pieslice"); arcPtr->outlineGC = None; arcPtr->fillGC = None; @@ -276,7 +258,7 @@ CreateArc(interp, canvas, itemPtr, argc, argv) * on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -319,9 +301,10 @@ ArcCoords(interp, canvas, itemPtr, argc, argv) } ComputeArcBbox(canvas, arcPtr); } else { - sprintf(interp->result, - "wrong # coordinates: expected 0 or 4, got %d", - argc); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; @@ -337,7 +320,7 @@ ArcCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information, such as colors and stipple @@ -381,12 +364,13 @@ ConfigureArc(interp, canvas, itemPtr, argc, argv, flags) i = (int) (arcPtr->extent/360.0); arcPtr->extent -= i*360.0; - if ((arcPtr->style != arcUid) && (arcPtr->style != chordUid) - && (arcPtr->style != pieSliceUid)) { + if ((arcPtr->style != Tk_GetUid("arc")) + && (arcPtr->style != Tk_GetUid("chord")) + && (arcPtr->style != Tk_GetUid("pieslice"))) { Tcl_AppendResult(interp, "bad -style option \"", arcPtr->style, "\": must be arc, chord, or pieslice", (char *) NULL); - arcPtr->style = pieSliceUid; + arcPtr->style = Tk_GetUid("pieslice"); return TCL_ERROR; } @@ -412,11 +396,11 @@ ConfigureArc(interp, canvas, itemPtr, argc, argv, flags) } arcPtr->outlineGC = newGC; - if ((arcPtr->fillColor == NULL) || (arcPtr->style == arcUid)) { + if ((arcPtr->fillColor == NULL) || (arcPtr->style == Tk_GetUid("arc"))) { newGC = None; } else { gcValues.foreground = arcPtr->fillColor->pixel; - if (arcPtr->style == chordUid) { + if (arcPtr->style == Tk_GetUid("chord")) { gcValues.arc_mode = ArcChord; } else { gcValues.arc_mode = ArcPieSlice; @@ -545,7 +529,7 @@ ComputeArcBbox(canvas, arcPtr) TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2); center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2; center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2; - if (arcPtr->style == pieSliceUid) { + if (arcPtr->style == Tk_GetUid("pieslice")) { TkIncludePoint((Tk_Item *) arcPtr, center); } @@ -689,10 +673,10 @@ DisplayArc(canvas, itemPtr, display, drawable, x, y, width, height) Tk_CanvasDrawableCoords(canvas, arcPtr->center2[0], arcPtr->center2[1], &x2, &y2); - if (arcPtr->style == chordUid) { + if (arcPtr->style == Tk_GetUid("chord")) { XDrawLine(display, drawable, arcPtr->outlineGC, x1, y1, x2, y2); - } else if (arcPtr->style == pieSliceUid) { + } else if (arcPtr->style == Tk_GetUid("pieslice")) { short cx, cy; Tk_CanvasDrawableCoords(canvas, @@ -704,10 +688,10 @@ DisplayArc(canvas, itemPtr, display, drawable, x, y, width, height) cx, cy, x2, y2); } } else { - if (arcPtr->style == chordUid) { + if (arcPtr->style == Tk_GetUid("chord")) { TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS, display, drawable, arcPtr->outlineGC, None); - } else if (arcPtr->style == pieSliceUid) { + } else if (arcPtr->style == Tk_GetUid("pieslice")) { TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS, display, drawable, arcPtr->outlineGC, None); TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, @@ -785,7 +769,7 @@ ArcToPoint(canvas, itemPtr, pointPtr) * we're dealing with. */ - if (arcPtr->style == arcUid) { + if (arcPtr->style == Tk_GetUid("arc")) { if (angleInRange) { return TkOvalToPoint(arcPtr->bbox, (double) arcPtr->width, 0, pointPtr); @@ -811,7 +795,7 @@ ArcToPoint(canvas, itemPtr, pointPtr) width = arcPtr->width; } - if (arcPtr->style == pieSliceUid) { + if (arcPtr->style == Tk_GetUid("pieslice")) { if (width > 1.0) { dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS, pointPtr); @@ -966,7 +950,7 @@ ArcToArea(canvas, itemPtr, rectPtr) numPoints = 2; pointPtr += 4; - if ((arcPtr->style == pieSliceUid) && (arcPtr->extent < 180.0)) { + if ((arcPtr->style == Tk_GetUid("pieslice")) && (arcPtr->extent < 180.0)) { pointPtr[0] = 0.0; pointPtr[1] = 0.0; numPoints++; @@ -1040,7 +1024,7 @@ ArcToArea(canvas, itemPtr, rectPtr) * polygon(s) forming the sides of a chord or pie-slice. */ - if (arcPtr->style == pieSliceUid) { + if (arcPtr->style == Tk_GetUid("pieslice")) { if (width >= 1.0) { if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS, rectPtr) != -1) { @@ -1056,7 +1040,7 @@ ArcToArea(canvas, itemPtr, rectPtr) return 0; } } - } else if (arcPtr->style == chordUid) { + } else if (arcPtr->style == Tk_GetUid("chord")) { if (width >= 1.0) { if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS, rectPtr) != -1) { @@ -1307,7 +1291,7 @@ ComputeArcOutline(arcPtr) * center point. The second point is the corner point. */ - if (arcPtr->style == chordUid) { + if (arcPtr->style == Tk_GetUid("chord")) { outlinePtr[0] = outlinePtr[12] = corner1[0]; outlinePtr[1] = outlinePtr[13] = corner1[1]; TkGetButtPoints(arcPtr->center2, arcPtr->center1, @@ -1322,7 +1306,7 @@ ComputeArcOutline(arcPtr) - arcPtr->center1[0]; outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11] - arcPtr->center1[1]; - } else if (arcPtr->style == pieSliceUid) { + } else if (arcPtr->style == Tk_GetUid("pieslice")) { /* * For pie slices, generate two polygons, one for each side * of the pie slice. The first arm has a shape like this, @@ -1574,7 +1558,7 @@ AngleInRange(x, y, start, extent) * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is - * left in interp->result, replacing whatever used + * left in the interp's result, replacing whatever used * to be there. If no error occurs, then Postscript for the * item is appended to the result. * @@ -1618,7 +1602,7 @@ ArcToPostscript(interp, canvas, itemPtr, prepass) (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); Tcl_AppendResult(interp, buffer, (char *) NULL); - if (arcPtr->style == chordUid) { + if (arcPtr->style == Tk_GetUid("chord")) { sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", ang1, ang2); } else { @@ -1670,9 +1654,9 @@ ArcToPostscript(interp, canvas, itemPtr, prepass) } else { Tcl_AppendResult(interp, "stroke\n", (char *) NULL); } - if (arcPtr->style != arcUid) { + if (arcPtr->style != Tk_GetUid("arc")) { Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL); - if (arcPtr->style == chordUid) { + if (arcPtr->style == Tk_GetUid("chord")) { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS); } else { diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index a09bf8d..dedc4e7 100644 --- a/generic/tkCanvBmap.c +++ b/generic/tkCanvBmap.c @@ -4,12 +4,12 @@ * This file implements bitmap items for canvas widgets. * * Copyright (c) 1992-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvBmap.c,v 1.2 1998/09/14 18:23:04 stanton Exp $ + * RCS: @(#) $Id: tkCanvBmap.c,v 1.3 1999/04/16 01:51:11 stanton Exp $ */ #include <stdio.h> @@ -129,7 +129,7 @@ Tk_ItemType tkBitmapType = { * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in - * interp->result; in this case itemPtr is left uninitialized, + * the interp's result; in this case itemPtr is left uninitialized, * so it can be safely freed by the caller. * * Side effects: @@ -194,7 +194,7 @@ CreateBitmap(interp, canvas, itemPtr, argc, argv) * details on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -228,8 +228,10 @@ BitmapCoords(interp, canvas, itemPtr, argc, argv) } ComputeBitmapBbox(canvas, bmapPtr); } else { - sprintf(interp->result, - "wrong # coordinates: expected 0 or 2, got %d", argc); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; @@ -245,7 +247,7 @@ BitmapCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information may be set for itemPtr. @@ -690,7 +692,7 @@ TranslateBitmap(canvas, itemPtr, deltaX, deltaY) * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is - * left in interp->result, replacing whatever used to be there. + * left in the interp's result, replacing whatever used to be there. * If no error occurs, then Postscript for the item is appended * to the result. * @@ -715,7 +717,7 @@ BitmapToPostscript(interp, canvas, itemPtr, prepass) double x, y; int width, height, rowsAtOnce, rowsThisTime; int curRow; - char buffer[200]; + char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4]; if (bmapPtr->bitmap == None) { return TCL_OK; @@ -749,7 +751,7 @@ BitmapToPostscript(interp, canvas, itemPtr, prepass) if (bmapPtr->bgColor != NULL) { sprintf(buffer, "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n", - x, y, width, height, -width,"0 rlineto closepath"); + x, y, width, height, -width, "0 rlineto closepath"); Tcl_AppendResult(interp, buffer, (char *) NULL); if (Tk_CanvasPsColor(interp, canvas, bmapPtr->bgColor) != TCL_OK) { return TCL_ERROR; diff --git a/generic/tkCanvImg.c b/generic/tkCanvImg.c index 0432bd7..cf1106d 100644 --- a/generic/tkCanvImg.c +++ b/generic/tkCanvImg.c @@ -4,12 +4,12 @@ * This file implements image items for canvas widgets. * * Copyright (c) 1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvImg.c,v 1.2 1998/09/14 18:23:05 stanton Exp $ + * RCS: @(#) $Id: tkCanvImg.c,v 1.3 1999/04/16 01:51:11 stanton Exp $ */ #include <stdio.h> @@ -126,7 +126,7 @@ Tk_ItemType tkImageType = { * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in - * interp->result; in this case itemPtr is left uninitialized, + * the interp's result; in this case itemPtr is left uninitialized, * so it can be safely freed by the caller. * * Side effects: @@ -190,7 +190,7 @@ CreateImage(interp, canvas, itemPtr, argc, argv) * details on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -224,8 +224,10 @@ ImageCoords(interp, canvas, itemPtr, argc, argv) } ComputeImageBbox(canvas, imgPtr); } else { - sprintf(interp->result, - "wrong # coordinates: expected 0 or 2, got %d", argc); + char buf[64]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; @@ -241,7 +243,7 @@ ImageCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information may be set for itemPtr. diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c index 1c35de5..131b73d 100644 --- a/generic/tkCanvLine.c +++ b/generic/tkCanvLine.c @@ -4,12 +4,13 @@ * This file implements line items for canvas widgets. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvLine.c,v 1.3 1999/02/04 20:51:23 stanton Exp $ + * RCS: @(#) $Id: tkCanvLine.c,v 1.4 1999/04/16 01:51:11 stanton Exp $ */ #include <stdio.h> @@ -180,15 +181,6 @@ Tk_ItemType tkLineType = { }; /* - * The Tk_Uid's below refer to uids for the various arrow types: - */ - -static Tk_Uid noneUid = NULL; -static Tk_Uid firstUid = NULL; -static Tk_Uid lastUid = NULL; -static Tk_Uid bothUid = NULL; - -/* * The definition below determines how large are static arrays * used to hold spline points (splines larger than this have to * have their arrays malloc-ed). @@ -207,7 +199,7 @@ static Tk_Uid bothUid = NULL; * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in - * interp->result; in this case itemPtr is left uninitialized, + * the interp's result; in this case itemPtr is left uninitialized, * so it can be safely freed by the caller. * * Side effects: @@ -252,13 +244,7 @@ CreateLine(interp, canvas, itemPtr, argc, argv) linePtr->joinStyle = JoinRound; linePtr->gc = None; linePtr->arrowGC = None; - if (noneUid == NULL) { - noneUid = Tk_GetUid("none"); - firstUid = Tk_GetUid("first"); - lastUid = Tk_GetUid("last"); - bothUid = Tk_GetUid("both"); - } - linePtr->arrow = noneUid; + linePtr->arrow = Tk_GetUid("none"); linePtr->arrowShapeA = (float)8.0; linePtr->arrowShapeB = (float)10.0; linePtr->arrowShapeC = (float)3.0; @@ -302,7 +288,7 @@ CreateLine(interp, canvas, itemPtr, argc, argv) * on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -385,7 +371,7 @@ LineCoords(interp, canvas, itemPtr, argc, argv) ckfree((char *) linePtr->lastArrowPtr); linePtr->lastArrowPtr = NULL; } - if (linePtr->arrow != noneUid) { + if (linePtr->arrow != Tk_GetUid("none")) { ConfigureArrows(canvas, linePtr); } ComputeLineBbox(canvas, linePtr); @@ -403,7 +389,7 @@ LineCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information, such as colors and stipple @@ -426,6 +412,10 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags) GC newGC, arrowGC; unsigned long mask; Tk_Window tkwin; + Tk_Uid noneUid = Tk_GetUid("none"); + Tk_Uid bothUid = Tk_GetUid("both"); + Tk_Uid firstUid = Tk_GetUid("first"); + Tk_Uid lastUid = Tk_GetUid("last"); tkwin = Tk_CanvasTkwin(canvas); if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv, @@ -493,8 +483,8 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags) ckfree((char *) linePtr->firstArrowPtr); linePtr->firstArrowPtr = NULL; } - if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != lastUid) - && (linePtr->arrow != bothUid)) { + if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != lastUid) + && (linePtr->arrow != bothUid)) { int i; i = 2*(linePtr->numPoints-1); @@ -505,7 +495,7 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags) } if (linePtr->arrow != noneUid) { if ((linePtr->arrow != firstUid) && (linePtr->arrow != lastUid) - && (linePtr->arrow != bothUid)) { + && (linePtr->arrow != bothUid)) { Tcl_AppendResult(interp, "bad arrow spec \"", linePtr->arrow, "\": must be none, first, last, or both", (char *) NULL); @@ -652,14 +642,14 @@ ComputeLineBbox(canvas, linePtr) * Add in the sizes of arrowheads, if any. */ - if (linePtr->arrow != noneUid) { - if (linePtr->arrow != lastUid) { + if (linePtr->arrow != Tk_GetUid("none")) { + if (linePtr->arrow != Tk_GetUid("last")) { for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW; i++, coordPtr += 2) { TkIncludePoint((Tk_Item *) linePtr, coordPtr); } } - if (linePtr->arrow != firstUid) { + if (linePtr->arrow != Tk_GetUid("first")) { for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW; i++, coordPtr += 2) { TkIncludePoint((Tk_Item *) linePtr, coordPtr); @@ -960,8 +950,8 @@ LineToPoint(canvas, itemPtr, pointPtr) * If there are arrowheads, check the distance to the arrowheads. */ - if (linePtr->arrow != noneUid) { - if (linePtr->arrow != lastUid) { + if (linePtr->arrow != Tk_GetUid("none")) { + if (linePtr->arrow != Tk_GetUid("last")) { dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW, pointPtr); if (dist <= 0.0) { @@ -971,7 +961,7 @@ LineToPoint(canvas, itemPtr, pointPtr) bestDist = dist; } } - if (linePtr->arrow != firstUid) { + if (linePtr->arrow != Tk_GetUid("first")) { dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW, pointPtr); if (dist <= 0.0) { @@ -1064,15 +1054,15 @@ LineToArea(canvas, itemPtr, rectPtr) * Check arrowheads, if any. */ - if (linePtr->arrow != noneUid) { - if (linePtr->arrow != lastUid) { + if (linePtr->arrow != Tk_GetUid("none")) { + if (linePtr->arrow != Tk_GetUid("last")) { if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW, rectPtr) != result) { result = 0; goto done; } } - if (linePtr->arrow != firstUid) { + if (linePtr->arrow != Tk_GetUid("first")) { if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW, rectPtr) != result) { result = 0; @@ -1145,7 +1135,7 @@ ScaleLine(canvas, itemPtr, originX, originY, scaleX, scaleY) coordPtr[0] = originX + scaleX*(*coordPtr - originX); coordPtr[1] = originY + scaleY*(coordPtr[1] - originY); } - if (linePtr->arrow != noneUid) { + if (linePtr->arrow != Tk_GetUid("none")) { ConfigureArrows(canvas, linePtr); } ComputeLineBbox(canvas, linePtr); @@ -1366,7 +1356,7 @@ ConfigureArrows(canvas, linePtr) fracHeight = (linePtr->width/2.0)/shapeC; backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0; - if (linePtr->arrow != lastUid) { + if (linePtr->arrow != Tk_GetUid("last")) { poly = linePtr->firstArrowPtr; if (poly == NULL) { poly = (double *) ckalloc((unsigned) @@ -1411,7 +1401,7 @@ ConfigureArrows(canvas, linePtr) * Similar arrowhead calculation for the last point of the line. */ - if (linePtr->arrow != firstUid) { + if (linePtr->arrow != Tk_GetUid("first")) { coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2); poly = linePtr->lastArrowPtr; if (poly == NULL) { @@ -1460,7 +1450,7 @@ ConfigureArrows(canvas, linePtr) * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is - * left in interp->result, replacing whatever used + * left in the interp's result, replacing whatever used * to be there. If no error occurs, then Postscript for the * item is appended to the result. * @@ -1482,7 +1472,7 @@ LineToPostscript(interp, canvas, itemPtr, prepass) * final Postscript is being created. */ { LineItem *linePtr = (LineItem *) itemPtr; - char buffer[200]; + char buffer[64 + TCL_INTEGER_SPACE]; char *style; if (linePtr->fg == NULL) { @@ -1600,7 +1590,7 @@ LineToPostscript(interp, canvas, itemPtr, prepass) * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is - * left in interp->result, replacing whatever used + * 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. * diff --git a/generic/tkCanvPoly.c b/generic/tkCanvPoly.c index 5f18bc7..ad5eb80 100644 --- a/generic/tkCanvPoly.c +++ b/generic/tkCanvPoly.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvPoly.c,v 1.2 1998/09/14 18:23:05 stanton Exp $ + * RCS: @(#) $Id: tkCanvPoly.c,v 1.3 1999/04/16 01:51:11 stanton Exp $ */ #include <stdio.h> @@ -150,7 +150,7 @@ Tk_ItemType tkPolygonType = { * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in - * interp->result; in this case itemPtr is + * the interp's result; in this case itemPtr is * left uninitialized, so it can be safely freed by the * caller. * @@ -234,7 +234,7 @@ CreatePolygon(interp, canvas, itemPtr, argc, argv) * on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -327,7 +327,7 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information, such as colors and stipple @@ -919,7 +919,7 @@ TranslatePolygon(canvas, itemPtr, deltaX, deltaY) * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is - * left in interp->result, replacing whatever used + * left in the interp's result, replacing whatever used * to be there. If no error occurs, then Postscript for the * item is appended to the result. * @@ -940,7 +940,6 @@ PolygonToPostscript(interp, canvas, itemPtr, prepass) * collect font information; 0 means * final Postscript is being created. */ { - char string[100]; PolygonItem *polyPtr = (PolygonItem *) itemPtr; /* @@ -977,6 +976,8 @@ PolygonToPostscript(interp, canvas, itemPtr, prepass) */ if (polyPtr->outlineColor != NULL) { + char string[32 + TCL_INTEGER_SPACE]; + if (!polyPtr->smooth) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index b87068d..4c99b15 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -6,12 +6,12 @@ * procedures used for generating Postscript. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvPs.c,v 1.4 1998/09/22 18:57:16 stanton Exp $ + * RCS: @(#) $Id: tkCanvPs.c,v 1.5 1999/04/16 01:51:11 stanton Exp $ */ #include "tkInt.h" @@ -115,6 +115,7 @@ static Tk_ConfigSpec configSpecs[] = { * The prolog data. Generated by str2c from prolog.ps * This was split in small chunks by str2c because * some C compiler have limitations on the size of static strings. + * (str2c is a small tcl script in tcl's tool directory (source release)) */ static CONST char * CONST prolog[]= { /* Start of part 1 (2000 characters) */ @@ -123,7 +124,7 @@ static CONST char * CONST prolog[]= { \n\ % This is a standard prolog for Postscript generated by Tk's canvas\n\ % widget.\n\ -% RCS: @(#) $Id: tkCanvPs.c,v 1.4 1998/09/22 18:57:16 stanton Exp $\n\ +% RCS: @(#) $Id: tkCanvPs.c,v 1.5 1999/04/16 01:51:11 stanton Exp $\n\ \n\ % The definitions below just define all of the variables used in\n\ % any of the procedures here. This is needed for obscure reasons\n\ @@ -710,20 +711,20 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n", "%%Creator: Tk Canvas Widget\n", (char *) NULL); -#if !(defined(__WIN32__) || defined(MAC_TCL)) +#ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { - struct passwd *pwPtr = getpwuid(getuid()); + struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ Tcl_AppendResult(canvasPtr->interp, "%%For: ", (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", (char *) NULL); endpwent(); } -#endif /* __WIN32__ || MAC_TCL */ +#endif /* HAVE_PW_GECOS */ Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ", Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL); time(&now); Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ", - ctime(&now), (char *) NULL); + ctime(&now), (char *) NULL); /* INTL: Native. */ if (!psInfo.rotate) { sprintf(string, "%d %d %d %d", (int) (psInfo.pageX + psInfo.scale*deltaX), @@ -764,7 +765,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) } if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -811,7 +812,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_AppendResult(canvasPtr->interp, string, " lineto closepath clip newpath\n", (char *) NULL); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -836,7 +837,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { - char msg[100]; + char msg[64 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (generating Postscript for item %d)", itemPtr->id); @@ -845,7 +846,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) } Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } } @@ -860,7 +861,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n", "%%Trailer\nend\n%%EOF\n", (char *) NULL); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -916,9 +917,9 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * then an error message will be left in the interp's result. * If no error occurs, then additional Postscript will be - * appended to interp->result. + * appended to the interp's result. * * Side effects: * None. @@ -997,9 +998,9 @@ Tk_CanvasPsColor(interp, canvas, colorPtr) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * then an error message will be left in the interp's result. * If no error occurs, then additional Postscript will be - * appended to the interp->result. + * appended to the interp's result. * * Side effects: * The Postscript font name is entered into psInfoPtr->fontTable @@ -1019,7 +1020,7 @@ Tk_CanvasPsFont(interp, canvas, tkfont) TkCanvas *canvasPtr = (TkCanvas *) canvas; TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; char *end; - char pointString[20]; + char pointString[TCL_INTEGER_SPACE]; Tcl_DString ds; int i, points; @@ -1091,9 +1092,9 @@ Tk_CanvasPsFont(interp, canvas, tkfont) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * then an error message will be left in the interp's result. * If no error occurs, then additional Postscript will be - * appended to interp->result. + * appended to the interp's result. * * Side effects: * None. @@ -1190,9 +1191,9 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * then an error message will be left in the interp's result. * If no error occurs, then additional Postscript will be - * appended to interp->result. + * appended to the interp's result. * * Side effects: * None. @@ -1210,7 +1211,7 @@ Tk_CanvasPsStipple(interp, canvas, bitmap) TkCanvas *canvasPtr = (TkCanvas *) canvas; TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; int width, height; - char string[100]; + char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; @@ -1278,7 +1279,7 @@ Tk_CanvasPsY(canvas, y) * commands to create the path. * * Results: - * Postscript commands get appended to what's in interp->result. + * Postscript commands get appended to what's in the interp's result. * * Side effects: * None. @@ -1327,7 +1328,7 @@ Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints) * TCL_OK is returned, then everything went well and the * screen distance is stored at *doublePtr; otherwise * TCL_ERROR is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 93230f7..b025e30 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -4,12 +4,12 @@ * This file implements text items for canvas widgets. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvText.c,v 1.3 1998/10/16 00:46:19 rjohnson Exp $ + * RCS: @(#) $Id: tkCanvText.c,v 1.4 1999/04/16 01:51:11 stanton Exp $ */ #include <stdio.h> @@ -36,8 +36,8 @@ typedef struct TextItem { */ double x, y; /* Positioning point for text. */ - int insertPos; /* Insertion cursor is displayed just to left - * of character with this index. */ + int insertPos; /* Character index of character just before + * which the insertion cursor is displayed. */ /* * Configuration settings that are updated by Tk_ConfigureWidget. @@ -57,7 +57,8 @@ typedef struct TextItem { * configuration settings above. */ - int numChars; /* Number of non-NULL characters in text. */ + 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 @@ -154,26 +155,26 @@ static void TranslateText _ANSI_ARGS_((Tk_Canvas canvas, */ Tk_ItemType tkTextType = { - "text", /* name */ - sizeof(TextItem), /* itemSize */ - CreateText, /* createProc */ - configSpecs, /* configSpecs */ - ConfigureText, /* configureProc */ - TextCoords, /* coordProc */ - DeleteText, /* deleteProc */ - DisplayCanvText, /* displayProc */ - 0, /* alwaysRedraw */ - TextToPoint, /* pointProc */ - TextToArea, /* areaProc */ - TextToPostscript, /* postscriptProc */ - ScaleText, /* scaleProc */ - TranslateText, /* translateProc */ - GetTextIndex, /* indexProc */ - SetTextCursor, /* icursorProc */ - GetSelText, /* selectionProc */ - TextInsert, /* insertProc */ - TextDeleteChars, /* dTextProc */ - (Tk_ItemType *) NULL /* nextPtr */ + "text", /* name */ + sizeof(TextItem), /* itemSize */ + CreateText, /* createProc */ + configSpecs, /* configSpecs */ + ConfigureText, /* configureProc */ + TextCoords, /* coordProc */ + DeleteText, /* deleteProc */ + DisplayCanvText, /* displayProc */ + 0, /* alwaysRedraw */ + TextToPoint, /* pointProc */ + TextToArea, /* areaProc */ + TextToPostscript, /* postscriptProc */ + ScaleText, /* scaleProc */ + TranslateText, /* translateProc */ + GetTextIndex, /* indexProc */ + SetTextCursor, /* icursorProc */ + GetSelText, /* selectionProc */ + TextInsert, /* insertProc */ + TextDeleteChars, /* dTextProc */ + (Tk_ItemType *) NULL /* nextPtr */ }; /* @@ -187,7 +188,7 @@ Tk_ItemType tkTextType = { * Results: * A standard Tcl return value. If an error occurred in * creating the item then an error message is left in - * interp->result; in this case itemPtr is left uninitialized + * the interp's result; in this case itemPtr is left uninitialized * so it can be safely freed by the caller. * * Side effects: @@ -198,12 +199,12 @@ Tk_ItemType tkTextType = { static int CreateText(interp, canvas, itemPtr, argc, argv) - Tcl_Interp *interp; /* Interpreter for error reporting. */ - Tk_Canvas canvas; /* Canvas to hold new item. */ - Tk_Item *itemPtr; /* Record to hold new item; header - * has been initialized by caller. */ - int argc; /* Number of arguments in argv. */ - char **argv; /* Arguments describing rectangle. */ + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Canvas canvas; /* Canvas to hold new item. */ + Tk_Item *itemPtr; /* Record to hold new item; header has been + * initialized by caller. */ + int argc; /* Number of arguments in argv. */ + char **argv; /* Arguments describing rectangle. */ { TextItem *textPtr = (TextItem *) itemPtr; @@ -215,8 +216,8 @@ CreateText(interp, canvas, itemPtr, argc, argv) } /* - * Carry out initialization that is needed in order to clean - * up after errors during the the remainder of this procedure. + * Carry out initialization that is needed in order to clean up after + * errors during the the remainder of this procedure. */ textPtr->textInfoPtr = Tk_CanvasGetTextInfo(canvas); @@ -232,6 +233,7 @@ CreateText(interp, canvas, itemPtr, argc, argv) textPtr->width = 0; textPtr->numChars = 0; + textPtr->numBytes = 0; textPtr->textLayout = NULL; textPtr->leftEdge = 0; textPtr->rightEdge = 0; @@ -266,7 +268,7 @@ CreateText(interp, canvas, itemPtr, argc, argv) * details on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -276,14 +278,12 @@ CreateText(interp, canvas, itemPtr, argc, argv) static int TextCoords(interp, canvas, itemPtr, argc, argv) - Tcl_Interp *interp; /* Used for error reporting. */ - Tk_Canvas canvas; /* Canvas containing item. */ - Tk_Item *itemPtr; /* Item whose coordinates are to be - * read or modified. */ - int argc; /* Number of coordinates supplied in - * argv. */ - char **argv; /* Array of coordinates: x1, y1, - * x2, y2, ... */ + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item whose coordinates are to be read or + * modified. */ + int argc; /* Number of coordinates supplied in argv. */ + char **argv; /* Array of coordinates: x1, y1, x2, y2, ... */ { TextItem *textPtr = (TextItem *) itemPtr; char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE]; @@ -300,8 +300,10 @@ TextCoords(interp, canvas, itemPtr, argc, argv) } ComputeTextBbox(canvas, textPtr); } else { - sprintf(interp->result, - "wrong # coordinates: expected 0 or 2, got %d", argc); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; @@ -317,7 +319,7 @@ TextCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information, such as colors and stipple @@ -400,17 +402,19 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags) * to keep them inside the item. */ - textPtr->numChars = strlen(textPtr->text); + textPtr->numBytes = strlen(textPtr->text); + textPtr->numChars = Tcl_NumUtfChars(textPtr->text, textPtr->numBytes); if (textInfoPtr->selItemPtr == itemPtr) { + if (textInfoPtr->selectFirst >= textPtr->numChars) { textInfoPtr->selItemPtr = NULL; } else { if (textInfoPtr->selectLast >= textPtr->numChars) { - textInfoPtr->selectLast = textPtr->numChars-1; + textInfoPtr->selectLast = textPtr->numChars - 1; } if ((textInfoPtr->anchorItemPtr == itemPtr) && (textInfoPtr->selectAnchor >= textPtr->numChars)) { - textInfoPtr->selectAnchor = textPtr->numChars-1; + textInfoPtr->selectAnchor = textPtr->numChars - 1; } } } @@ -441,10 +445,9 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags) static void DeleteText(canvas, itemPtr, display) - Tk_Canvas canvas; /* Info about overall canvas widget. */ - Tk_Item *itemPtr; /* Item that is being deleted. */ - Display *display; /* Display containing window for - * canvas. */ + Tk_Canvas canvas; /* Info about overall canvas widget. */ + Tk_Item *itemPtr; /* Item that is being deleted. */ + Display *display; /* Display containing window for canvas. */ { TextItem *textPtr = (TextItem *) itemPtr; @@ -494,9 +497,8 @@ DeleteText(canvas, itemPtr, display) static void ComputeTextBbox(canvas, textPtr) - Tk_Canvas canvas; /* Canvas that contains item. */ - TextItem *textPtr; /* Item whose bbos is to be - * recomputed. */ + Tk_Canvas canvas; /* Canvas that contains item. */ + TextItem *textPtr; /* Item whose bbox is to be recomputed. */ { Tk_CanvasTextInfo *textInfoPtr; int leftX, topY, width, height, fudge; @@ -591,17 +593,16 @@ ComputeTextBbox(canvas, textPtr) static void DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height) - Tk_Canvas canvas; /* Canvas that contains item. */ - Tk_Item *itemPtr; /* Item to be displayed. */ - Display *display; /* Display on which to draw item. */ - Drawable drawable; /* Pixmap or window in which to draw - * item. */ - int x, y, width, height; /* Describes region of canvas that - * must be redisplayed (not used). */ + Tk_Canvas canvas; /* Canvas that contains item. */ + Tk_Item *itemPtr; /* Item to be displayed. */ + Display *display; /* Display on which to draw item. */ + Drawable drawable; /* Pixmap or window in which to draw item. */ + int x, y, width, height; /* Describes region of canvas that must be + * redisplayed (not used). */ { TextItem *textPtr; Tk_CanvasTextInfo *textInfoPtr; - int selFirst, selLast; + int selFirstChar, selLastChar; short drawableX, drawableY; textPtr = (TextItem *) itemPtr; @@ -621,26 +622,30 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height) Tk_CanvasSetStippleOrigin(canvas, textPtr->gc); } - selFirst = -1; - selLast = 0; /* lint. */ + selFirstChar = -1; + selLastChar = 0; /* lint. */ + if (textInfoPtr->selItemPtr == itemPtr) { - selFirst = textInfoPtr->selectFirst; - selLast = textInfoPtr->selectLast; - if (selLast >= textPtr->numChars) { - selLast = textPtr->numChars - 1; + char *text; + + text = textPtr->text; + selFirstChar = textInfoPtr->selectFirst; + selLastChar = textInfoPtr->selectLast; + if (selLastChar >= textPtr->numChars) { + selLastChar = textPtr->numChars - 1; } - if ((selFirst >= 0) && (selFirst <= selLast)) { + if ((selFirstChar >= 0) && (selFirstChar <= selLastChar)) { + int xFirst, yFirst, hFirst; + int xLast, yLast; + /* * Draw a special background under the selection. */ - int xFirst, yFirst, hFirst; - int xLast, yLast, wLast; - - Tk_CharBbox(textPtr->textLayout, selFirst, - &xFirst, &yFirst, NULL, &hFirst); - Tk_CharBbox(textPtr->textLayout, selLast, - &xLast, &yLast, &wLast, NULL); + Tk_CharBbox(textPtr->textLayout, selFirstChar, &xFirst, &yFirst, + NULL, &hFirst); + Tk_CharBbox(textPtr->textLayout, selLastChar, &xLast, &yLast, + NULL, NULL); /* * If the selection spans the end of this line, then display @@ -653,7 +658,7 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height) height = hFirst; for (y = yFirst ; y <= yLast; y += height) { if (y == yLast) { - width = (xLast + wLast) - x; + width = xLast - x; } else { width = textPtr->rightEdge - textPtr->leftEdge - x; } @@ -724,10 +729,10 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height) Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, drawableX, drawableY, 0, -1); - if ((selFirst >= 0) && (textPtr->selTextGC != textPtr->gc)) { + if ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) { Tk_DrawTextLayout(display, drawable, textPtr->selTextGC, - textPtr->textLayout, drawableX, drawableY, selFirst, - selLast + 1); + textPtr->textLayout, drawableX, drawableY, selFirstChar, + selLastChar + 1); } if (textPtr->stipple != None) { @@ -754,36 +759,42 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height) */ static void -TextInsert(canvas, itemPtr, beforeThis, string) +TextInsert(canvas, itemPtr, index, string) Tk_Canvas canvas; /* Canvas containing text item. */ Tk_Item *itemPtr; /* Text item to be modified. */ - int beforeThis; /* Index of character before which text is + int index; /* Character index before which string is * to be inserted. */ char *string; /* New characters to be inserted. */ { TextItem *textPtr = (TextItem *) itemPtr; - int length; - char *new; + int byteIndex, byteCount, charsAdded; + char *new, *text; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; - length = strlen(string); - if (length == 0) { - return; + text = textPtr->text; + + if (index < 0) { + index = 0; } - if (beforeThis < 0) { - beforeThis = 0; + if (index > textPtr->numChars) { + index = textPtr->numChars; } - if (beforeThis > textPtr->numChars) { - beforeThis = textPtr->numChars; + byteIndex = Tcl_UtfAtIndex(text, index) - text; + byteCount = strlen(string); + if (byteCount == 0) { + return; } - new = (char *) ckalloc((unsigned) (textPtr->numChars + length + 1)); - strncpy(new, textPtr->text, (size_t) beforeThis); - strcpy(new+beforeThis, string); - strcpy(new+beforeThis+length, textPtr->text+beforeThis); - ckfree(textPtr->text); + new = (char *) ckalloc((unsigned) textPtr->numBytes + byteCount + 1); + memcpy(new, text, (size_t) byteIndex); + strcpy(new + byteIndex, string); + strcpy(new + byteIndex + byteCount, text + byteIndex); + + ckfree(text); textPtr->text = new; - textPtr->numChars += length; + charsAdded = Tcl_NumUtfChars(string, byteCount); + textPtr->numChars += charsAdded; + textPtr->numBytes += byteCount; /* * Inserting characters invalidates indices such as those for the @@ -791,19 +802,19 @@ TextInsert(canvas, itemPtr, beforeThis, string) */ if (textInfoPtr->selItemPtr == itemPtr) { - if (textInfoPtr->selectFirst >= beforeThis) { - textInfoPtr->selectFirst += length; + if (textInfoPtr->selectFirst >= index) { + textInfoPtr->selectFirst += charsAdded; } - if (textInfoPtr->selectLast >= beforeThis) { - textInfoPtr->selectLast += length; + if (textInfoPtr->selectLast >= index) { + textInfoPtr->selectLast += charsAdded; } if ((textInfoPtr->anchorItemPtr == itemPtr) - && (textInfoPtr->selectAnchor >= beforeThis)) { - textInfoPtr->selectAnchor += length; + && (textInfoPtr->selectAnchor >= index)) { + textInfoPtr->selectAnchor += charsAdded; } } - if (textPtr->insertPos >= beforeThis) { - textPtr->insertPos += length; + if (textPtr->insertPos >= index) { + textPtr->insertPos += charsAdded; } ComputeTextBbox(canvas, textPtr); } @@ -830,31 +841,40 @@ static void TextDeleteChars(canvas, itemPtr, first, last) Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Item in which to delete characters. */ - int first; /* Index of first character to delete. */ - int last; /* Index of last character to delete. */ + int first; /* Character index of first character to + * delete. */ + int last; /* Character index of last character to + * delete (inclusive). */ { TextItem *textPtr = (TextItem *) itemPtr; - int count; - char *new; + int byteIndex, byteCount, charsRemoved; + char *new, *text; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; + text = textPtr->text; if (first < 0) { first = 0; } if (last >= textPtr->numChars) { - last = textPtr->numChars-1; + last = textPtr->numChars - 1; } if (first > last) { return; } - count = last + 1 - first; + charsRemoved = last + 1 - first; + + byteIndex = Tcl_UtfAtIndex(text, first) - text; + byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved) + - (text + byteIndex); + + new = (char *) ckalloc((unsigned) (textPtr->numBytes + 1 - byteCount)); + memcpy(new, text, (size_t) byteIndex); + strcpy(new + byteIndex, text + byteIndex + byteCount); - new = (char *) ckalloc((unsigned) (textPtr->numChars + 1 - count)); - strncpy(new, textPtr->text, (size_t) first); - strcpy(new+first, textPtr->text+last+1); - ckfree(textPtr->text); + ckfree(text); textPtr->text = new; - textPtr->numChars -= count; + textPtr->numChars -= charsRemoved; + textPtr->numBytes -= byteCount; /* * Update indexes for the selection and cursor to reflect the @@ -863,15 +883,15 @@ TextDeleteChars(canvas, itemPtr, first, last) if (textInfoPtr->selItemPtr == itemPtr) { if (textInfoPtr->selectFirst > first) { - textInfoPtr->selectFirst -= count; + textInfoPtr->selectFirst -= charsRemoved; if (textInfoPtr->selectFirst < first) { textInfoPtr->selectFirst = first; } } if (textInfoPtr->selectLast >= first) { - textInfoPtr->selectLast -= count; - if (textInfoPtr->selectLast < (first-1)) { - textInfoPtr->selectLast = (first-1); + textInfoPtr->selectLast -= charsRemoved; + if (textInfoPtr->selectLast < first - 1) { + textInfoPtr->selectLast = first - 1; } } if (textInfoPtr->selectFirst > textInfoPtr->selectLast) { @@ -879,14 +899,14 @@ TextDeleteChars(canvas, itemPtr, first, last) } if ((textInfoPtr->anchorItemPtr == itemPtr) && (textInfoPtr->selectAnchor > first)) { - textInfoPtr->selectAnchor -= count; + textInfoPtr->selectAnchor -= charsRemoved; if (textInfoPtr->selectAnchor < first) { textInfoPtr->selectAnchor = first; } } } if (textPtr->insertPos > first) { - textPtr->insertPos -= count; + textPtr->insertPos -= charsRemoved; if (textPtr->insertPos < first) { textPtr->insertPos = first; } @@ -987,11 +1007,11 @@ TextToArea(canvas, itemPtr, rectPtr) /* ARGSUSED */ static void ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY) - Tk_Canvas canvas; /* Canvas containing rectangle. */ - Tk_Item *itemPtr; /* Rectangle to be scaled. */ - double originX, originY; /* Origin about which to scale rect. */ - double scaleX; /* Amount to scale in X direction. */ - double scaleY; /* Amount to scale in Y direction. */ + Tk_Canvas canvas; /* Canvas containing rectangle. */ + Tk_Item *itemPtr; /* Rectangle to be scaled. */ + double originX, originY; /* Origin about which to scale rect. */ + double scaleX; /* Amount to scale in X direction. */ + double scaleY; /* Amount to scale in Y direction. */ { TextItem *textPtr = (TextItem *) itemPtr; @@ -1022,10 +1042,9 @@ ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY) static void TranslateText(canvas, itemPtr, deltaX, deltaY) - Tk_Canvas canvas; /* Canvas containing item. */ - Tk_Item *itemPtr; /* Item that is being moved. */ - double deltaX, deltaY; /* Amount by which item is to be - * moved. */ + Tk_Canvas canvas; /* Canvas containing item. */ + Tk_Item *itemPtr; /* Item that is being moved. */ + double deltaX, deltaY; /* Amount by which item is to be moved. */ { TextItem *textPtr = (TextItem *) itemPtr; @@ -1046,7 +1065,7 @@ TranslateText(canvas, itemPtr, deltaX, deltaY) * A standard Tcl result. If all went well, then *indexPtr is * filled in with the index (into itemPtr) corresponding to * string. Otherwise an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. @@ -1062,7 +1081,8 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr) * specified. */ char *string; /* Specification of a particular character * in itemPtr's text. */ - int *indexPtr; /* Where to store converted index. */ + int *indexPtr; /* Where to store converted character + * index. */ { TextItem *textPtr = (TextItem *) itemPtr; size_t length; @@ -1080,14 +1100,14 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr) } else if ((c == 's') && (strncmp(string, "sel.first", length) == 0) && (length >= 5)) { if (textInfoPtr->selItemPtr != itemPtr) { - interp->result = "selection isn't in item"; + Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); return TCL_ERROR; } *indexPtr = textInfoPtr->selectFirst; } else if ((c == 's') && (strncmp(string, "sel.last", length) == 0) && (length >= 5)) { if (textInfoPtr->selItemPtr != itemPtr) { - interp->result = "selection isn't in item"; + Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); return TCL_ERROR; } *indexPtr = textInfoPtr->selectLast; @@ -1119,7 +1139,7 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr) } } else { /* - * Some of the paths here leave messages in interp->result, + * Some of the paths here leave messages in the interp's result, * so we have to clear it out before storing our own message. */ @@ -1151,11 +1171,11 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr) /* ARGSUSED */ static void SetTextCursor(canvas, itemPtr, index) - Tk_Canvas canvas; /* Record describing canvas widget. */ - Tk_Item *itemPtr; /* Text item in which cursor position - * is to be set. */ - int index; /* Index of character just before which - * cursor is to be positioned. */ + Tk_Canvas canvas; /* Record describing canvas widget. */ + Tk_Item *itemPtr; /* Text item in which cursor position is to + * be set. */ + int index; /* Character index of character just before + * which cursor is to be positioned. */ { TextItem *textPtr = (TextItem *) itemPtr; @@ -1191,34 +1211,38 @@ SetTextCursor(canvas, itemPtr, index) static int GetSelText(canvas, itemPtr, offset, buffer, maxBytes) - Tk_Canvas canvas; /* Canvas containing selection. */ - Tk_Item *itemPtr; /* Text item containing selection. */ - int offset; /* Offset within selection of first - * character to be returned. */ - char *buffer; /* Location in which to place - * selection. */ - int maxBytes; /* Maximum number of bytes to place - * at buffer, not including terminating - * NULL character. */ + Tk_Canvas canvas; /* Canvas containing selection. */ + Tk_Item *itemPtr; /* Text item containing selection. */ + int offset; /* Byte offset within selection of first + * character to be returned. */ + char *buffer; /* Location in which to place selection. */ + int maxBytes; /* Maximum number of bytes to place at + * buffer, not including terminating NULL + * character. */ { TextItem *textPtr = (TextItem *) itemPtr; - int count; + int byteCount; + char *text, *selStart, *selEnd; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; - count = textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst - offset; - if (textInfoPtr->selectLast == textPtr->numChars) { - count -= 1; + if ((textInfoPtr->selectFirst < 0) || + (textInfoPtr->selectFirst > textInfoPtr->selectLast)) { + return 0; } - if (count > maxBytes) { - count = maxBytes; + text = textPtr->text; + selStart = Tcl_UtfAtIndex(text, textInfoPtr->selectFirst); + selEnd = Tcl_UtfAtIndex(selStart, + textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst); + byteCount = selEnd - selStart - offset; + if (byteCount > maxBytes) { + byteCount = maxBytes; } - if (count <= 0) { + if (byteCount <= 0) { return 0; } - strncpy(buffer, textPtr->text + textInfoPtr->selectFirst + offset, - (size_t) count); - buffer[count] = '\0'; - return count; + memcpy(buffer, selStart + offset, (size_t) byteCount); + buffer[byteCount] = '\0'; + return byteCount; } /* @@ -1232,7 +1256,7 @@ GetSelText(canvas, itemPtr, offset, buffer, maxBytes) * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is - * left in interp->result, replacing whatever used + * left in the interp's result, replacing whatever used * to be there. If no error occurs, then Postscript for the * item is appended to the result. * @@ -1244,14 +1268,12 @@ GetSelText(canvas, itemPtr, offset, buffer, maxBytes) static int TextToPostscript(interp, canvas, itemPtr, prepass) - Tcl_Interp *interp; /* Leave Postscript or error message - * here. */ - Tk_Canvas canvas; /* Information about overall canvas. */ - Tk_Item *itemPtr; /* Item for which Postscript is - * wanted. */ - int prepass; /* 1 means this is a prepass to - * collect font information; 0 means - * final Postscript is being created. */ + Tcl_Interp *interp; /* Leave Postscript or error message here. */ + Tk_Canvas canvas; /* Information about overall canvas. */ + Tk_Item *itemPtr; /* Item for which Postscript is wanted. */ + int prepass; /* 1 means this is a prepass to collect + * font information; 0 means final Postscript + * is being created. */ { TextItem *textPtr = (TextItem *) itemPtr; int x, y; diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c index 16a5ffa..7d203ec 100644 --- a/generic/tkCanvUtil.c +++ b/generic/tkCanvUtil.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvUtil.c,v 1.2 1998/09/14 18:23:06 stanton Exp $ + * RCS: @(#) $Id: tkCanvUtil.c,v 1.3 1999/04/16 01:51:12 stanton Exp $ */ #include "tk.h" @@ -177,7 +177,7 @@ Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr) * TCL_OK is returned, then everything went well and the * canvas coordinate is stored at *doublePtr; otherwise * TCL_ERROR is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c index 5839cae..4dd8ee3 100644 --- a/generic/tkCanvWind.c +++ b/generic/tkCanvWind.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvWind.c,v 1.2 1998/09/14 18:23:06 stanton Exp $ + * RCS: @(#) $Id: tkCanvWind.c,v 1.3 1999/04/16 01:51:12 stanton Exp $ */ #include <stdio.h> @@ -147,7 +147,7 @@ static Tk_GeomMgr canvasGeomType = { * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in - * interp->result; in this case itemPtr is + * the interp's result; in this case itemPtr is * left uninitialized, so it can be safely freed by the * caller. * @@ -214,7 +214,7 @@ CreateWinItem(interp, canvas, itemPtr, argc, argv) * details on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -248,8 +248,10 @@ WinItemCoords(interp, canvas, itemPtr, argc, argv) } ComputeWindowBbox(canvas, winItemPtr); } else { - sprintf(interp->result, - "wrong # coordinates: expected 0 or 2, got %d", argc); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; @@ -265,7 +267,7 @@ WinItemCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information may be set for itemPtr. diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index c095f7e..2ec336d 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -6,13 +6,13 @@ * objects such as rectangles, lines, and texts. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvas.c,v 1.3 1998/10/13 18:13:06 rjohnson Exp $ + * RCS: @(#) $Id: tkCanvas.c,v 1.4 1999/04/16 01:51:12 stanton Exp $ */ #include "default.h" @@ -152,20 +152,6 @@ extern Tk_ItemType tkOvalType, tkPolygonType; extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType; /* - * Various Tk_Uid's used by this module (set up during initialization): - */ - -static Tk_Uid allUid = NULL; -static Tk_Uid currentUid = NULL; - -/* - * Statistics counters: - */ - -static int numIdSearches; -static int numSlowSearches; - -/* * Prototypes for procedures defined later in this file: */ @@ -356,7 +342,7 @@ Tk_CanvasCmd(clientData, interp, argc, argv) canvasPtr->nextId = 1; canvasPtr->psInfoPtr = NULL; Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS); - + Tk_SetClass(canvasPtr->tkwin, "Canvas"); TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr); Tk_CreateEventHandler(canvasPtr->tkwin, @@ -372,7 +358,7 @@ Tk_CanvasCmd(clientData, interp, argc, argv) goto error; } - interp->result = Tk_PathName(canvasPtr->tkwin); + Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC); return TCL_OK; error: @@ -475,7 +461,10 @@ CanvasWidgetCmd(clientData, interp, argc, argv) } } if (gotAny) { - sprintf(interp->result, "%d %d %d %d", x1, y1, x2, y2); + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", x1, y1, x2, y2); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } } else if ((c == 'b') && (strncmp(argv[1], "bind", length) == 0) && (length >= 2)) { @@ -565,15 +554,30 @@ CanvasWidgetCmd(clientData, interp, argc, argv) command = Tk_GetBinding(interp, canvasPtr->bindingTable, object, argv[3]); if (command == NULL) { - goto error; + char *string; + + string = Tcl_GetStringResult(interp); + /* + * Ignore missing binding errors. This is a special hack + * that relies on the error message returned by FindSequence + * in tkBind.c. + */ + + if (string[0] != '\0') { + goto error; + } else { + Tcl_ResetResult(interp); + } + } else { + Tcl_SetResult(interp, command, TCL_STATIC); } - interp->result = command; } else { Tk_GetAllBindings(interp, canvasPtr->bindingTable, object); } } else if ((c == 'c') && (strcmp(argv[1], "canvasx") == 0)) { int x; double grid; + char buf[TCL_DOUBLE_SPACE]; if ((argc < 3) || (argc > 4)) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -593,10 +597,12 @@ CanvasWidgetCmd(clientData, interp, argc, argv) grid = 0.0; } x += canvasPtr->xOrigin; - Tcl_PrintDouble(interp, GridAlign((double) x, grid), interp->result); + Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'c') && (strcmp(argv[1], "canvasy") == 0)) { int y; double grid; + char buf[TCL_DOUBLE_SPACE]; if ((argc < 3) || (argc > 4)) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -616,7 +622,8 @@ CanvasWidgetCmd(clientData, interp, argc, argv) grid = 0.0; } y += canvasPtr->yOrigin; - Tcl_PrintDouble(interp, GridAlign((double) y, grid), interp->result); + Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) && (length >= 2)) { if (argc != 3) { @@ -667,9 +674,10 @@ CanvasWidgetCmd(clientData, interp, argc, argv) Tk_ItemType *typePtr; Tk_ItemType *matchPtr = NULL; Tk_Item *itemPtr; + char buf[TCL_INTEGER_SPACE]; int isNew = 0; Tcl_HashEntry *entryPtr; - + if (argc < 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " create type ?arg arg ...?\"", (char *) NULL); @@ -722,7 +730,8 @@ CanvasWidgetCmd(clientData, interp, argc, argv) Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); canvasPtr->flags |= REPICK_NEEDED; - sprintf(interp->result, "%d", itemPtr->id); + sprintf(buf, "%d", itemPtr->id); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'd') && (strncmp(argv[1], "dchars", length) == 0) && (length >= 2)) { int first, last; @@ -870,7 +879,10 @@ CanvasWidgetCmd(clientData, interp, argc, argv) itemPtr = canvasPtr->textInfo.focusItemPtr; if (argc == 2) { if (itemPtr != NULL) { - sprintf(interp->result, "%d", itemPtr->id); + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "%d", itemPtr->id); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } goto done; } @@ -940,6 +952,7 @@ CanvasWidgetCmd(clientData, interp, argc, argv) } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) && (length >= 3)) { int index; + char buf[TCL_INTEGER_SPACE]; if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -962,7 +975,8 @@ CanvasWidgetCmd(clientData, interp, argc, argv) itemPtr, argv[3], &index) != TCL_OK) { goto error; } - sprintf(interp->result, "%d", index); + sprintf(buf, "%d", index); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) && (length >= 3)) { int beforeThis; @@ -1145,7 +1159,7 @@ CanvasWidgetCmd(clientData, interp, argc, argv) goto error; } if ((xScale == 0.0) || (yScale == 0.0)) { - interp->result = "scale factor cannot be zero"; + Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC); goto error; } for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search); @@ -1280,8 +1294,10 @@ CanvasWidgetCmd(clientData, interp, argc, argv) goto error; } if (canvasPtr->textInfo.selItemPtr != NULL) { - sprintf(interp->result, "%d", - canvasPtr->textInfo.selItemPtr->id); + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) { if (argc != 5) { @@ -1305,7 +1321,7 @@ CanvasWidgetCmd(clientData, interp, argc, argv) } itemPtr = StartTagSearch(canvasPtr, argv[2], &search); if (itemPtr != NULL) { - interp->result = itemPtr->typePtr->name; + Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC); } } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { int count, type; @@ -1317,7 +1333,7 @@ CanvasWidgetCmd(clientData, interp, argc, argv) PrintScrollFractions(canvasPtr->xOrigin + canvasPtr->inset, canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollX1, - canvasPtr->scrollX2, interp->result); + canvasPtr->scrollX2, Tcl_GetStringResult(interp)); } else { type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); switch (type) { @@ -1355,7 +1371,7 @@ CanvasWidgetCmd(clientData, interp, argc, argv) PrintScrollFractions(canvasPtr->yOrigin + canvasPtr->inset, canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollY1, - canvasPtr->scrollY2, interp->result); + canvasPtr->scrollY2, Tcl_GetStringResult(interp)); } else { type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); switch (type) { @@ -1473,7 +1489,7 @@ DestroyCanvas(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as colors, border width, @@ -2141,8 +2157,6 @@ InitCanvas() tkBitmapType.nextPtr = &tkArcType; tkArcType.nextPtr = &tkWindowType; tkWindowType.nextPtr = NULL; - allUid = Tk_GetUid("all"); - currentUid = Tk_GetUid("current"); } /* @@ -2183,6 +2197,11 @@ StartTagSearch(canvasPtr, tag, searchPtr) Tk_Uid *tagPtr; Tk_Uid uid; int count; + TkWindow *tkwin; + TkDisplay *dispPtr; + + tkwin = (TkWindow *) canvasPtr->tkwin; + dispPtr = tkwin->dispPtr; /* * Initialize the search. @@ -2201,15 +2220,15 @@ StartTagSearch(canvasPtr, tag, searchPtr) if (isdigit(UCHAR(*tag))) { char *end; Tcl_HashEntry *entryPtr; - - numIdSearches++; + + dispPtr->numIdSearches++; id = strtoul(tag, &end, 0); if (*end == 0) { itemPtr = canvasPtr->hotPtr; - lastPtr = canvasPtr->hotPrevPtr; + lastPtr = canvasPtr->hotPrevPtr; if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL) || (lastPtr->nextPtr != itemPtr)) { - numSlowSearches++; + dispPtr->numSlowSearches++; entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); if (entryPtr != NULL) { itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr); @@ -2227,7 +2246,7 @@ StartTagSearch(canvasPtr, tag, searchPtr) } searchPtr->tag = uid = Tk_GetUid(tag); - if (uid == allUid) { + if (uid == Tk_GetUid("all")) { /* * All items match. @@ -2362,7 +2381,7 @@ NextItem(searchPtr) * * Side effects: * If tag is NULL then itemPtr's id is added as a list element - * to interp->result; otherwise tag is added to itemPtr's + * to the interp's result; otherwise tag is added to itemPtr's * list of tags. * *-------------------------------------------------------------- @@ -2384,7 +2403,8 @@ DoItem(interp, itemPtr, tag) */ if (tag == NULL) { - char msg[30]; + char msg[TCL_INTEGER_SPACE]; + sprintf(msg, "%d", itemPtr->id); Tcl_AppendElement(interp, msg); return; @@ -2438,9 +2458,9 @@ DoItem(interp, itemPtr, tag) * Results: * A standard Tcl return value. If newTag is NULL, then a * list of ids from all the items that match argc/argv is - * returned in interp->result. If newTag is NULL, then - * the normal interp->result is an empty string. If an error - * occurs, then interp->result will hold an error message. + * returned in the interp's result. If newTag is NULL, then + * the normal the interp's result is an empty string. If an error + * occurs, then the interp's result will hold an error message. * * Side effects: * If newTag is non-NULL, then all the items that match the @@ -2463,7 +2483,7 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option) char *newTag; /* If non-NULL, gives new tag to set * on all found items; if NULL, then * ids of found items are returned - * in interp->result. */ + * in the interp's result. */ char *cmdName; /* Name of original Tcl command, for * use in error messages. */ char *option; /* For error messages: gives option @@ -2671,9 +2691,9 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option) * Results: * A standard Tcl return value. If newTag is NULL, then a * list of ids from all the items overlapping or enclosed - * by the rectangle given by argc is returned in interp->result. - * If newTag is NULL, then the normal interp->result is an - * empty string. If an error occurs, then interp->result will + * by the rectangle given by argc is returned in the interp's result. + * If newTag is NULL, then the normal the interp's result is an + * empty string. If an error occurs, then the interp's result will * hold an error message. * * Side effects: @@ -2696,7 +2716,7 @@ FindArea(interp, canvasPtr, argv, uid, enclosed) Tk_Uid uid; /* If non-NULL, gives new tag to set * on all found items; if NULL, then * ids of found items are returned - * in interp->result. */ + * in the interp's result. */ int enclosed; /* 0 means overlapping or enclosed * items are OK, 1 means only enclosed * items are OK. */ @@ -3114,7 +3134,7 @@ PickCurrentItem(canvasPtr, eventPtr) if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) { for (i = itemPtr->numTags-1; i >= 0; i--) { - if (itemPtr->tagPtr[i] == currentUid) { + if (itemPtr->tagPtr[i] == Tk_GetUid("current")) { itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1]; itemPtr->numTags--; break; @@ -3144,7 +3164,8 @@ PickCurrentItem(canvasPtr, eventPtr) if (canvasPtr->currentItemPtr != NULL) { XEvent event; - DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, currentUid); + DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, + Tk_GetUid("current")); event = canvasPtr->pickEvent; event.type = EnterNotify; event.xcrossing.detail = NotifyAncestor; @@ -3260,7 +3281,7 @@ CanvasDoEvent(canvasPtr, eventPtr) objectPtr = (ClientData *) ckalloc((unsigned) (numObjects * sizeof(ClientData))); } - objectPtr[0] = (ClientData) allUid; + objectPtr[0] = (ClientData) Tk_GetUid("all"); for (i = itemPtr->numTags-1; i >= 0; i--) { objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i]; } diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index 7df518a..e2a5187 100644 --- a/generic/tkClipboard.c +++ b/generic/tkClipboard.c @@ -6,12 +6,12 @@ * supplied on demand to requesting applications. * * Copyright (c) 1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkClipboard.c,v 1.2 1998/09/14 18:23:07 stanton Exp $ + * RCS: @(#) $Id: tkClipboard.c,v 1.3 1999/04/16 01:51:12 stanton Exp $ */ #include "tkInt.h" @@ -226,7 +226,7 @@ ClipboardLostSel(clientData) * * Results: * A standard Tcl result. If an error occurs, an error message is - * left in interp->result. + * left in the interp's result. * * Side effects: * From now on, requests for the CLIPBOARD selection will be @@ -311,7 +311,7 @@ Tk_ClipboardClear(interp, tkwin) * * Results: * A standard Tcl result. If an error is returned, an error message - * is left in interp->result. + * is left in the interp's result. * * Side effects: * The specified buffer will be copied onto the end of the clipboard. @@ -528,9 +528,10 @@ Tk_ClipboardCmd(clientData, interp, argc, argv) } return Tk_ClipboardClear(interp, tkwin); } else { - sprintf(interp->result, - "bad option \"%.50s\": must be clear or append", - argv[1]); + char buf[100 + TCL_INTEGER_SPACE]; + + sprintf(buf, "bad option \"%.50s\": must be clear or append", argv[1]); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } } @@ -546,8 +547,8 @@ Tk_ClipboardCmd(clientData, interp, argc, argv) * * Results: * The result is a standard Tcl return value, which is normally TCL_OK. - * If an error occurs then an error message is left in interp->result - * and TCL_ERROR is returned. + * If an error occurs then an error message is left in the interp's + * result and TCL_ERROR is returned. * * Side effects: * Sets up the clipWindow and related data structures. diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 19d05ca..b655fc0 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -5,13 +5,12 @@ * that didn't fit in any particular file of the toolkit. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCmds.c,v 1.5 1999/03/10 07:04:39 stanton Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.6 1999/04/16 01:51:12 stanton Exp $ */ #include "tkPort.h" @@ -26,6 +25,7 @@ #include "tkUnixInt.h" #endif + /* * Forward declarations for procedures defined later in this file: */ @@ -63,12 +63,10 @@ Tk_BellObjCmd(clientData, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { + static char *bellOptions[] = {"-displayof", (char *) NULL}; Tk_Window tkwin = (Tk_Window) clientData; + char *displayName; int index; - char *string; - static char *optionStrings[] = { - "-displayof", NULL - }; if ((objc != 1) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window?"); @@ -76,12 +74,13 @@ Tk_BellObjCmd(clientData, interp, objc, objv) } if (objc == 3) { - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + if (Tcl_GetIndexFromObj(interp, objv[1], bellOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } - string = Tcl_GetStringFromObj(objv[2], NULL); - tkwin = Tk_NameToWindow(interp, string, tkwin); + displayName = Tcl_GetStringFromObj(objv[2], (int *) NULL); + + tkwin = Tk_NameToWindow(interp, displayName, tkwin); if (tkwin == NULL) { return TCL_ERROR; } @@ -162,7 +161,7 @@ Tk_BindCmd(clientData, interp, argc, argv) Tcl_ResetResult(interp); return TCL_OK; } - interp->result = command; + Tcl_SetResult(interp, command, TCL_STATIC); } else { Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); } @@ -194,7 +193,6 @@ TkBindEventProc(winPtr, eventPtr) { #define MAX_OBJS 20 ClientData objects[MAX_OBJS], *objPtr; - static Tk_Uid allUid = NULL; TkWindow *topLevPtr; int i, count; char *p; @@ -242,10 +240,7 @@ TkBindEventProc(winPtr, eventPtr) } else { count = 3; } - if (allUid == NULL) { - allUid = Tk_GetUid("all"); - } - objPtr[count-1] = (ClientData) allUid; + objPtr[count-1] = (ClientData) Tk_GetUid("all"); } Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr, count, objPtr); @@ -606,7 +601,7 @@ Tk_TkObjCmd(clientData, interp, objc, objv) string = Tcl_GetStringFromObj(objv[2], NULL); winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); } - Tcl_SetStringObj(Tcl_GetObjResult(interp), winPtr->nameUid, -1); + Tcl_AppendResult(interp, winPtr->nameUid, NULL); break; } case TK_SCALING: { @@ -808,7 +803,7 @@ WaitWindowProc(clientData, eventPtr) /* *---------------------------------------------------------------------- * - * Tk_UpdateCmd -- + * Tk_UpdateObjCmd -- * * This procedure is invoked to process the "update" Tcl command. * See the user documentation for details on what it does. @@ -824,28 +819,27 @@ WaitWindowProc(clientData, eventPtr) /* ARGSUSED */ int -Tk_UpdateCmd(clientData, interp, argc, argv) +Tk_UpdateObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int flags; + static char *updateOptions[] = {"idletasks", (char *) NULL}; + int flags, index; TkDisplay *dispPtr; - if (argc == 1) { + if (objc == 1) { flags = TCL_DONT_WAIT; - } else if (argc == 2) { - if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be idletasks", (char *) NULL); + } else if (objc == 2) { + if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } flags = TCL_IDLE_EVENTS; } else { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " ?idletasks?\"", (char *) NULL); + Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); return TCL_ERROR; } @@ -857,12 +851,12 @@ Tk_UpdateCmd(clientData, interp, argc, argv) * Thus, don't use any information from tkwin after calling * Tcl_DoOneEvent. */ - + while (1) { while (Tcl_DoOneEvent(flags) != 0) { /* Empty loop body */ } - for (dispPtr = tkDisplayList; dispPtr != NULL; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XSync(dispPtr->display, False); } @@ -906,10 +900,10 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { int index, x, y, width, height, useX, useY, class, skip; - char buf[128]; char *string; TkWindow *winPtr; Tk_Window tkwin; + Tcl_Obj *resultPtr; static TkStateMap visualMap[] = { {PseudoColor, "pseudocolor"}, @@ -982,85 +976,73 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) } } winPtr = (TkWindow *) tkwin; + resultPtr = Tcl_GetObjResult(interp); switch ((enum options) index) { case WIN_CELLS: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), - Tk_Visual(tkwin)->map_entries); + Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries); break; } case WIN_CHILDREN: { Tcl_Obj *strPtr; - Tcl_ResetResult(interp); winPtr = winPtr->childList; for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) { strPtr = Tcl_NewStringObj(winPtr->pathName, -1); - Tcl_ListObjAppendElement(NULL, - Tcl_GetObjResult(interp), strPtr); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } break; } case WIN_CLASS: { - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Class(tkwin), -1); + Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1); break; } case WIN_COLORMAPFULL: { - Tcl_ResetResult(interp); - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), + Tcl_SetBooleanObj(resultPtr, TkpCmapStressed(tkwin, Tk_Colormap(tkwin))); break; } case WIN_DEPTH: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Depth(tkwin)); + Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin)); break; } case WIN_GEOMETRY: { - Tcl_ResetResult(interp); + 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(Tcl_GetObjResult(interp), buf, -1); + Tcl_SetStringObj(resultPtr, buf, -1); break; } case WIN_HEIGHT: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Height(tkwin)); + Tcl_SetIntObj(resultPtr, Tk_Height(tkwin)); break; } case WIN_ID: { + char buf[TCL_INTEGER_SPACE]; + Tk_MakeWindowExist(tkwin); TkpPrintWindowId(buf, Tk_WindowId(tkwin)); - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1); + Tcl_SetStringObj(resultPtr, buf, -1); break; } case WIN_ISMAPPED: { - Tcl_ResetResult(interp); - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (int) Tk_IsMapped(tkwin)); + Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin)); break; } case WIN_MANAGER: { - Tcl_ResetResult(interp); if (winPtr->geomMgrPtr != NULL) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - winPtr->geomMgrPtr->name, -1); + Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1); } break; } case WIN_NAME: { - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Name(tkwin), -1); + Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1); break; } case WIN_PARENT: { - Tcl_ResetResult(interp); if (winPtr->parentPtr != NULL) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - winPtr->parentPtr->pathName, -1); + Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1); } break; } @@ -1086,80 +1068,66 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) } else { TkGetPointerCoords((Tk_Window) winPtr, &x, &y); } - Tcl_ResetResult(interp); if (useX & useY) { + char buf[TCL_INTEGER_SPACE * 2]; + sprintf(buf, "%d %d", x, y); - Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1); + Tcl_SetStringObj(resultPtr, buf, -1); } else if (useX) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), x); + Tcl_SetIntObj(resultPtr, x); } else { - Tcl_SetIntObj(Tcl_GetObjResult(interp), y); + Tcl_SetIntObj(resultPtr, y); } break; } case WIN_REQHEIGHT: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqHeight(tkwin)); + Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin)); break; } case WIN_REQWIDTH: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqWidth(tkwin)); + Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin)); break; } case WIN_ROOTX: { Tk_GetRootCoords(tkwin, &x, &y); - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), x); + Tcl_SetIntObj(resultPtr, x); break; } case WIN_ROOTY: { Tk_GetRootCoords(tkwin, &x, &y); - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), y); + Tcl_SetIntObj(resultPtr, y); break; } case WIN_SCREEN: { + char buf[TCL_INTEGER_SPACE]; + sprintf(buf, "%d", Tk_ScreenNumber(tkwin)); - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - Tk_DisplayName(tkwin), ".", buf, NULL); + Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".", + buf, NULL); break; } case WIN_SCREENCELLS: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), - CellsOfScreen(Tk_Screen(tkwin))); + Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin))); break; } case WIN_SCREENDEPTH: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), - DefaultDepthOfScreen(Tk_Screen(tkwin))); + Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin))); break; } case WIN_SCREENHEIGHT: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), - HeightOfScreen(Tk_Screen(tkwin))); + Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin))); break; } case WIN_SCREENWIDTH: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), - WidthOfScreen(Tk_Screen(tkwin))); + Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin))); break; } case WIN_SCREENMMHEIGHT: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), - HeightMMOfScreen(Tk_Screen(tkwin))); + Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin))); break; } case WIN_SCREENMMWIDTH: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), - WidthMMOfScreen(Tk_Screen(tkwin))); + Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin))); break; } case WIN_SCREENVISUAL: { @@ -1173,9 +1141,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) case WIN_TOPLEVEL: { winPtr = GetToplevel(tkwin); if (winPtr != NULL) { - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), - winPtr->pathName, -1); + Tcl_SetStringObj(resultPtr, winPtr->pathName, -1); } break; } @@ -1192,8 +1158,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) break; } } - Tcl_ResetResult(interp); - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), viewable); + Tcl_SetBooleanObj(resultPtr, viewable); break; } case WIN_VISUAL: { @@ -1204,54 +1169,47 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) if (string == NULL) { string = "unknown"; } - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), string, -1); + Tcl_SetStringObj(resultPtr, string, -1); break; } case WIN_VISUALID: { - Tcl_ResetResult(interp); + char buf[TCL_INTEGER_SPACE]; + sprintf(buf, "0x%x", (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin))); - Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1); + Tcl_SetStringObj(resultPtr, buf, -1); break; } case WIN_VROOTHEIGHT: { Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), height); + Tcl_SetIntObj(resultPtr, height); break; } case WIN_VROOTWIDTH: { Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), width); + Tcl_SetIntObj(resultPtr, width); break; } case WIN_VROOTX: { Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), x); + Tcl_SetIntObj(resultPtr, x); break; } case WIN_VROOTY: { Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), y); + Tcl_SetIntObj(resultPtr, y); break; } case WIN_WIDTH: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Width(tkwin)); + Tcl_SetIntObj(resultPtr, Tk_Width(tkwin)); break; } case WIN_X: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_X(tkwin)); + Tcl_SetIntObj(resultPtr, Tk_X(tkwin)); break; } case WIN_Y: { - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Y(tkwin)); + Tcl_SetIntObj(resultPtr, Tk_Y(tkwin)); break; } @@ -1270,9 +1228,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) } objv += skip; string = Tcl_GetStringFromObj(objv[2], NULL); - Tcl_ResetResult(interp); - Tcl_SetLongObj(Tcl_GetObjResult(interp), - (long) Tk_InternAtom(tkwin, string)); + Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string)); break; } case WIN_ATOMNAME: { @@ -1291,15 +1247,14 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { return TCL_ERROR; } - Tcl_ResetResult(interp); name = Tk_GetAtomName(tkwin, (Atom) id); if (strcmp(name, "?bad atom?") == 0) { string = Tcl_GetStringFromObj(objv[2], NULL); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + Tcl_AppendStringsToObj(resultPtr, "no atom exists with id \"", string, "\"", NULL); return TCL_ERROR; } - Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1); + Tcl_SetStringObj(resultPtr, name, -1); break; } case WIN_CONTAINING: { @@ -1323,9 +1278,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) } tkwin = Tk_CoordsToWindow(x, y, tkwin); if (tkwin != NULL) { - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), - Tk_PathName(tkwin), -1); + Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); } break; } @@ -1362,9 +1315,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) Tk_IdToWindow(Tk_Display(tkwin), (Window) id); if ((winPtr == NULL) || (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "window id \"", string, + Tcl_AppendStringsToObj(resultPtr, "window id \"", string, "\" doesn't exist in this application", (char *) NULL); return TCL_ERROR; } @@ -1377,9 +1328,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) tkwin = (Tk_Window) winPtr; if (Tk_PathName(tkwin) != NULL) { - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), - Tk_PathName(tkwin), -1); + Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); } break; } @@ -1397,12 +1346,14 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) } string = Tcl_GetStringFromObj(objv[2], NULL); 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_ResetResult(interp); /* clear any error msg */ - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), alive); + Tcl_SetBooleanObj(resultPtr, alive); break; } case WIN_FPIXELS: { @@ -1422,9 +1373,8 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } pixels = mm * WidthOfScreen(Tk_Screen(tkwin)) - / WidthMMOfScreen(Tk_Screen(tkwin)); - Tcl_ResetResult(interp); - Tcl_SetDoubleObj(Tcl_GetObjResult(interp), pixels); + / WidthMMOfScreen(Tk_Screen(tkwin)); + Tcl_SetDoubleObj(resultPtr, pixels); break; } case WIN_PIXELS: { @@ -1443,12 +1393,12 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) { return TCL_ERROR; } - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), pixels); + Tcl_SetIntObj(resultPtr, pixels); break; } case WIN_RGB: { XColor *colorPtr; + char buf[TCL_INTEGER_SPACE * 3]; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "window colorName"); @@ -1467,16 +1417,16 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green, colorPtr->blue); Tk_FreeColor(colorPtr); - Tcl_ResetResult(interp); - Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1); + Tcl_SetStringObj(resultPtr, buf, -1); break; } case WIN_VISUALSAVAILABLE: { XVisualInfo template, *visInfoPtr; int count, i; - char visualIdString[16]; int includeVisualId; Tcl_Obj *strPtr; + char buf[16 + TCL_INTEGER_SPACE]; + char visualIdString[TCL_INTEGER_SPACE]; if (objc == 3) { includeVisualId = 0; @@ -1498,9 +1448,8 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) template.screen = Tk_ScreenNumber(tkwin); visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask, &template, &count); - Tcl_ResetResult(interp); if (visInfoPtr == NULL) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), + Tcl_SetStringObj(resultPtr, "can't find any visuals for screen", -1); return TCL_ERROR; } @@ -1517,8 +1466,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) strcat(buf, visualIdString); } strPtr = Tcl_NewStringObj(buf, -1); - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - strPtr); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } XFree((char *) visInfoPtr); break; diff --git a/generic/tkColor.c b/generic/tkColor.c index 108bf70..e37b331 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -6,63 +6,157 @@ * map color names to pixel values. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkColor.c,v 1.2 1998/09/14 18:23:08 stanton Exp $ + * RCS: @(#) $Id: tkColor.c,v 1.3 1999/04/16 01:51:12 stanton Exp $ */ -#include <tkColor.h> +#include "tkColor.h" /* - * A two-level data structure is used to manage the color database. - * The top level consists of one entry for each color name that is - * currently active, and the bottom level contains one entry for each - * pixel value that is still in use. The distinction between - * levels is necessary because the same pixel may have several - * different names. There are two hash tables, one used to index into - * each of the data structures. The name hash table is used when - * allocating colors, and the pixel hash table is used when freeing - * colors. + * Structures of the following following type are used as keys for + * colorValueTable (in TkDisplay). */ - -/* - * Hash table for name -> TkColor mapping, and key structure used to - * index into that table: - */ - -static Tcl_HashTable nameTable; typedef struct { - Tk_Uid name; /* Name of desired color. */ + int red, green, blue; /* Values for desired color. */ Colormap colormap; /* Colormap from which color will be * allocated. */ Display *display; /* Display for colormap. */ -} NameKey; +} ValueKey; + /* - * Hash table for value -> TkColor mapping, and key structure used to - * index into that table: + * The structure below is used to allocate thread-local data. */ -static Tcl_HashTable valueTable; -typedef struct { - int red, green, blue; /* Values for desired color. */ - Colormap colormap; /* Colormap from which color will be - * allocated. */ - Display *display; /* Display for colormap. */ -} ValueKey; - -static int initialized = 0; /* 0 means static structures haven't been - * initialized yet. */ +typedef struct ThreadSpecificData { + char rgbString[20]; /* */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations for procedures defined in this file: */ -static void ColorInit _ANSI_ARGS_((void)); +static void ColorInit _ANSI_ARGS_((TkDisplay *dispPtr)); +static void DupColorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr, + Tcl_Obj *dupObjPtr)); +static void FreeColorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void InitColorObj _ANSI_ARGS_((Tcl_Obj *objPtr)); + +/* + * The following structure defines the implementation of the "color" Tcl + * object, which maps a string color name to a TkColor object. The + * ptr1 field of the Tcl_Obj points to a TkColor object. + */ + +static Tcl_ObjType colorObjType = { + "color", /* name */ + FreeColorObjProc, /* freeIntRepProc */ + DupColorObjProc, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +/* + *---------------------------------------------------------------------- + * + * Tk_AllocColorFromObj -- + * + * Given a Tcl_Obj *, map the value to a corresponding + * XColor structure based on the tkwin given. + * + * Results: + * The return value is a pointer to an XColor structure that + * indicates the red, blue, and green intensities for the color + * given by the string in objPtr, and also specifies a pixel value + * to use to draw in that color. If an error occurs, NULL is + * returned and an error message will be left in interp's result + * (unless interp is NULL). + * + * Side effects: + * The color is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeColorFromObj so that the database is cleaned up when colors + * aren't in use anymore. + * + *---------------------------------------------------------------------- + */ + +XColor * +Tk_AllocColorFromObj(interp, tkwin, objPtr) + Tcl_Interp *interp; /* Used only for error reporting. If NULL, + * then no messages are provided. */ + Tk_Window tkwin; /* Window in which the color will be used.*/ + Tcl_Obj *objPtr; /* Object that describes the color; string + * value is a color name such as "red" or + * "#ff0000".*/ +{ + TkColor *tkColPtr; + + if (objPtr->typePtr != &colorObjType) { + InitColorObj(objPtr); + } + tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; + + /* + * If the object currently points to a TkColor, see if it's the + * one we want. If so, increment its reference count and return. + */ + + if (tkColPtr != NULL) { + if (tkColPtr->resourceRefCount == 0) { + /* + * This is a stale reference: it refers to a TkColor that's + * no longer in use. Clear the reference. + */ + + FreeColorObjProc(objPtr); + tkColPtr = NULL; + } else if ((Tk_Screen(tkwin) == tkColPtr->screen) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + tkColPtr->resourceRefCount++; + return (XColor *) tkColPtr; + } + } + + /* + * The object didn't point to the TkColor that we wanted. Search + * the list of TkColors with the same name to see if one of the + * other TkColors is the right one. + */ + + if (tkColPtr != NULL) { + TkColor *firstColorPtr = + (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr); + FreeColorObjProc(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; + return (XColor *) tkColPtr; + } + } + } + + /* + * Still no luck. Call Tk_GetColor to allocate a new TkColor object. + */ + + tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr)); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr; + if (tkColPtr != NULL) { + tkColPtr->objRefCount++; + } + return (XColor *) tkColPtr; +} /* *---------------------------------------------------------------------- @@ -77,7 +171,7 @@ static void ColorInit _ANSI_ARGS_((void)); * indicates the red, blue, and green intensities for the color * given by "name", and also specifies a pixel value to use to * draw in that color. If an error occurs, NULL is returned and - * an error message will be left in interp->result. + * an error message will be left in the interp's result. * * Side effects: * The color is added to an internal database with a reference count. @@ -93,17 +187,17 @@ Tk_GetColor(interp, tkwin, name) Tcl_Interp *interp; /* Place to leave error message if * color can't be found. */ Tk_Window tkwin; /* Window in which color will be used. */ - Tk_Uid name; /* Name of color to allocated (in form + char *name; /* Name of color to be allocated (in form * suitable for passing to XParseColor). */ { - NameKey nameKey; Tcl_HashEntry *nameHashPtr; int new; TkColor *tkColPtr; - Display *display = Tk_Display(tkwin); + TkColor *existingColPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - ColorInit(); + if (!dispPtr->colorInit) { + ColorInit(dispPtr); } /* @@ -111,14 +205,19 @@ Tk_GetColor(interp, tkwin, name) * name. */ - nameKey.name = name; - nameKey.colormap = Tk_Colormap(tkwin); - nameKey.display = display; - nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new); + nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &new); if (!new) { - tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr); - tkColPtr->refCount++; - return &tkColPtr->color; + existingColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr); + for (tkColPtr = existingColPtr; tkColPtr != NULL; + tkColPtr = tkColPtr->nextPtr) { + if ((tkColPtr->screen == Tk_Screen(tkwin)) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + tkColPtr->resourceRefCount++; + return &tkColPtr->color; + } + } + } else { + existingColPtr = NULL; } /* @@ -137,22 +236,27 @@ Tk_GetColor(interp, tkwin, name) "\"", (char *) NULL); } } - Tcl_DeleteHashEntry(nameHashPtr); + if (new) { + Tcl_DeleteHashEntry(nameHashPtr); + } return (XColor *) NULL; } /* - * Now create a new TkColor structure and add it to nameTable. + * Now create a new TkColor structure and add it to colorNameTable + * (in TkDisplay). */ tkColPtr->magic = COLOR_MAGIC; tkColPtr->gc = None; tkColPtr->screen = Tk_Screen(tkwin); - tkColPtr->colormap = nameKey.colormap; + tkColPtr->colormap = Tk_Colormap(tkwin); tkColPtr->visual = Tk_Visual(tkwin); - tkColPtr->refCount = 1; - tkColPtr->tablePtr = &nameTable; + tkColPtr->resourceRefCount = 1; + tkColPtr->objRefCount = 0; + tkColPtr->tablePtr = &dispPtr->colorNameTable; tkColPtr->hashPtr = nameHashPtr; + tkColPtr->nextPtr = existingColPtr; Tcl_SetHashValue(nameHashPtr, tkColPtr); return &tkColPtr->color; @@ -193,9 +297,10 @@ Tk_GetColorByValue(tkwin, colorPtr) int new; TkColor *tkColPtr; Display *display = Tk_Display(tkwin); + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { - ColorInit(); + if (!dispPtr->colorInit) { + ColorInit(dispPtr); } /* @@ -208,16 +313,17 @@ Tk_GetColorByValue(tkwin, colorPtr) valueKey.blue = colorPtr->blue; valueKey.colormap = Tk_Colormap(tkwin); valueKey.display = display; - valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new); + valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable, + (char *) &valueKey, &new); if (!new) { tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr); - tkColPtr->refCount++; + tkColPtr->resourceRefCount++; return &tkColPtr->color; } /* * The name isn't currently known. Find a pixel value for this - * color and add a new structure to valueTable. + * color and add a new structure to colorValueTable (in TkDisplay). */ tkColPtr = TkpGetColorByValue(tkwin, colorPtr); @@ -226,9 +332,11 @@ Tk_GetColorByValue(tkwin, colorPtr) tkColPtr->screen = Tk_Screen(tkwin); tkColPtr->colormap = valueKey.colormap; tkColPtr->visual = Tk_Visual(tkwin); - tkColPtr->refCount = 1; - tkColPtr->tablePtr = &valueTable; + tkColPtr->resourceRefCount = 1; + tkColPtr->objRefCount = 0; + tkColPtr->tablePtr = &dispPtr->colorValueTable; tkColPtr->hashPtr = valueHashPtr; + tkColPtr->nextPtr = NULL; Tcl_SetHashValue(valueHashPtr, tkColPtr); return &tkColPtr->color; } @@ -260,15 +368,15 @@ Tk_NameOfColor(colorPtr) XColor *colorPtr; /* Color whose name is desired. */ { register TkColor *tkColPtr = (TkColor *) colorPtr; - static char string[20]; - - if ((tkColPtr->magic == COLOR_MAGIC) - && (tkColPtr->tablePtr == &nameTable)) { - return ((NameKey *) tkColPtr->hashPtr->key.words)->name; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tkColPtr->magic == COLOR_MAGIC) { + return tkColPtr->hashPtr->key.string; } - sprintf(string, "#%04x%04x%04x", colorPtr->red, colorPtr->green, - colorPtr->blue); - return string; + sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, + colorPtr->green, colorPtr->blue); + return tsdPtr->rgbString; } /* @@ -347,8 +455,9 @@ Tk_FreeColor(colorPtr) * allocated by Tk_GetColor or * Tk_GetColorByValue. */ { - register TkColor *tkColPtr = (TkColor *) colorPtr; + TkColor *tkColPtr = (TkColor *) colorPtr; Screen *screen = tkColPtr->screen; + TkColor *prevPtr; /* * Do a quick sanity check to make sure this color was really @@ -359,15 +468,45 @@ Tk_FreeColor(colorPtr) panic("Tk_FreeColor called with bogus color"); } - tkColPtr->refCount--; - if (tkColPtr->refCount == 0) { - if (tkColPtr->gc != None) { - XFreeGC(DisplayOfScreen(screen), tkColPtr->gc); - tkColPtr->gc = None; + tkColPtr->resourceRefCount--; + if (tkColPtr->resourceRefCount > 0) { + return; + } + + /* + * This color is no longer being actively used, so free the color + * resources associated with it and remove it from the hash table. + * no longer any objects referencing it. + */ + + if (tkColPtr->gc != None) { + XFreeGC(DisplayOfScreen(screen), tkColPtr->gc); + tkColPtr->gc = None; + } + TkpFreeColor(tkColPtr); + + prevPtr = (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr); + if (prevPtr == tkColPtr) { + if (tkColPtr->nextPtr == NULL) { + Tcl_DeleteHashEntry(tkColPtr->hashPtr); + } else { + Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr); + } + } else { + while (prevPtr->nextPtr != tkColPtr) { + prevPtr = prevPtr->nextPtr; } - TkpFreeColor(tkColPtr); - Tcl_DeleteHashEntry(tkColPtr->hashPtr); - tkColPtr->magic = 0; + prevPtr->nextPtr = tkColPtr->nextPtr; + } + + /* + * Free the TkColor structure if there are no objects referencing + * it. However, if there are objects referencing it then keep the + * structure around; it will get freed when the last reference is + * cleared + */ + + if (tkColPtr->objRefCount == 0) { ckfree((char *) tkColPtr); } } @@ -375,6 +514,223 @@ Tk_FreeColor(colorPtr) /* *---------------------------------------------------------------------- * + * Tk_FreeColorFromObj -- + * + * This procedure is called to release a color allocated by + * Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *; + * it only gets rid of the hash table entry for this color + * and clears the cached value that is normally stored in the object. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with the color represented by + * objPtr is decremented, and the color is released to X if there are + * no remaining uses for it. + * + *---------------------------------------------------------------------- + */ + +void +Tk_FreeColorFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window this color lives in. Needed + * for the screen and colormap values. */ + Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */ +{ + Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr)); +} + +/* + *--------------------------------------------------------------------------- + * + * FreeColorObjProc -- + * + * 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 needs to be changed. + * + * Results: + * None. + * + * Side effects: + * The object reference count is decremented. When both it + * and the hash ref count go to zero, the color's resources + * are released. + * + *--------------------------------------------------------------------------- + */ + +static void +FreeColorObjProc(objPtr) + Tcl_Obj *objPtr; /* The object we are releasing. */ +{ + TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; + + if (tkColPtr != NULL) { + tkColPtr->objRefCount--; + if ((tkColPtr->objRefCount == 0) + && (tkColPtr->resourceRefCount == 0)) { + ckfree((char *) tkColPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; + } +} + +/* + *--------------------------------------------------------------------------- + * + * DupColorObjProc -- + * + * When a cached color object is duplicated, this is called to + * update the internal reps. + * + * Results: + * None. + * + * Side effects: + * The color's objRefCount is incremented and the internal rep + * of the copy is set to point to it. + * + *--------------------------------------------------------------------------- + */ + +static void +DupColorObjProc(srcObjPtr, dupObjPtr) + 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; + + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr; + + if (tkColPtr != NULL) { + tkColPtr->objRefCount++; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tk_GetColorFromObj -- + * + * Returns the color referred to by a Tcl object. The color must + * already have been allocated via a call to Tk_AllocColorFromObj + * or Tk_GetColor. + * + * Results: + * Returns the XColor * that matches the tkwin and the string rep + * of objPtr. + * + * Side effects: + * If the object is not already a color, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +XColor * +Tk_GetColorFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window in which the color will be + * used. */ + Tcl_Obj *objPtr; /* String value contains the name of the + * desired color. */ +{ + TkColor *tkColPtr; + Tcl_HashEntry *hashPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + if (objPtr->typePtr != &colorObjType) { + InitColorObj(objPtr); + } + + tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; + if (tkColPtr != NULL) { + if ((tkColPtr->resourceRefCount > 0) + && (Tk_Screen(tkwin) == tkColPtr->screen) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + /* + * The object already points to the right TkColor structure. + * Just return it. + */ + + return (XColor *) tkColPtr; + } + hashPtr = tkColPtr->hashPtr; + FreeColorObjProc(objPtr); + } else { + hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, + Tcl_GetString(objPtr)); + if (hashPtr == NULL) { + goto error; + } + } + + /* + * At this point we've got a hash table entry, off of which hang + * one or more TkColor structures. See if any of them will work. + */ + + for (tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr); + (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { + if ((Tk_Screen(tkwin) == tkColPtr->screen) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr; + tkColPtr->objRefCount++; + return (XColor *) tkColPtr; + } + } + + error: + panic(" Tk_GetColorFromObj called with non-existent color!"); + /* + * The following code isn't reached; it's just there to please compilers. + */ + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * InitColorObj -- + * + * Bookeeping procedure to change an objPtr to a color type. + * + * Results: + * None. + * + * Side effects: + * The old internal rep of the object is freed. The object's + * type is set to color with a NULL TkColor pointer (the pointer + * will be set later by either Tk_AllocColorFromObj or + * Tk_GetColorFromObj). + * + *---------------------------------------------------------------------- + */ + +static void +InitColorObj(objPtr) + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + + /* + * Free the old internalRep before setting the new one. + */ + + Tcl_GetString(objPtr); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &colorObjType; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; +} + +/* + *---------------------------------------------------------------------- + * * ColorInit -- * * Initialize the structure used for color management. @@ -389,9 +745,62 @@ Tk_FreeColor(colorPtr) */ static void -ColorInit() +ColorInit(dispPtr) + TkDisplay *dispPtr; +{ + if (!dispPtr->colorInit) { + dispPtr->colorInit = 1; + Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&dispPtr->colorValueTable, + sizeof(ValueKey)/sizeof(int)); + } +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugColor -- + * + * This procedure returns debugging information about a color. + * + * Results: + * The return value is a list with one sublist for each TkColor + * corresponding to "name". Each sublist has two elements that + * contain the resourceRefCount and objRefCount fields from the + * TkColor structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkDebugColor(tkwin, name) + Tk_Window tkwin; /* The window in which the color will be + * used (not currently used). */ + char *name; /* Name of the desired color. */ { - initialized = 1; - Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int)); - Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int)); + TkColor *tkColPtr; + Tcl_HashEntry *hashPtr; + Tcl_Obj *resultPtr, *objPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + resultPtr = Tcl_NewObj(); + hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name); + if (hashPtr != NULL) { + tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr); + if (tkColPtr == NULL) { + panic("TkDebugColor found empty hash table entry"); + } + for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(tkColPtr->resourceRefCount)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(tkColPtr->objRefCount)); + Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); + } + } + return resultPtr; } diff --git a/generic/tkColor.h b/generic/tkColor.h index 8aa2e59..7e1ab3b 100644 --- a/generic/tkColor.h +++ b/generic/tkColor.h @@ -4,12 +4,12 @@ * Declarations of data types and functions used by the * Tk color module. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkColor.h,v 1.4 1998/09/14 18:23:08 stanton Exp $ + * RCS: @(#) $Id: tkColor.h,v 1.5 1999/04/16 01:51:12 stanton Exp $ */ #ifndef _TKCOLOR @@ -24,8 +24,8 @@ /* * One of the following data structures is used to keep track of - * each color that the color module has allocated from the X display - * server. + * each color that is being used by the application; typically there + * is a colormap entry allocated for each of these colors. */ #define COLOR_MAGIC ((unsigned int) 0x46140277) @@ -43,11 +43,30 @@ typedef struct TkColor { Colormap colormap; /* Colormap from which this entry was * allocated. */ Visual *visual; /* Visual associated with colormap. */ - int refCount; /* Number of uses of this structure. */ + int resourceRefCount; /* Number of active uses of this color (each + * active use corresponds to a call to + * Tk_AllocColorFromObj or Tk_GetColor). + * If this count is 0, then this TkColor + * structure is no longer valid and it isn't + * present in a hash table: it is being + * kept around only because there are objects + * referring to it. The structure is freed + * when resourceRefCount and objRefCount + * are both 0. */ + int objRefCount; /* The number of Tcl objects that reference + * this structure. */ Tcl_HashTable *tablePtr; /* Hash table that indexes this structure * (needed when deleting structure). */ Tcl_HashEntry *hashPtr; /* Pointer to hash table entry for this * structure. (for use in deleting entry). */ + struct TkColor *nextPtr; /* Points to the next TkColor structure with + * the same color name. Colors with the + * same name but different screens or + * colormaps are chained together off a + * single entry in nameTable. For colors in + * valueTable (those allocated by + * Tk_GetColorByValue) this field is always + * NULL. */ } TkColor; /* diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 9714feb..0b78f4a 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -1,579 +1,1630 @@ /* * tkConfig.c -- * - * This file contains the Tk_ConfigureWidget procedure. + * This file contains procedures that manage configuration options + * for widgets and other things. * - * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1997-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. * - * RCS: @(#) $Id: tkConfig.c,v 1.2 1998/09/14 18:23:08 stanton Exp $ + * RCS: @(#) $Id: tkConfig.c,v 1.3 1999/04/16 01:51:12 stanton Exp $ */ -#include "tkPort.h" +/* + * Temporary flag for working on new config package. + */ + +#if 0 + +/* + * used only for removing the old config code + */ + +#define __NO_OLD_CONFIG +#endif + #include "tk.h" +#include "tkInt.h" +#include "tkPort.h" +#include "tkFont.h" /* - * Values for "flags" field of Tk_ConfigSpec structures. Be sure - * to coordinate these values with those defined in tk.h - * (TK_CONFIG_COLOR_ONLY, etc.). There must not be overlap! + * The following definition is an AssocData key used to keep track of + * all of the option tables that have been created for an interpreter. + */ + +#define OPTION_HASH_KEY "TkOptionTable" + +/* + * The following two structures are used along with Tk_OptionSpec + * structures to manage configuration options. Tk_OptionSpecs are + * static templates that are compiled into the code of a widget + * or other object manager. However, to look up options efficiently + * we need to supplement the static information with additional + * dynamic information, and this dynamic information may be different + * for each application. Thus we create structures of the following + * two types to hold all of the dynamic information; this is done + * by Tk_CreateOptionTable. + * + * One of the following structures corresponds to each Tk_OptionSpec. + * These structures exist as arrays inside TkOptionTable structures. + */ + +typedef struct TkOption { + CONST Tk_OptionSpec *specPtr; /* The original spec from the template + * passed to Tk_CreateOptionTable.*/ + Tk_Uid dbNameUID; /* The Uid form of the option database + * name. */ + Tk_Uid dbClassUID; /* The Uid form of the option database + * class name. */ + Tcl_Obj *defaultPtr; /* Default value for this option. */ + union { + Tcl_Obj *monoColorPtr; /* For color and border options, this + * is an alternate default value to + * use on monochrome displays. */ + struct TkOption *synonymPtr; /* For synonym options, this points to + * the master entry. */ + } extra; + int flags; /* Miscellaneous flag values; see + * below for definitions. */ +} Option; + +/* + * Flag bits defined for Option structures: * - * INIT - Non-zero means (char *) things have been - * converted to Tk_Uid's. + * OPTION_NEEDS_FREEING - 1 means that FreeResources must be + * invoke to free resources associated with + * the option when it is no longer needed. */ -#define INIT 0x20 +#define OPTION_NEEDS_FREEING 1 + +/* + * One of the following exists for each Tk_OptionSpec array that has + * been passed to Tk_CreateOptionTable. + */ + +typedef struct OptionTable { + int refCount; /* Counts the number of uses of this + * table (the number of times + * Tk_CreateOptionTable has returned + * it). This can be greater than 1 if + * it is shared along several option + * table chains, or if the same table + * is used for multiple purposes. */ + Tcl_HashEntry *hashEntryPtr; /* Hash table entry that refers to this + * table; used to delete the entry. */ + struct OptionTable *nextPtr; /* If templatePtr was part of a chain + * of templates, this points to the + * table corresponding to the next + * template in the chain. */ + int numOptions; /* The number of items in the options + * array below. */ + Option options[1]; /* Information about the individual + * options in the table. This must be + * the last field in the structure: + * the actual size of the array will + * be numOptions, not 1. */ +} OptionTable; /* * Forward declarations for procedures defined later in this file: */ -static int DoConfig _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specPtr, - Tk_Uid value, int valueIsUid, char *widgRec)); -static Tk_ConfigSpec * FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp, - Tk_ConfigSpec *specs, char *argvName, - int needFlags, int hateFlags)); -static char * FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specPtr, - char *widgRec)); -static char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specPtr, - char *widgRec, char *buffer, - Tcl_FreeProc **freeProcPtr)); +static int DoObjConfig _ANSI_ARGS_((Tcl_Interp *interp, + char *recordPtr, Option *optionPtr, + Tcl_Obj *valuePtr, Tk_Window tkwin, + Tk_SavedOption *savePtr)); +static void DestroyOptionHashTable _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp)); +static void FreeResources _ANSI_ARGS_((Option *optionPtr, + Tcl_Obj *objPtr, char *internalPtr, + Tk_Window tkwin)); +static Tcl_Obj * GetConfigList _ANSI_ARGS_((char *recordPtr, + Option *optionPtr, Tk_Window tkwin)); +static Tcl_Obj * GetObjectForOption _ANSI_ARGS_((char *recordPtr, + Option *optionPtr, Tk_Window tkwin)); +static Option * GetOptionFromObj _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr, OptionTable *tablePtr)); +static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr)); +static int SetOptionFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); + +/* + * The structure below defines an object type that is used to cache the + * result of looking up an option name. If an object has this type, then + * its internalPtr1 field points to the OptionTable in which it was looked up, + * and the internalPtr2 field points to the entry that matched. + */ + +Tcl_ObjType optionType = { + "option", /* name */ + (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ + (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ + (Tcl_UpdateStringProc *) NULL, /* updateStringProc */ + SetOptionFromAny /* setFromAnyProc */ +}; /* *-------------------------------------------------------------- * - * Tk_ConfigureWidget -- + * Tk_CreateOptionTable -- * - * Process command-line options and database options to - * fill in fields of a widget record with resources and - * other parameters. + * Given a template for configuration options, this procedure + * creates a table that may be used to look up options efficiently. * * Results: - * A standard Tcl return value. In case of an error, - * interp->result will hold an error message. + * Returns a token to a structure that can be passed to procedures + * such as Tk_InitOptions, Tk_SetOptions, and Tk_FreeConfigOptions. * * Side effects: - * The fields of widgRec get filled in with information - * from argc/argv and the option database. Old information - * in widgRec's fields gets recycled. + * Storage is allocated. * *-------------------------------------------------------------- */ -int -Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags) - 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. */ - int argc; /* Number of elements in argv. */ - 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 be present in config specs - * for them to be considered. Also, - * may have TK_CONFIG_ARGV_ONLY set. */ +Tk_OptionTable +Tk_CreateOptionTable(interp, templatePtr) + Tcl_Interp *interp; /* Interpreter associated with the + * application in which this table + * will be used. */ + CONST Tk_OptionSpec *templatePtr; /* Static information about the + * configuration options. */ { - register Tk_ConfigSpec *specPtr; - Tk_Uid value; /* Value of option from database. */ - int needFlags; /* Specs must contain this set of flags - * or else they are not considered. */ - int hateFlags; /* If a spec contains any bits here, it's - * not considered. */ - - needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); - if (Tk_Depth(tkwin) <= 1) { - hateFlags = TK_CONFIG_COLOR_ONLY; - } else { - hateFlags = TK_CONFIG_MONO_ONLY; + Tcl_HashTable *hashTablePtr; + Tcl_HashEntry *hashEntryPtr; + int newEntry; + OptionTable *tablePtr; + CONST Tk_OptionSpec *specPtr, *specPtr2; + Option *optionPtr; + int numOptions, i; + + /* + * 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 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); } /* - * Pass one: scan through all the option specs, replacing strings - * with Tk_Uids (if this hasn't been done already) and clearing - * the TK_CONFIG_OPTION_SPECIFIED flags. + * See if a table has already been created for this template. If + * so, just reuse the existing table. */ - for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { - if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) { + hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr, + &newEntry); + if (!newEntry) { + tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); + tablePtr->refCount++; + return (Tk_OptionTable) tablePtr; + } + + /* + * Count the number of options in the template, then create the + * table structure. + */ + + numOptions = 0; + for (specPtr = templatePtr; specPtr->type != TK_OPTION_END; specPtr++) { + numOptions++; + } + tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable) + + ((numOptions - 1) * sizeof(Option)))); + tablePtr->refCount = 1; + tablePtr->hashEntryPtr = hashEntryPtr; + tablePtr->nextPtr = NULL; + tablePtr->numOptions = numOptions; + + /* + * Initialize all of the Option structures in the table. + */ + + for (specPtr = templatePtr, optionPtr = tablePtr->options; + specPtr->type != TK_OPTION_END; specPtr++, optionPtr++) { + optionPtr->specPtr = specPtr; + optionPtr->dbNameUID = NULL; + optionPtr->dbClassUID = NULL; + optionPtr->defaultPtr = NULL; + optionPtr->extra.monoColorPtr = NULL; + optionPtr->flags = 0; + + if (specPtr->type == TK_OPTION_SYNONYM) { + /* + * This is a synonym option; find the master option that it + * refers to and create a pointer from the synonym to the + * master. + */ + + for (specPtr2 = templatePtr, i = 0; ; specPtr2++, i++) { + if (specPtr2->type == TK_OPTION_END) { + panic("Tk_CreateOptionTable couldn't find synonym"); + } + if (strcmp(specPtr2->optionName, + (char *) specPtr->clientData) == 0) { + optionPtr->extra.synonymPtr = tablePtr->options + i; + break; + } + } + } else { if (specPtr->dbName != NULL) { - specPtr->dbName = Tk_GetUid(specPtr->dbName); + optionPtr->dbNameUID = Tk_GetUid(specPtr->dbName); } if (specPtr->dbClass != NULL) { - specPtr->dbClass = Tk_GetUid(specPtr->dbClass); + optionPtr->dbClassUID = + Tk_GetUid(specPtr->dbClass); } if (specPtr->defValue != NULL) { - specPtr->defValue = Tk_GetUid(specPtr->defValue); + optionPtr->defaultPtr = + Tcl_NewStringObj(specPtr->defValue, -1); + Tcl_IncrRefCount(optionPtr->defaultPtr); + } + if (((specPtr->type == TK_OPTION_COLOR) + || (specPtr->type == TK_OPTION_BORDER)) + && (specPtr->clientData != NULL)) { + optionPtr->extra.monoColorPtr = + Tcl_NewStringObj((char *) specPtr->clientData, -1); + Tcl_IncrRefCount(optionPtr->extra.monoColorPtr); } } - specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED) - | INIT; + if (((specPtr->type == TK_OPTION_STRING) + && (specPtr->internalOffset >= 0)) + || (specPtr->type == TK_OPTION_COLOR) + || (specPtr->type == TK_OPTION_FONT) + || (specPtr->type == TK_OPTION_BITMAP) + || (specPtr->type == TK_OPTION_BORDER) + || (specPtr->type == TK_OPTION_CURSOR)) { + optionPtr->flags |= OPTION_NEEDS_FREEING; + } } + tablePtr->hashEntryPtr = hashEntryPtr; + Tcl_SetHashValue(hashEntryPtr, tablePtr); /* - * Pass two: scan through all of the arguments, processing those - * that match entries in the specs. + * Finally, check to see if this template chains to another template + * with additional options. If so, call ourselves recursively to + * create the next table(s). */ - for ( ; argc > 0; argc -= 2, argv += 2) { - specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags); - if (specPtr == NULL) { - return TCL_ERROR; + if (specPtr->clientData != NULL) { + tablePtr->nextPtr = (OptionTable *) Tk_CreateOptionTable(interp, + (Tk_OptionSpec *) specPtr->clientData); + } + + return (Tk_OptionTable) tablePtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_DeleteOptionTable -- + * + * Called to release resources used by an option table when + * the table is no longer needed. + * + * Results: + * None. + * + * Side effects: + * The option table and associated resources (such as additional + * option tables chained off it) are destroyed. + * + *---------------------------------------------------------------------- + */ + +void +Tk_DeleteOptionTable(optionTable) + Tk_OptionTable optionTable; /* The option table to delete. */ +{ + OptionTable *tablePtr = (OptionTable *) optionTable; + Option *optionPtr; + int count; + + tablePtr->refCount--; + if (tablePtr->refCount > 0) { + return; + } + + if (tablePtr->nextPtr != NULL) { + Tk_DeleteOptionTable((Tk_OptionTable) tablePtr->nextPtr); + } + + for (count = tablePtr->numOptions - 1, optionPtr = tablePtr->options; + count > 0; count--, optionPtr++) { + if (optionPtr->defaultPtr != NULL) { + Tcl_DecrRefCount(optionPtr->defaultPtr); } + if (((optionPtr->specPtr->type == TK_OPTION_COLOR) + || (optionPtr->specPtr->type == TK_OPTION_BORDER)) + && (optionPtr->extra.monoColorPtr != NULL)) { + Tcl_DecrRefCount(optionPtr->extra.monoColorPtr); + } + } + Tcl_DeleteHashEntry(tablePtr->hashEntryPtr); + ckfree((char *) tablePtr); +} + +/* + *---------------------------------------------------------------------- + * + * DestroyOptionHashTable -- + * + * This procedure 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, interp) + 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); /* - * Process the entry. + * 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). */ - if (argc < 2) { - Tcl_AppendResult(interp, "value for \"", *argv, - "\" missing", (char *) NULL); - return TCL_ERROR; - } - if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) { - char msg[100]; + tablePtr->refCount = 1; + tablePtr->nextPtr = NULL; + Tk_DeleteOptionTable((Tk_OptionTable) tablePtr); + } + Tcl_DeleteHashTable(hashTablePtr); + ckfree((char *) hashTablePtr); +} + +/* + *-------------------------------------------------------------- + * + * Tk_InitOptions -- + * + * This procedure is invoked when an object such as a widget + * is created. It supplies an initial value for each configuration + * option (the value may come from the option database, a system + * default, or the default in the option table). + * + * Results: + * The return value is TCL_OK if the procedure completed + * successfully, and TCL_ERROR if one of the initial values was + * bogus. If an error occurs and interp isn't NULL, then an + * error message will be left in its result. + * + * Side effects: + * Fields of recordPtr are filled in with initial values. + * + *-------------------------------------------------------------- + */ - sprintf(msg, "\n (processing \"%.40s\" option)", - specPtr->argvName); - Tcl_AddErrorInfo(interp, msg); +int +Tk_InitOptions(interp, recordPtr, optionTable, tkwin) + Tcl_Interp *interp; /* Interpreter for error reporting. NULL + * means don't leave an error message. */ + char *recordPtr; /* Pointer to the record to configure. + * Note: the caller should have properly + * initialized the record with NULL + * pointers for each option value. */ + Tk_OptionTable optionTable; /* The token which matches the config + * specs for the widget in question. */ + Tk_Window tkwin; /* Certain options types (such as + * TK_OPTION_COLOR) need fields out + * of the window they are used in to + * be able to calculate their values. + * Not needed unless one of these + * options is in the configSpecs record. */ +{ + OptionTable *tablePtr = (OptionTable *) optionTable; + Option *optionPtr; + int count; + char *value; + Tcl_Obj *valuePtr; + enum { + OPTION_DATABASE, SYSTEM_DEFAULT, TABLE_DEFAULT + } source; + + /* + * If this table chains to other tables, handle their initialization + * first. That way, if both tables refer to the same field of the + * record, the value in the first table will win. + */ + + if (tablePtr->nextPtr != NULL) { + if (Tk_InitOptions(interp, recordPtr, + (Tk_OptionTable) tablePtr->nextPtr, tkwin) != TCL_OK) { return TCL_ERROR; } - specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED; } /* - * Pass three: scan through all of the specs again; if no - * command-line argument matched a spec, then check for info - * in the option database. If there was nothing in the - * database, then use the default. + * Iterate over all of the options in the table, initializing each in + * turn. */ - if (!(flags & TK_CONFIG_ARGV_ONLY)) { - for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { - if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED) - || (specPtr->argvName == NULL) - || (specPtr->type == TK_CONFIG_SYNONYM)) { - continue; + for (optionPtr = tablePtr->options, count = tablePtr->numOptions; + count > 0; optionPtr++, count--) { + + if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) { + continue; + } + source = TABLE_DEFAULT; + + /* + * We look in three places for the initial value, using the first + * non-NULL value that we find. First, check the option database. + */ + + valuePtr = NULL; + if (optionPtr->dbNameUID != NULL) { + value = Tk_GetOption(tkwin, optionPtr->dbNameUID, + optionPtr->dbClassUID); + if (value != NULL) { + valuePtr = Tcl_NewStringObj(value, -1); + source = OPTION_DATABASE; } - if (((specPtr->specFlags & needFlags) != needFlags) - || (specPtr->specFlags & hateFlags)) { - continue; + } + + /* + * Second, check for a system-specific default value. + */ + + if ((valuePtr == NULL) + && (optionPtr->dbNameUID != NULL)) { + valuePtr = TkpGetSystemDefault(tkwin, optionPtr->dbNameUID, + optionPtr->dbClassUID); + if (valuePtr != NULL) { + source = SYSTEM_DEFAULT; } - value = NULL; - if (specPtr->dbName != NULL) { - value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass); + } + + /* + * Third and last, use the default value supplied by the option + * table. In the case of color objects, we pick one of two + * values depending on whether the screen is mono or color. + */ + + if (valuePtr == NULL) { + if ((tkwin != NULL) + && ((optionPtr->specPtr->type == TK_OPTION_COLOR) + || (optionPtr->specPtr->type == TK_OPTION_BORDER)) + && (Tk_Depth(tkwin) <= 1) + && (optionPtr->extra.monoColorPtr != NULL)) { + valuePtr = optionPtr->extra.monoColorPtr; + } else { + valuePtr = optionPtr->defaultPtr; } - if (value != NULL) { - if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != - TCL_OK) { - char msg[200]; + } + + if (valuePtr == NULL) { + continue; + } + + if (DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, + (Tk_SavedOption *) NULL) != TCL_OK) { + if (interp != NULL) { + char msg[200]; - sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", - "database entry for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); - return TCL_ERROR; + switch (source) { + case OPTION_DATABASE: + sprintf(msg, "\n (database entry for \"%.50s\")", + optionPtr->specPtr->optionName); + break; + case SYSTEM_DEFAULT: + sprintf(msg, "\n (system default for \"%.50s\")", + optionPtr->specPtr->optionName); + break; + case TABLE_DEFAULT: + sprintf(msg, "\n (default value for \"%.50s\")", + optionPtr->specPtr->optionName); } - } else { - value = specPtr->defValue; - if ((value != NULL) && !(specPtr->specFlags - & TK_CONFIG_DONT_SET_DEFAULT)) { - if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != - TCL_OK) { - char msg[200]; - - sprintf(msg, - "\n (%s \"%.50s\" in widget \"%.50s\")", - "default value for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); - return TCL_ERROR; - } + if (tkwin != NULL) { + sprintf(msg + strlen(msg) - 1, " in widget \"%.50s\")", + Tk_PathName(tkwin)); } + Tcl_AddErrorInfo(interp, msg); } + return TCL_ERROR; } } - return TCL_OK; } /* *-------------------------------------------------------------- * - * FindConfigSpec -- + * DoObjConfig -- * - * Search through a table of configuration specs, looking for - * one that matches a given argvName. + * This procedure applies a new value for a configuration option + * to the record being configured. * * Results: - * The return value is a pointer to the matching entry, or NULL - * if nothing matched. In that case an error message is left - * in interp->result. + * The return value is TCL_OK if the procedure completed + * successfully. If an error occurred then TCL_ERROR is + * returned and an error message is left in interp's result, if + * interp isn't NULL. In addition, if oldValuePtrPtr isn't + * NULL then it *oldValuePtrPtr is filled in with a pointer + * to the option's old value. * * Side effects: - * None. + * RecordPtr gets modified to hold the new value in the form of + * a Tcl_Obj, an internal representation, or both. The old + * value is freed if oldValuePtrPtr is NULL. * *-------------------------------------------------------------- */ -static Tk_ConfigSpec * -FindConfigSpec(interp, specs, argvName, needFlags, hateFlags) - Tcl_Interp *interp; /* Used for reporting errors. */ - Tk_ConfigSpec *specs; /* Pointer to table of configuration - * specifications for a widget. */ - char *argvName; /* Name (suitable for use in a "config" - * command) identifying particular option. */ - int needFlags; /* Flags that must be present in matching - * entry. */ - int hateFlags; /* Flags that must NOT be present in - * matching entry. */ +static int +DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, savedOptionPtr) + Tcl_Interp *interp; /* Interpreter for error reporting. If + * NULL, then no message is left if an error + * occurs. */ + char *recordPtr; /* The record to modify to hold the new + * option value. */ + Option *optionPtr; /* Pointer to information about the + * option. */ + Tcl_Obj *valuePtr; /* New value for option. */ + Tk_Window tkwin; /* Window in which option will be used (needed + * to allocate resources for some options). + * May be NULL if the option doesn't + * require window-related resources. */ + Tk_SavedOption *savedOptionPtr; + /* If NULL, the old value for the option will + * be freed. If non-NULL, the old value will + * be stored here, and it becomes the property + * of the caller (the caller must eventually + * free the old value). */ { - register Tk_ConfigSpec *specPtr; - register char c; /* First character of current argument. */ - Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */ - size_t length; - - c = argvName[1]; - length = strlen(argvName); - matchPtr = NULL; - for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { - if (specPtr->argvName == NULL) { - continue; + Tcl_Obj **slotPtrPtr, *oldPtr; + char *internalPtr; /* Points to location in record where + * internal representation of value should + * be stored, or NULL. */ + char *oldInternalPtr; /* Points to location in which to save old + * internal representation of value. */ + Tk_SavedOption internal; /* Used to save the old internal representation + * of the value if savedOptionPtr is NULL. */ + CONST Tk_OptionSpec *specPtr; + int nullOK; + + /* + * Save the old object form for the value, if there is one. + */ + + specPtr = optionPtr->specPtr; + if (specPtr->objOffset >= 0) { + slotPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset); + oldPtr = *slotPtrPtr; + } else { + slotPtrPtr = NULL; + oldPtr = NULL; + } + + /* + * Apply the new value in a type-specific way. Also remember the + * old object and internal forms, if they exist. + */ + + if (specPtr->internalOffset >= 0) { + internalPtr = recordPtr + specPtr->internalOffset; + } else { + internalPtr = NULL; + } + if (savedOptionPtr != NULL) { + savedOptionPtr->optionPtr = optionPtr; + savedOptionPtr->valuePtr = oldPtr; + oldInternalPtr = (char *) &savedOptionPtr->internalForm; + } else { + oldInternalPtr = (char *) &internal.internalForm; + } + nullOK = (optionPtr->specPtr->flags & TK_OPTION_NULL_OK); + switch (optionPtr->specPtr->type) { + case TK_OPTION_BOOLEAN: { + int new; + + if (Tcl_GetBooleanFromObj(interp, valuePtr, &new) + != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((int *) oldInternalPtr) = *((int *) internalPtr); + *((int *) internalPtr) = new; + } + break; } - if ((specPtr->argvName[1] != c) - || (strncmp(specPtr->argvName, argvName, length) != 0)) { - continue; + case TK_OPTION_INT: { + int new; + + if (Tcl_GetIntFromObj(interp, valuePtr, &new) != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((int *) oldInternalPtr) = *((int *) internalPtr); + *((int *) internalPtr) = new; + } + break; } - if (((specPtr->specFlags & needFlags) != needFlags) - || (specPtr->specFlags & hateFlags)) { - continue; + case TK_OPTION_DOUBLE: { + double new; + + if (Tcl_GetDoubleFromObj(interp, valuePtr, &new) + != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((double *) oldInternalPtr) = *((double *) internalPtr); + *((double *) internalPtr) = new; + } + break; + } + case TK_OPTION_STRING: { + char *new, *value; + int length; + + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + } + if (internalPtr != NULL) { + if (valuePtr != NULL) { + value = Tcl_GetStringFromObj(valuePtr, &length); + new = ckalloc((unsigned) (length + 1)); + strcpy(new, value); + } else { + new = NULL; + } + *((char **) oldInternalPtr) = *((char **) internalPtr); + *((char **) internalPtr) = new; + } + break; } - if (specPtr->argvName[length] == 0) { - matchPtr = specPtr; - goto gotMatch; + case TK_OPTION_STRING_TABLE: { + int new; + + if (Tcl_GetIndexFromObj(interp, valuePtr, + (char **) optionPtr->specPtr->clientData, + optionPtr->specPtr->optionName+1, 0, &new) != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((int *) oldInternalPtr) = *((int *) internalPtr); + *((int *) internalPtr) = new; + } + break; } - if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", argvName, - "\"", (char *) NULL); - return (Tk_ConfigSpec *) NULL; + case TK_OPTION_COLOR: { + XColor *newPtr; + + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + newPtr = NULL; + } else { + newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr); + if (newPtr == NULL) { + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + *((XColor **) oldInternalPtr) = *((XColor **) internalPtr); + *((XColor **) internalPtr) = newPtr; + } + break; } - matchPtr = specPtr; - } + case TK_OPTION_FONT: { + Tk_Font new; - if (matchPtr == NULL) { - Tcl_AppendResult(interp, "unknown option \"", argvName, - "\"", (char *) NULL); - return (Tk_ConfigSpec *) NULL; + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + new = NULL; + } else { + new = Tk_AllocFontFromObj(interp, tkwin, valuePtr); + if (new == NULL) { + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + *((Tk_Font *) oldInternalPtr) = *((Tk_Font *) internalPtr); + *((Tk_Font *) internalPtr) = new; + } + break; + } + case TK_OPTION_BITMAP: { + Pixmap new; + + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + new = None; + } else { + new = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr); + if (new == None) { + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + *((Pixmap *) oldInternalPtr) = *((Pixmap *) internalPtr); + *((Pixmap *) internalPtr) = new; + } + break; + } + case TK_OPTION_BORDER: { + Tk_3DBorder new; + + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + new = NULL; + } else { + new = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr); + if (new == NULL) { + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + *((Tk_3DBorder *) oldInternalPtr) = + *((Tk_3DBorder *) internalPtr); + *((Tk_3DBorder *) internalPtr) = new; + } + break; + } + case TK_OPTION_RELIEF: { + int new; + + if (Tk_GetReliefFromObj(interp, valuePtr, &new) != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((int *) oldInternalPtr) = *((int *) internalPtr); + *((int *) internalPtr) = new; + } + break; + } + case TK_OPTION_CURSOR: { + Tk_Cursor new; + + if (nullOK && ObjectIsEmpty(valuePtr)) { + new = None; + valuePtr = NULL; + } else { + new = Tk_AllocCursorFromObj(interp, tkwin, valuePtr); + if (new == None) { + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + *((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr); + *((Tk_Cursor *) internalPtr) = new; + } + Tk_DefineCursor(tkwin, new); + break; + } + case TK_OPTION_JUSTIFY: { + Tk_Justify new; + + if (Tk_GetJustifyFromObj(interp, valuePtr, &new) != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((Tk_Justify *) oldInternalPtr) + = *((Tk_Justify *) internalPtr); + *((Tk_Justify *) internalPtr) = new; + } + break; + } + case TK_OPTION_ANCHOR: { + Tk_Anchor new; + + if (Tk_GetAnchorFromObj(interp, valuePtr, &new) != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((Tk_Anchor *) oldInternalPtr) + = *((Tk_Anchor *) internalPtr); + *((Tk_Anchor *) internalPtr) = new; + } + break; + } + case TK_OPTION_PIXELS: { + int new; + + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, + &new) != TCL_OK) { + return TCL_ERROR; + } + if (internalPtr != NULL) { + *((int *) oldInternalPtr) = *((int *) internalPtr); + *((int *) internalPtr) = new; + } + break; + } + case TK_OPTION_WINDOW: { + Tk_Window new; + + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + new = None; + } else { + if (TkGetWindowFromObj(interp, tkwin, valuePtr, &new) + != TCL_OK) { + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + *((Tk_Window *) oldInternalPtr) = *((Tk_Window *) internalPtr); + *((Tk_Window *) internalPtr) = new; + } + break; + } + default: { + sprintf(interp->result, "bad config table: unknown type %d", + optionPtr->specPtr->type); + return TCL_ERROR; + } } /* - * Found a matching entry. If it's a synonym, then find the - * entry that it's a synonym for. + * Release resources associated with the old value, if we're not + * returning it to the caller, then install the new object value into + * the record. */ - gotMatch: - specPtr = matchPtr; - 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, "\"", (char *) NULL); - return (Tk_ConfigSpec *) NULL; - } - if ((specPtr->dbName == matchPtr->dbName) - && (specPtr->type != TK_CONFIG_SYNONYM) - && ((specPtr->specFlags & needFlags) == needFlags) - && !(specPtr->specFlags & hateFlags)) { - break; - } + if (savedOptionPtr == NULL) { + if (optionPtr->flags & OPTION_NEEDS_FREEING) { + FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin); + } + if (oldPtr != NULL) { + Tcl_DecrRefCount(oldPtr); } } - return specPtr; + if (slotPtrPtr != NULL) { + *slotPtrPtr = valuePtr; + if (valuePtr != NULL) { + Tcl_IncrRefCount(valuePtr); + } + } + return TCL_OK; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * - * DoConfig -- + * ObjectIsEmpty -- * - * This procedure applies a single configuration option - * to a widget record. + * This procedure tests whether the string value of an object is + * empty. * * Results: - * A standard Tcl return value. + * The return value is 1 if the string value of objPtr has length + * zero, and 0 otherwise. * * Side effects: - * WidgRec is modified as indicated by specPtr and value. - * The old value is recycled, if that is appropriate for - * the value type. + * None. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static int -DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec) - Tcl_Interp *interp; /* Interpreter for error reporting. */ - Tk_Window tkwin; /* Window containing widget (needed to - * set up X resources). */ - Tk_ConfigSpec *specPtr; /* Specifier to apply. */ - char *value; /* Value to use to fill in widgRec. */ - int valueIsUid; /* Non-zero means value is a Tk_Uid; - * zero means it's an ordinary string. */ - char *widgRec; /* Record whose fields are to be - * modified. Values must be properly - * initialized. */ +ObjectIsEmpty(objPtr) + Tcl_Obj *objPtr; /* Object to test. May be NULL. */ { - char *ptr; - Tk_Uid uid; - int nullValue; + int length; - nullValue = 0; - if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) { - nullValue = 1; + if (objPtr == NULL) { + return 1; } + if (objPtr->bytes != NULL) { + return (objPtr->length == 0); + } + Tcl_GetStringFromObj(objPtr, &length); + return (length == 0); +} + +/* + *---------------------------------------------------------------------- + * + * GetOptionFromObj -- + * + * This procedure searches through a chained option table to find + * the entry for a particular option name. + * + * Results: + * The return value is a pointer to the matching entry, or NULL + * if no matching entry could be found. If NULL is returned and + * interp is not NULL than an error message is left in its result. + * Note: if the matching entry is a synonym then this procedure + * returns a pointer to the synonym entry, *not* the "real" entry + * that the synonym refers to. + * + * Side effects: + * Information about the matching entry is cached in the object + * containing the name, so that future lookups can proceed more + * quickly. + * + *---------------------------------------------------------------------- + */ - do { - ptr = widgRec + specPtr->offset; - switch (specPtr->type) { - case TK_CONFIG_BOOLEAN: - if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) { - return TCL_ERROR; - } - break; - case TK_CONFIG_INT: - if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) { - return TCL_ERROR; - } - break; - case TK_CONFIG_DOUBLE: - if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) { - return TCL_ERROR; - } - break; - case TK_CONFIG_STRING: { - char *old, *new; +static Option * +GetOptionFromObj(interp, objPtr, tablePtr) + Tcl_Interp *interp; /* Used only for error reporting; if NULL + * no message is left after an error. */ + Tcl_Obj *objPtr; /* Object whose string value is to be + * looked up in the option table. */ + OptionTable *tablePtr; /* Table in which to look up objPtr. */ +{ + Option *bestPtr, *optionPtr; + OptionTable *tablePtr2; + char *p1, *p2, *name; + int count; - if (nullValue) { - new = NULL; - } else { - new = (char *) ckalloc((unsigned) (strlen(value) + 1)); - strcpy(new, value); - } - old = *((char **) ptr); - if (old != NULL) { - ckfree(old); + /* + * First, check to see if the object already has the answer cached. + */ + + if (objPtr->typePtr == &optionType) { + if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) { + return (Option *) objPtr->internalRep.twoPtrValue.ptr2; + } + } + + /* + * The answer isn't cached. Search through all of the option tables + * in the chain to find the best match. Some tricky aspects: + * + * 1. We have to accept unique abbreviations. + * 2. The same name could appear in different tables in the chain. + * If this happens, we use the entry from the first table. We + * have to be careful to distinguish this case from an ambiguous + * abbreviation. + */ + + bestPtr = NULL; + name = Tcl_GetStringFromObj(objPtr, (int *) NULL); + for (tablePtr2 = tablePtr; tablePtr2 != NULL; + tablePtr2 = tablePtr2->nextPtr) { + for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions; + count > 0; optionPtr++, count--) { + for (p1 = name, p2 = optionPtr->specPtr->optionName; + *p1 == *p2; p1++, p2++) { + if (*p1 == 0) { + /* + * This is an exact match. We're done. + */ + + bestPtr = optionPtr; + goto done; } - *((char **) ptr) = new; - break; } - case TK_CONFIG_UID: - if (nullValue) { - *((Tk_Uid *) ptr) = NULL; - } else { - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - *((Tk_Uid *) ptr) = uid; - } - break; - case TK_CONFIG_COLOR: { - XColor *newPtr, *oldPtr; + if (*p1 == 0) { + /* + * The name is an abbreviation for this option. Keep + * to make sure that the abbreviation only matches one + * option name. If we've already found a match in the + * past, then it is an error unless the full names for + * the two options are identical; in this case, the first + * option overrides the second. + */ - if (nullValue) { - newPtr = NULL; + if (bestPtr == NULL) { + bestPtr = optionPtr; } else { - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - newPtr = Tk_GetColor(interp, tkwin, uid); - if (newPtr == NULL) { - return TCL_ERROR; + if (strcmp(bestPtr->specPtr->optionName, + optionPtr->specPtr->optionName) != 0) { + goto error; } } - oldPtr = *((XColor **) ptr); - if (oldPtr != NULL) { - Tk_FreeColor(oldPtr); - } - *((XColor **) ptr) = newPtr; - break; } - case TK_CONFIG_FONT: { - Tk_Font new; + } + } + if (bestPtr == NULL) { + goto error; + } - if (nullValue) { - new = NULL; - } else { - new = Tk_GetFont(interp, tkwin, value); - if (new == NULL) { - return TCL_ERROR; - } - } - Tk_FreeFont(*((Tk_Font *) ptr)); - *((Tk_Font *) ptr) = new; - break; + done: + if ((objPtr->typePtr != NULL) + && (objPtr->typePtr->freeIntRepProc != NULL)) { + objPtr->typePtr->freeIntRepProc(objPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr; + objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr; + objPtr->typePtr = &optionType; + return bestPtr; + + error: + if (interp != NULL) { + Tcl_AppendResult(interp, "unknown option \"", name, + "\"", (char *) NULL); + } + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * SetOptionFromAny -- + * + * This procedure 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 + * procedure always generates an error. + * + * Results: + * The return value is always TCL_ERROR, and an error message is + * left in interp's result if interp isn't NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +SetOptionFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "can't convert value to option except via GetOptionFromObj API", + -1); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * Tk_SetOptions -- + * + * Process one or more name-value pairs for configuration options + * and fill in fields of a record with new values. + * + * Results: + * If all goes well then TCL_OK is returned and the old values of + * any modified objects are saved in *savePtr, if it isn't NULL (the + * caller must eventually call Tk_RestoreSavedOptions or + * Tk_FreeSavedOptions to free the contents of *savePtr). In + * addition, if maskPtr isn't NULL then *maskPtr is filled in with + * the OR of the typeMask bits from all modified options. If an + * error occurs then TCL_ERROR is returned and a message + * is left in interp's result unless interp is NULL; nothing is + * saved in *savePtr or *maskPtr in this case. + * + * Side effects: + * The fields of recordPtr get filled in with object pointers + * from objc/objv. Old information in widgRec's fields gets + * recycled. Information may be left at *savePtr. + * + *-------------------------------------------------------------- + */ + +int +Tk_SetOptions(interp, recordPtr, optionTable, objc, objv, tkwin, savePtr, + maskPtr) + Tcl_Interp *interp; /* Interpreter for error reporting. + * If NULL, then no error message is + * returned.*/ + char *recordPtr; /* The record to configure. */ + Tk_OptionTable optionTable; /* Describes valid options. */ + int objc; /* The number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Contains one or more name-value + * pairs. */ + Tk_Window tkwin; /* Window associated with the thing + * being configured; needed for some + * options (such as colors). */ + Tk_SavedOptions *savePtr; /* If non-NULL, the old values of + * modified options are saved here + * so that they can be restored + * after an error. */ + int *maskPtr; /* It non-NULL, this word is modified + * on a successful return to hold the + * bit-wise OR of the typeMask fields + * of all options that were modified + * by this call. Used by the caller + * to figure out which options + * actually changed. */ +{ + OptionTable *tablePtr = (OptionTable *) optionTable; + Option *optionPtr; + Tk_SavedOptions *lastSavePtr, *newSavePtr; + int mask; + + if (savePtr != NULL) { + savePtr->recordPtr = recordPtr; + savePtr->tkwin = tkwin; + savePtr->numItems = 0; + savePtr->nextPtr = NULL; + } + lastSavePtr = savePtr; + + /* + * Scan through all of the arguments, processing those + * that match entries in the option table. + */ + + mask = 0; + for ( ; objc > 0; objc -= 2, objv += 2) { + optionPtr = GetOptionFromObj(interp, objv[0], tablePtr); + if (optionPtr == NULL) { + goto error; + } + if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) { + optionPtr = optionPtr->extra.synonymPtr; + } + + if (objc < 2) { + if (interp != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "value for \"", Tcl_GetStringFromObj(*objv, NULL), + "\" missing", (char *) NULL); + goto error; } - case TK_CONFIG_BITMAP: { - Pixmap new, old; + } + if ((savePtr != NULL) + && (lastSavePtr->numItems >= TK_NUM_SAVED_OPTIONS)) { + /* + * We've run out of space for saving old option values. Allocate + * more space. + */ - if (nullValue) { - new = None; - } else { - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - new = Tk_GetBitmap(interp, tkwin, uid); - if (new == None) { - return TCL_ERROR; - } + newSavePtr = (Tk_SavedOptions *) ckalloc(sizeof( + Tk_SavedOptions)); + newSavePtr->recordPtr = recordPtr; + newSavePtr->tkwin = tkwin; + newSavePtr->numItems = 0; + newSavePtr->nextPtr = NULL; + lastSavePtr->nextPtr = newSavePtr; + lastSavePtr = newSavePtr; + } + if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin, + (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems] + : (Tk_SavedOption *) NULL) != TCL_OK) { + char msg[100]; + + sprintf(msg, "\n (processing \"%.40s\" option)", + Tcl_GetStringFromObj(*objv, NULL)); + Tcl_AddErrorInfo(interp, msg); + goto error; + } + if (savePtr != NULL) { + lastSavePtr->numItems++; + } + mask |= optionPtr->specPtr->typeMask; + } + if (maskPtr != NULL) { + *maskPtr = mask; + } + return TCL_OK; + + error: + if (savePtr != NULL) { + Tk_RestoreSavedOptions(savePtr); + } + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_RestoreSavedOptions -- + * + * This procedure undoes the effect of a previous call to + * Tk_SetOptions by restoring all of the options to their value + * before the call to Tk_SetOptions. + * + * Results: + * None. + * + * Side effects: + * The configutation record is restored and all the information + * stored in savePtr is freed. + * + *---------------------------------------------------------------------- + */ + +void +Tk_RestoreSavedOptions(savePtr) + Tk_SavedOptions *savePtr; /* Holds saved option information; must + * have been passed to Tk_SetOptions. */ +{ + int i; + Option *optionPtr; + Tcl_Obj *newPtr; /* New object value of option, which we + * replace with old value and free. Taken + * from record. */ + char *internalPtr; /* Points to internal value of option in + * record. */ + CONST Tk_OptionSpec *specPtr; + + /* + * Be sure to restore the options in the opposite order they were + * set. This is important because it's possible that the same + * option name was used twice in a single call to Tk_SetOptions. + */ + + if (savePtr->nextPtr != NULL) { + Tk_RestoreSavedOptions(savePtr->nextPtr); + ckfree((char *) savePtr->nextPtr); + savePtr->nextPtr = NULL; + } + for (i = savePtr->numItems - 1; i >= 0; i--) { + optionPtr = savePtr->items[i].optionPtr; + specPtr = optionPtr->specPtr; + + /* + * First free the new value of the option, which is currently + * in the record. + */ + + if (specPtr->objOffset >= 0) { + newPtr = *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset)); + } else { + newPtr = NULL; + } + if (specPtr->internalOffset >= 0) { + internalPtr = savePtr->recordPtr + specPtr->internalOffset; + } else { + internalPtr = NULL; + } + if (optionPtr->flags & OPTION_NEEDS_FREEING) { + FreeResources(optionPtr, newPtr, internalPtr, savePtr->tkwin); + } + if (newPtr != NULL) { + Tcl_DecrRefCount(newPtr); + } + + /* + * Now restore the old value of the option. + */ + + if (specPtr->objOffset >= 0) { + *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset)) + = savePtr->items[i].valuePtr; + } + if (specPtr->internalOffset >= 0) { + switch (specPtr->type) { + case TK_OPTION_BOOLEAN: { + *((int *) internalPtr) + = *((int *) &savePtr->items[i].internalForm); + break; } - old = *((Pixmap *) ptr); - if (old != None) { - Tk_FreeBitmap(Tk_Display(tkwin), old); + case TK_OPTION_INT: { + *((int *) internalPtr) + = *((int *) &savePtr->items[i].internalForm); + break; } - *((Pixmap *) ptr) = new; - break; - } - case TK_CONFIG_BORDER: { - Tk_3DBorder new, old; - - if (nullValue) { - new = NULL; - } else { - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - new = Tk_Get3DBorder(interp, tkwin, uid); - if (new == NULL) { - return TCL_ERROR; - } + case TK_OPTION_DOUBLE: { + *((double *) internalPtr) + = *((double *) &savePtr->items[i].internalForm); + break; } - old = *((Tk_3DBorder *) ptr); - if (old != NULL) { - Tk_Free3DBorder(old); + case TK_OPTION_STRING: { + *((char **) internalPtr) + = *((char **) &savePtr->items[i].internalForm); + break; } - *((Tk_3DBorder *) ptr) = new; - break; - } - case TK_CONFIG_RELIEF: - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) { - return TCL_ERROR; + case TK_OPTION_STRING_TABLE: { + *((int *) internalPtr) + = *((int *) &savePtr->items[i].internalForm); + break; } - break; - case TK_CONFIG_CURSOR: - case TK_CONFIG_ACTIVE_CURSOR: { - Tk_Cursor new, old; - - if (nullValue) { - new = None; - } else { - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - new = Tk_GetCursor(interp, tkwin, uid); - if (new == None) { - return TCL_ERROR; - } + case TK_OPTION_COLOR: { + *((XColor **) internalPtr) + = *((XColor **) &savePtr->items[i].internalForm); + break; } - old = *((Tk_Cursor *) ptr); - if (old != None) { - Tk_FreeCursor(Tk_Display(tkwin), old); + case TK_OPTION_FONT: { + *((Tk_Font *) internalPtr) + = *((Tk_Font *) &savePtr->items[i].internalForm); + break; } - *((Tk_Cursor *) ptr) = new; - if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) { - Tk_DefineCursor(tkwin, new); + case TK_OPTION_BITMAP: { + *((Pixmap *) internalPtr) + = *((Pixmap *) &savePtr->items[i].internalForm); + break; } - break; - } - case TK_CONFIG_JUSTIFY: - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) { - return TCL_ERROR; + case TK_OPTION_BORDER: { + *((Tk_3DBorder *) internalPtr) + = *((Tk_3DBorder *) &savePtr->items[i].internalForm); + break; } - break; - case TK_CONFIG_ANCHOR: - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) { - return TCL_ERROR; + case TK_OPTION_RELIEF: { + *((int *) internalPtr) + = *((int *) &savePtr->items[i].internalForm); + break; } - break; - case TK_CONFIG_CAP_STYLE: - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) { - return TCL_ERROR; + case TK_OPTION_CURSOR: { + *((Tk_Cursor *) internalPtr) + = *((Tk_Cursor *) &savePtr->items[i].internalForm); + Tk_DefineCursor(savePtr->tkwin, + *((Tk_Cursor *) internalPtr)); + break; } - break; - case TK_CONFIG_JOIN_STYLE: - uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); - if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) { - return TCL_ERROR; + case TK_OPTION_JUSTIFY: { + *((Tk_Justify *) internalPtr) + = *((Tk_Justify *) &savePtr->items[i].internalForm); + break; } - break; - case TK_CONFIG_PIXELS: - if (Tk_GetPixels(interp, tkwin, value, (int *) ptr) - != TCL_OK) { - return TCL_ERROR; + case TK_OPTION_ANCHOR: { + *((Tk_Anchor *) internalPtr) + = *((Tk_Anchor *) &savePtr->items[i].internalForm); + break; } - break; - case TK_CONFIG_MM: - if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr) - != TCL_OK) { - return TCL_ERROR; + case TK_OPTION_PIXELS: { + *((int *) internalPtr) + = *((int *) &savePtr->items[i].internalForm); + break; + } + case TK_OPTION_WINDOW: { + *((Tk_Window *) internalPtr) + = *((Tk_Window *) &savePtr->items[i].internalForm); + break; } - break; - case TK_CONFIG_WINDOW: { - Tk_Window tkwin2; + default: { + panic("bad option type in Tk_RestoreSavedOptions"); + } + } + } + } + savePtr->numItems = 0; +} + +/* + *-------------------------------------------------------------- + * + * Tk_FreeSavedOptions -- + * + * Free all of the saved configuration option values from a + * previous call to Tk_SetOptions. + * + * Results: + * None. + * + * Side effects: + * Storage and system resources are freed. + * + *-------------------------------------------------------------- + */ - if (nullValue) { - tkwin2 = NULL; - } else { - tkwin2 = Tk_NameToWindow(interp, value, tkwin); - if (tkwin2 == NULL) { - return TCL_ERROR; - } +void +Tk_FreeSavedOptions(savePtr) + Tk_SavedOptions *savePtr; /* Contains options saved in a previous + * call to Tk_SetOptions. */ +{ + int count; + Tk_SavedOption *savedOptionPtr; + + if (savePtr->nextPtr != NULL) { + Tk_FreeSavedOptions(savePtr->nextPtr); + ckfree((char *) savePtr->nextPtr); + } + for (count = savePtr->numItems, + savedOptionPtr = &savePtr->items[savePtr->numItems-1]; + count > 0; count--, savedOptionPtr--) { + if (savedOptionPtr->optionPtr->flags & OPTION_NEEDS_FREEING) { + FreeResources(savedOptionPtr->optionPtr, savedOptionPtr->valuePtr, + (char *) &savedOptionPtr->internalForm, savePtr->tkwin); + } + if (savedOptionPtr->valuePtr != NULL) { + Tcl_DecrRefCount(savedOptionPtr->valuePtr); + } + } +} + +/* + *---------------------------------------------------------------------- + * + * Tk_FreeConfigOptions -- + * + * Free all resources associated with configuration options. + * + * Results: + * None. + * + * Side effects: + * All of the Tcl_Obj's in recordPtr that are controlled by + * configuration options in optionTable are freed. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +Tk_FreeConfigOptions(recordPtr, optionTable, tkwin) + char *recordPtr; /* Record whose fields contain current + * values for options. */ + Tk_OptionTable optionTable; /* Describes legal options. */ + Tk_Window tkwin; /* Window associated with recordPtr; needed + * for freeing some options. */ +{ + OptionTable *tablePtr; + Option *optionPtr; + int count; + Tcl_Obj **oldPtrPtr, *oldPtr; + char *oldInternalPtr; + CONST Tk_OptionSpec *specPtr; + + for (tablePtr = (OptionTable *) optionTable; tablePtr != NULL; + tablePtr = tablePtr->nextPtr) { + for (optionPtr = tablePtr->options, count = tablePtr->numOptions; + count > 0; optionPtr++, count--) { + specPtr = optionPtr->specPtr; + if (specPtr->type == TK_OPTION_SYNONYM) { + continue; + } + if (specPtr->objOffset >= 0) { + oldPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset); + oldPtr = *oldPtrPtr; + *oldPtrPtr = NULL; + } else { + oldPtr = NULL; + } + if (specPtr->internalOffset >= 0) { + oldInternalPtr = recordPtr + specPtr->internalOffset; + } else { + oldInternalPtr = NULL; + } + if (optionPtr->flags & OPTION_NEEDS_FREEING) { + FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin); + } + if (oldPtr != NULL) { + Tcl_DecrRefCount(oldPtr); + } + } + } +} + +/* + *---------------------------------------------------------------------- + * + * FreeResources -- + * + * Free system resources associated with a configuration option, + * such as colors or fonts. + * + * Results: + * None. + * + * Side effects: + * Any system resources associated with objPtr are released. However, + * objPtr itself is not freed. + * + *---------------------------------------------------------------------- + */ + +static void +FreeResources(optionPtr, objPtr, internalPtr, tkwin) + Option *optionPtr; /* Description of the configuration option. */ + Tcl_Obj *objPtr; /* The current value of the option, specified + * as an object. */ + char *internalPtr; /* A pointer to an internal representation for + * the option's value, such as an int or + * (XColor *). Only valid if + * optionPtr->specPtr->internalOffset >= 0. */ + Tk_Window tkwin; /* The window in which this option is used. */ +{ + int internalFormExists; + + /* + * If there exists an internal form for the value, use it to free + * resources (also zero out the internal form). If there is no + * internal form, then use the object form. + */ + + internalFormExists = optionPtr->specPtr->internalOffset >= 0; + switch (optionPtr->specPtr->type) { + case TK_OPTION_STRING: + if (internalFormExists) { + if (*((char **) internalPtr) != NULL) { + ckfree(*((char **) internalPtr)); + *((char **) internalPtr) = NULL; } - *((Tk_Window *) ptr) = tkwin2; - break; } - case TK_CONFIG_CUSTOM: - if ((*specPtr->customPtr->parseProc)( - specPtr->customPtr->clientData, interp, tkwin, - value, widgRec, specPtr->offset) != TCL_OK) { - return TCL_ERROR; + break; + case TK_OPTION_COLOR: + if (internalFormExists) { + if (*((XColor **) internalPtr) != NULL) { + Tk_FreeColor(*((XColor **) internalPtr)); + *((XColor **) internalPtr) = NULL; } - break; - default: { - sprintf(interp->result, "bad config table: unknown type %d", - specPtr->type); - return TCL_ERROR; + } else if (objPtr != NULL) { + Tk_FreeColorFromObj(tkwin, objPtr); } - } - specPtr++; - } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END)); - return TCL_OK; + break; + case TK_OPTION_FONT: + if (internalFormExists) { + Tk_FreeFont(*((Tk_Font *) internalPtr)); + *((Tk_Font *) internalPtr) = NULL; + } else if (objPtr != NULL) { + Tk_FreeFontFromObj(tkwin, objPtr); + } + break; + case TK_OPTION_BITMAP: + if (internalFormExists) { + if (*((Pixmap *) internalPtr) != None) { + Tk_FreeBitmap(Tk_Display(tkwin), *((Pixmap *) internalPtr)); + *((Pixmap *) internalPtr) = None; + } + } else if (objPtr != NULL) { + Tk_FreeBitmapFromObj(tkwin, objPtr); + } + break; + case TK_OPTION_BORDER: + if (internalFormExists) { + if (*((Tk_3DBorder *) internalPtr) != NULL) { + Tk_Free3DBorder(*((Tk_3DBorder *) internalPtr)); + *((Tk_3DBorder *) internalPtr) = NULL; + } + } else if (objPtr != NULL) { + Tk_Free3DBorderFromObj(tkwin, objPtr); + } + break; + case TK_OPTION_CURSOR: + if (internalFormExists) { + if (*((Tk_Cursor *) internalPtr) != None) { + Tk_FreeCursor(Tk_Display(tkwin), + *((Tk_Cursor *) internalPtr)); + *((Tk_Cursor *) internalPtr) = None; + } + } else if (objPtr != NULL) { + Tk_FreeCursorFromObj(tkwin, objPtr); + } + break; + default: + break; + } } /* *-------------------------------------------------------------- * - * Tk_ConfigureInfo -- + * Tk_GetOptionInfo -- * - * Return information about the configuration options - * for a window, and their current values. + * Returns a list object containing complete information about + * either a single option or all the configuration options in a + * table. * * Results: - * Always returns TCL_OK. Interp->result will be modified - * hold a description of either a single configuration option - * available for "widgRec" via "specs", or all the configuration - * options available. In the "all" case, the result will - * available for "widgRec" via "specs". The result will - * be a list, each of whose entries describes one option. - * Each entry will itself be a list containing the option's - * name for use on command lines, database name, database - * class, default value, and current value (empty string - * if none). For options that are synonyms, the list will - * contain only two values: name and synonym name. If the - * "name" argument is non-NULL, then the only information - * returned is that for the named argument (i.e. the corresponding - * entry in the overall list is returned). + * This procedure 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 current value. If the option is a + * synonym then the list will contain only two values: the option + * name and the name of the option it refers to. If namePtr is + * NULL, then information is returned for every option in the + * option table: the result will have one sub-list (in the form + * described above) for each option in the table. If an error + * occurs (e.g. because namePtr isn't valid) then NULL is returned + * and an error message will be left in interp's result unless + * interp is NULL. * * Side effects: * None. @@ -581,47 +1632,40 @@ DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec) *-------------------------------------------------------------- */ -int -Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags) - Tcl_Interp *interp; /* Interpreter for error reporting. */ - Tk_Window tkwin; /* Window corresponding to widgRec. */ - Tk_ConfigSpec *specs; /* Describes legal options. */ - char *widgRec; /* Record whose fields contain current +Tcl_Obj * +Tk_GetOptionInfo(interp, recordPtr, optionTable, namePtr, tkwin) + Tcl_Interp *interp; /* Interpreter for error reporting. If + * NULL, then no error message is created. */ + char *recordPtr; /* Record whose fields contain current * values for options. */ - 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. */ + Tk_OptionTable optionTable; /* Describes all the legal options. */ + Tcl_Obj *namePtr; /* If non-NULL, the string value selects + * a single option whose info is to be + * returned. Otherwise info is returned for + * all options in optionTable. */ + Tk_Window tkwin; /* Window associated with recordPtr; needed + * to compute correct default value for some + * options. */ { - register Tk_ConfigSpec *specPtr; - int needFlags, hateFlags; - char *list; - char *leader = "{"; - - needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); - if (Tk_Depth(tkwin) <= 1) { - hateFlags = TK_CONFIG_COLOR_ONLY; - } else { - hateFlags = TK_CONFIG_MONO_ONLY; - } + Tcl_Obj *resultPtr; + OptionTable *tablePtr = (OptionTable *) optionTable; + Option *optionPtr; + int count; /* * If information is only wanted for a single configuration * spec, then handle that one spec specially. */ - Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); - if (argvName != NULL) { - specPtr = FindConfigSpec(interp, specs, argvName, needFlags, - hateFlags); - if (specPtr == NULL) { - return TCL_ERROR; + if (namePtr != NULL) { + optionPtr = GetOptionFromObj(interp, namePtr, tablePtr); + if (optionPtr == NULL) { + return (Tcl_Obj *) NULL; } - interp->result = FormatConfigInfo(interp, tkwin, specPtr, widgRec); - interp->freeProc = TCL_DYNAMIC; - return TCL_OK; + if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) { + optionPtr = optionPtr->extra.synonymPtr; + } + return GetConfigList(recordPtr, optionPtr, tkwin); } /* @@ -629,29 +1673,21 @@ Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags) * their information. */ - for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { - if ((argvName != NULL) && (specPtr->argvName != argvName)) { - continue; - } - if (((specPtr->specFlags & needFlags) != needFlags) - || (specPtr->specFlags & hateFlags)) { - continue; - } - if (specPtr->argvName == NULL) { - continue; + resultPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + for (; tablePtr != NULL; tablePtr = tablePtr->nextPtr) { + for (optionPtr = tablePtr->options, count = tablePtr->numOptions; + count > 0; optionPtr++, count--) { + Tcl_ListObjAppendElement(interp, resultPtr, + GetConfigList(recordPtr, optionPtr, tkwin)); } - list = FormatConfigInfo(interp, tkwin, specPtr, widgRec); - Tcl_AppendResult(interp, leader, list, "}", (char *) NULL); - ckfree(list); - leader = " {"; } - return TCL_OK; + return resultPtr; } /* *-------------------------------------------------------------- * - * FormatConfigInfo -- + * GetConfigList -- * * Create a valid Tcl list holding the configuration information * for a single configuration option. @@ -666,67 +1702,78 @@ Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags) *-------------------------------------------------------------- */ -static char * -FormatConfigInfo(interp, tkwin, specPtr, widgRec) - Tcl_Interp *interp; /* Interpreter to use for things - * like floating-point precision. */ - Tk_Window tkwin; /* Window corresponding to widget. */ - register Tk_ConfigSpec *specPtr; /* Pointer to information describing - * option. */ - char *widgRec; /* Pointer to record holding current - * values of info for widget. */ +static Tcl_Obj * +GetConfigList(recordPtr, optionPtr, tkwin) + char *recordPtr; /* Pointer to record holding current + * values of configuration options. */ + Option *optionPtr; /* Pointer to information describing a + * particular option. */ + Tk_Window tkwin; /* Window corresponding to recordPtr. */ { - char *argv[6], *result; - char buffer[200]; - Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL; - - argv[0] = specPtr->argvName; - argv[1] = specPtr->dbName; - argv[2] = specPtr->dbClass; - argv[3] = specPtr->defValue; - if (specPtr->type == TK_CONFIG_SYNONYM) { - return Tcl_Merge(2, argv); - } - argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, - &freeProc); - if (argv[1] == NULL) { - argv[1] = ""; - } - if (argv[2] == NULL) { - argv[2] = ""; - } - if (argv[3] == NULL) { - argv[3] = ""; - } - if (argv[4] == NULL) { - argv[4] = ""; - } - result = Tcl_Merge(5, argv); - if (freeProc != NULL) { - if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { - ckfree(argv[4]); + Tcl_Obj *listPtr, *elementPtr; + + listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, + Tcl_NewStringObj(optionPtr->specPtr->optionName, -1)); + + if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) { + elementPtr = Tcl_NewStringObj( + optionPtr->extra.synonymPtr->specPtr->optionName, -1); + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr); + } else { + if (optionPtr->dbNameUID == NULL) { + elementPtr = Tcl_NewObj(); + } else { + elementPtr = Tcl_NewStringObj(optionPtr->dbNameUID, -1); + } + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr); + + if (optionPtr->dbClassUID == NULL) { + elementPtr = Tcl_NewObj(); + } else { + elementPtr = Tcl_NewStringObj(optionPtr->dbClassUID, -1); + } + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr); + + if ((tkwin != NULL) && ((optionPtr->specPtr->type == TK_OPTION_COLOR) + || (optionPtr->specPtr->type == TK_OPTION_BORDER)) + && (Tk_Depth(tkwin) <= 1) + && (optionPtr->extra.monoColorPtr != NULL)) { + elementPtr = optionPtr->extra.monoColorPtr; + } else if (optionPtr->defaultPtr != NULL) { + elementPtr = optionPtr->defaultPtr; } else { - (*freeProc)(argv[4]); + elementPtr = Tcl_NewObj(); } + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr); + + if (optionPtr->specPtr->objOffset >= 0) { + elementPtr = *((Tcl_Obj **) (recordPtr + + optionPtr->specPtr->objOffset)); + if (elementPtr == NULL) { + elementPtr = Tcl_NewObj(); + } + } else { + elementPtr = GetObjectForOption(recordPtr, optionPtr, tkwin); + } + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr); } - return result; + return listPtr; } /* *---------------------------------------------------------------------- * - * FormatConfigValue -- + * GetObjectForOption -- * - * This procedure formats the current value of a configuration - * option. + * This procedure is called to create an object that contains the + * value for an option. It is invoked by GetConfigList and + * Tk_GetOptionValue when only the internal form of an option is + * stored in the record. * * Results: - * The return value is the formatted value of the option given - * by specPtr and widgRec. If the value is static, so that it - * need not be freed, *freeProcPtr will be set to NULL; otherwise - * *freeProcPtr will be set to the address of a procedure to - * free the result, and the caller must invoke this procedure - * when it is finished with the result. + * The return value is a pointer to a Tcl object. The caller + * must call Tcl_IncrRefCount on this object to preserve it. * * Side effects: * None. @@ -734,146 +1781,130 @@ FormatConfigInfo(interp, tkwin, specPtr, widgRec) *---------------------------------------------------------------------- */ -static char * -FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr) - Tcl_Interp *interp; /* Interpreter for use in real conversions. */ - Tk_Window tkwin; /* Window corresponding to widget. */ - 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. */ - char *buffer; /* Static buffer to use for small values. - * Must have at least 200 bytes of storage. */ - Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address - * of procedure to free the result, or NULL - * if result is static. */ +static Tcl_Obj * +GetObjectForOption(recordPtr, optionPtr, tkwin) + char *recordPtr; /* Pointer to record holding current + * values of configuration options. */ + Option *optionPtr; /* Pointer to information describing an + * option whose internal value is stored + * in *recordPtr. */ + Tk_Window tkwin; /* Window corresponding to recordPtr. */ { - char *ptr, *result; - - *freeProcPtr = NULL; - ptr = widgRec + specPtr->offset; - result = ""; - switch (specPtr->type) { - case TK_CONFIG_BOOLEAN: - if (*((int *) ptr) == 0) { - result = "0"; - } else { - result = "1"; - } + Tcl_Obj *objPtr; + char *internalPtr; /* Points to internal value of option in + * record. */ + + internalPtr = recordPtr + optionPtr->specPtr->internalOffset; + objPtr = NULL; + switch (optionPtr->specPtr->type) { + case TK_OPTION_BOOLEAN: { + objPtr = Tcl_NewIntObj(*((int *) internalPtr)); break; - case TK_CONFIG_INT: - sprintf(buffer, "%d", *((int *) ptr)); - result = buffer; + } + case TK_OPTION_INT: { + objPtr = Tcl_NewIntObj(*((int *) internalPtr)); break; - case TK_CONFIG_DOUBLE: - Tcl_PrintDouble(interp, *((double *) ptr), buffer); - result = buffer; + } + case TK_OPTION_DOUBLE: { + objPtr = Tcl_NewDoubleObj(*((double *) internalPtr)); break; - case TK_CONFIG_STRING: - result = (*(char **) ptr); - if (result == NULL) { - result = ""; - } + } + case TK_OPTION_STRING: { + objPtr = Tcl_NewStringObj(*((char **) internalPtr), -1); break; - case TK_CONFIG_UID: { - Tk_Uid uid = *((Tk_Uid *) ptr); - if (uid != NULL) { - result = uid; - } + } + case TK_OPTION_STRING_TABLE: { + objPtr = Tcl_NewStringObj( + ((char **) optionPtr->specPtr->clientData)[ + *((int *) internalPtr)], -1); break; } - case TK_CONFIG_COLOR: { - XColor *colorPtr = *((XColor **) ptr); + case TK_OPTION_COLOR: { + XColor *colorPtr = *((XColor **) internalPtr); if (colorPtr != NULL) { - result = Tk_NameOfColor(colorPtr); + objPtr = Tcl_NewStringObj(Tk_NameOfColor(colorPtr), -1); } break; } - case TK_CONFIG_FONT: { - Tk_Font tkfont = *((Tk_Font *) ptr); + case TK_OPTION_FONT: { + Tk_Font tkfont = *((Tk_Font *) internalPtr); if (tkfont != NULL) { - result = Tk_NameOfFont(tkfont); + objPtr = Tcl_NewStringObj(Tk_NameOfFont(tkfont), -1); } break; } - case TK_CONFIG_BITMAP: { - Pixmap pixmap = *((Pixmap *) ptr); + case TK_OPTION_BITMAP: { + Pixmap pixmap = *((Pixmap *) internalPtr); if (pixmap != None) { - result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap); + objPtr = Tcl_NewStringObj(Tk_NameOfBitmap(Tk_Display(tkwin), + pixmap), -1); } break; } - case TK_CONFIG_BORDER: { - Tk_3DBorder border = *((Tk_3DBorder *) ptr); + case TK_OPTION_BORDER: { + Tk_3DBorder border = *((Tk_3DBorder *) internalPtr); if (border != NULL) { - result = Tk_NameOf3DBorder(border); + objPtr = Tcl_NewStringObj(Tk_NameOf3DBorder(border), -1); } break; } - case TK_CONFIG_RELIEF: - result = Tk_NameOfRelief(*((int *) ptr)); + case TK_OPTION_RELIEF: { + objPtr = Tcl_NewStringObj(Tk_NameOfRelief( + *((int *) internalPtr)), -1); break; - case TK_CONFIG_CURSOR: - case TK_CONFIG_ACTIVE_CURSOR: { - Tk_Cursor cursor = *((Tk_Cursor *) ptr); + } + case TK_OPTION_CURSOR: { + Tk_Cursor cursor = *((Tk_Cursor *) internalPtr); if (cursor != None) { - result = Tk_NameOfCursor(Tk_Display(tkwin), cursor); + objPtr = Tcl_NewStringObj( + Tk_NameOfCursor(Tk_Display(tkwin), cursor), -1); } break; } - case TK_CONFIG_JUSTIFY: - result = Tk_NameOfJustify(*((Tk_Justify *) ptr)); - break; - case TK_CONFIG_ANCHOR: - result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr)); - break; - case TK_CONFIG_CAP_STYLE: - result = Tk_NameOfCapStyle(*((int *) ptr)); + case TK_OPTION_JUSTIFY: { + objPtr = Tcl_NewStringObj(Tk_NameOfJustify( + *((Tk_Justify *) internalPtr)), -1); break; - case TK_CONFIG_JOIN_STYLE: - result = Tk_NameOfJoinStyle(*((int *) ptr)); - break; - case TK_CONFIG_PIXELS: - sprintf(buffer, "%d", *((int *) ptr)); - result = buffer; + } + case TK_OPTION_ANCHOR: { + objPtr = Tcl_NewStringObj(Tk_NameOfAnchor( + *((Tk_Anchor *) internalPtr)), -1); break; - case TK_CONFIG_MM: - Tcl_PrintDouble(interp, *((double *) ptr), buffer); - result = buffer; + } + case TK_OPTION_PIXELS: { + objPtr = Tcl_NewIntObj(*((int *) internalPtr)); break; - case TK_CONFIG_WINDOW: { - Tk_Window tkwin; - - tkwin = *((Tk_Window *) ptr); + } + case TK_OPTION_WINDOW: { + Tk_Window tkwin = *((Tk_Window *) internalPtr); if (tkwin != NULL) { - result = Tk_PathName(tkwin); + objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1); } break; } - case TK_CONFIG_CUSTOM: - result = (*specPtr->customPtr->printProc)( - specPtr->customPtr->clientData, tkwin, widgRec, - specPtr->offset, freeProcPtr); - break; - default: - result = "?? unknown type ??"; + default: { + panic("bad option type in GetObjectForOption"); + } } - return result; + if (objPtr == NULL) { + objPtr = Tcl_NewObj(); + } + return objPtr; } /* *---------------------------------------------------------------------- * - * Tk_ConfigureValue -- + * Tk_GetOptionValue -- * * This procedure returns the current value of a configuration - * option for a widget. + * option. * * Results: - * The return value is a standard Tcl completion code (TCL_OK or - * TCL_ERROR). Interp->result will be set to hold either the value - * of the option given by argvName (if TCL_OK is returned) or - * an error message (if TCL_ERROR is returned). + * The return value is the object holding the current value of + * the option given by namePtr. If no such option exists, then + * the return value is NULL and an error message is left in + * interp's result (if interp isn't NULL). * * Side effects: * None. @@ -881,110 +1912,113 @@ FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr) *---------------------------------------------------------------------- */ -int -Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags) - Tcl_Interp *interp; /* Interpreter for error reporting. */ - Tk_Window tkwin; /* Window corresponding to widgRec. */ - Tk_ConfigSpec *specs; /* Describes legal options. */ - char *widgRec; /* Record whose fields contain current +Tcl_Obj * +Tk_GetOptionValue(interp, recordPtr, optionTable, namePtr, tkwin) + Tcl_Interp *interp; /* Interpreter for error reporting. If + * NULL then no messages are provided for + * errors. */ + char *recordPtr; /* Record whose fields contain current * values for options. */ - char *argvName; /* Gives the command-line name for the + Tk_OptionTable optionTable; /* Describes legal options. */ + Tcl_Obj *namePtr; /* 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 considered. */ + Tk_Window tkwin; /* Window corresponding to recordPtr. */ { - Tk_ConfigSpec *specPtr; - int needFlags, hateFlags; + OptionTable *tablePtr = (OptionTable *) optionTable; + Option *optionPtr; + Tcl_Obj *resultPtr; - needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); - if (Tk_Depth(tkwin) <= 1) { - hateFlags = TK_CONFIG_COLOR_ONLY; - } else { - hateFlags = TK_CONFIG_MONO_ONLY; + optionPtr = GetOptionFromObj(interp, namePtr, tablePtr); + if (optionPtr == NULL) { + return NULL; } - specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags); - if (specPtr == NULL) { - return TCL_ERROR; + if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) { + optionPtr = optionPtr->extra.synonymPtr; } - interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec, - interp->result, &interp->freeProc); - return TCL_OK; + if (optionPtr->specPtr->objOffset >= 0) { + resultPtr = *((Tcl_Obj **) (recordPtr + optionPtr->specPtr->objOffset)); + if (resultPtr == NULL) { + /* + * This option has a null value and is represented by a null + * object pointer. We can't return the null pointer, since that + * would indicate an error. Instead, return a new empty object. + */ + + resultPtr = Tcl_NewObj(); + } + } else { + resultPtr = GetObjectForOption(recordPtr, optionPtr, tkwin); + } + return resultPtr; } /* *---------------------------------------------------------------------- * - * Tk_FreeOptions -- + * TkDebugConfig -- * - * Free up all resources associated with configuration options. + * This is a debugging procedure that returns information about + * one of the configuration tables that currently exists for an + * interpreter. * * Results: - * None. + * If the specified table exists in the given interpreter, then a + * list is returned describing the table and any other tables that + * it chains to: for each table there will be three list elements + * giving the reference count for the table, the number of elements + * in the table, and the command-line name for the first option + * in the table. If the table doesn't exist in the interpreter + * then an empty object is returned. The reference count for the + * returned object is 0. * * Side effects: - * Any resource in widgRec that is controlled by a configuration - * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate - * fashion. + * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ -void -Tk_FreeOptions(specs, widgRec, display, needFlags) - Tk_ConfigSpec *specs; /* Describes legal options. */ - char *widgRec; /* Record whose fields contain current - * values for options. */ - Display *display; /* X display; needed for freeing some - * resources. */ - int needFlags; /* Used to specify additional flags - * that must be present in config specs - * for them to be considered. */ +Tcl_Obj * +TkDebugConfig(interp, table) + Tcl_Interp *interp; /* Interpreter in which the table is + * defined. */ + Tk_OptionTable table; /* Table about which information is to + * be returned. May not necessarily + * exist in the interpreter anymore. */ { - register Tk_ConfigSpec *specPtr; - char *ptr; + OptionTable *tablePtr = (OptionTable *) table; + Tcl_HashTable *hashTablePtr; + Tcl_HashEntry *hashEntryPtr; + Tcl_HashSearch search; + Tcl_Obj *objPtr; - for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { - if ((specPtr->specFlags & needFlags) != needFlags) { - continue; - } - ptr = widgRec + specPtr->offset; - switch (specPtr->type) { - case TK_CONFIG_STRING: - if (*((char **) ptr) != NULL) { - ckfree(*((char **) ptr)); - *((char **) ptr) = NULL; - } - break; - case TK_CONFIG_COLOR: - if (*((XColor **) ptr) != NULL) { - Tk_FreeColor(*((XColor **) ptr)); - *((XColor **) ptr) = NULL; - } - break; - case TK_CONFIG_FONT: - Tk_FreeFont(*((Tk_Font *) ptr)); - *((Tk_Font *) ptr) = NULL; - break; - case TK_CONFIG_BITMAP: - if (*((Pixmap *) ptr) != None) { - Tk_FreeBitmap(display, *((Pixmap *) ptr)); - *((Pixmap *) ptr) = None; - } - break; - case TK_CONFIG_BORDER: - if (*((Tk_3DBorder *) ptr) != NULL) { - Tk_Free3DBorder(*((Tk_3DBorder *) ptr)); - *((Tk_3DBorder *) ptr) = NULL; - } - break; - case TK_CONFIG_CURSOR: - case TK_CONFIG_ACTIVE_CURSOR: - if (*((Tk_Cursor *) ptr) != None) { - Tk_FreeCursor(display, *((Tk_Cursor *) ptr)); - *((Tk_Cursor *) ptr) = None; - } + objPtr = Tcl_NewObj(); + hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY, + NULL); + if (hashTablePtr == NULL) { + return objPtr; + } + + /* + * Scan all the tables for this interpreter to make sure that the + * one we want still is valid. + */ + + for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search); + hashEntryPtr != NULL; + hashEntryPtr = Tcl_NextHashEntry(&search)) { + if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) { + for ( ; tablePtr != NULL; tablePtr = tablePtr->nextPtr) { + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_NewIntObj(tablePtr->refCount)); + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_NewIntObj(tablePtr->numOptions)); + Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_NewStringObj( + tablePtr->options[0].specPtr->optionName, + -1)); + } + break; } } + return objPtr; } diff --git a/generic/tkConsole.c b/generic/tkConsole.c index 810847e..cbbef79 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -10,13 +10,14 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkConsole.c,v 1.4 1999/03/10 07:04:39 stanton Exp $ + * RCS: @(#) $Id: tkConsole.c,v 1.5 1999/04/16 01:51:13 stanton Exp $ */ #include "tk.h" -#include "tkInt.h" #include <string.h> +#include "tkInt.h" + /* * A data structure of the following type holds information for each console * which a handler (i.e. a Tcl command) has been defined for a particular @@ -28,7 +29,10 @@ typedef struct ConsoleInfo { Tcl_Interp *interp; /* Interpreter to send console commands. */ } ConsoleInfo; -static Tcl_Interp *gStdoutInterp = NULL; +typedef struct ThreadSpecificData { + Tcl_Interp *gStdoutInterp; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations for procedures defined later in this file: @@ -36,7 +40,6 @@ static Tcl_Interp *gStdoutInterp = NULL; * The first three will be used in the tk app shells... */ -void TkConsoleCreate _ANSI_ARGS_((void)); void TkConsoleCreate_ _ANSI_ARGS_((void)); int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp)); void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp, @@ -101,10 +104,10 @@ void TkConsoleCreate() { /* - * This function is being disabled so we don't end up calling it - * twice. Once from WinMain() and once from Tk_Main(). The real - * function is now TkConsoleCreate_ and is only called from Tk_Main. - * All of is an ugly hack. + * This function is being diabled so we don't end up calling it + * twice. Once from WinMain() and once from Tk_MainEx(). The real + * function is now tkCreateConsole_ and is only called from Tk_MainEx. + * All of this is an ugly hack. */ } @@ -113,27 +116,50 @@ TkConsoleCreate_() { Tcl_Channel consoleChannel; - consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0", - (ClientData) TCL_STDIN, TCL_READABLE); - if (consoleChannel != NULL) { - Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf"); - Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none"); + /* + * check for STDIN, otherwise create it + */ + + if (Tcl_GetStdChannel(TCL_STDIN) == NULL) { + consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0", + (ClientData) TCL_STDIN, 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_SetStdChannel(consoleChannel, TCL_STDIN); } - Tcl_SetStdChannel(consoleChannel, TCL_STDIN); - consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1", - (ClientData) TCL_STDOUT, TCL_WRITABLE); - if (consoleChannel != NULL) { - Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf"); - Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none"); + + /* + * check for STDOUT, otherwise create it + */ + + if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) { + consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1", + (ClientData) TCL_STDOUT, 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_SetStdChannel(consoleChannel, TCL_STDOUT); } - Tcl_SetStdChannel(consoleChannel, TCL_STDOUT); - consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2", - (ClientData) TCL_STDERR, TCL_WRITABLE); - if (consoleChannel != NULL) { - Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf"); - Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none"); + + /* + * check for STDERR, otherwise create it + */ + + if (Tcl_GetStdChannel(TCL_STDERR) == NULL) { + consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2", + (ClientData) TCL_STDERR, 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_SetStdChannel(consoleChannel, TCL_STDERR); } - Tcl_SetStdChannel(consoleChannel, TCL_STDERR); } /* @@ -161,6 +187,8 @@ TkConsoleInit(interp) Tcl_Interp *consoleInterp; ConsoleInfo *info; Tk_Window mainWindow = Tk_MainWindow(interp); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); #ifdef MAC_TCL static char initCmd[] = "source -rsrc {Console}"; #else @@ -168,7 +196,6 @@ TkConsoleInit(interp) #endif consoleInterp = Tcl_CreateInterp(); - if (consoleInterp == NULL) { goto error; } @@ -183,7 +210,7 @@ TkConsoleInit(interp) if (Tk_Init(consoleInterp) != TCL_OK) { goto error; } - gStdoutInterp = interp; + tsdPtr->gStdoutInterp = interp; /* * Add console commands to the interp @@ -239,11 +266,15 @@ ConsoleOutput(instanceData, buf, toWrite, errorCode) int toWrite; /* How many bytes to write? */ int *errorCode; /* Where to store error code. */ { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + *errorCode = 0; Tcl_SetErrno(0); - if (gStdoutInterp != NULL) { - TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite); + if (tsdPtr->gStdoutInterp != NULL) { + TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf, + toWrite); } return toWrite; @@ -390,6 +421,7 @@ ConsoleCmd(clientData, interp, argc, argv) int length; int result; Tcl_Interp *consoleInterp; + Tcl_DString dString; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -402,20 +434,20 @@ ConsoleCmd(clientData, interp, argc, argv) result = TCL_OK; consoleInterp = info->consoleInterp; Tcl_Preserve((ClientData) consoleInterp); + Tcl_DStringInit(&dString); + if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) { - Tcl_DString dString; - - Tcl_DStringInit(&dString); Tcl_DStringAppend(&dString, "wm title . ", -1); if (argc == 3) { Tcl_DStringAppendElement(&dString, argv[2]); } Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString)); - Tcl_DStringFree(&dString); } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) { - Tcl_Eval(consoleInterp, "wm withdraw ."); + Tcl_DStringAppend(&dString, "wm withdraw . ", -1); + Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString)); } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) { - Tcl_Eval(consoleInterp, "wm deiconify ."); + Tcl_DStringAppend(&dString, "wm deiconify . ", -1); + Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString)); } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) { if (argc == 3) { result = Tcl_Eval(consoleInterp, argv[2]); @@ -432,6 +464,7 @@ ConsoleCmd(clientData, interp, argc, argv) (char *) NULL); result = TCL_ERROR; } + Tcl_DStringFree(&dString); Tcl_Release((ClientData) consoleInterp); return result; } @@ -547,9 +580,13 @@ ConsoleEventProc(clientData, eventPtr) { ConsoleInfo *info = (ConsoleInfo *) clientData; Tcl_Interp *consoleInterp; + Tcl_DString dString; if (eventPtr->type == DestroyNotify) { - consoleInterp = info->consoleInterp; + + Tcl_DStringInit(&dString); + + consoleInterp = info->consoleInterp; /* * It is possible that the console interpreter itself has @@ -562,7 +599,9 @@ ConsoleEventProc(clientData, eventPtr) return; } Tcl_Preserve((ClientData) consoleInterp); - Tcl_Eval(consoleInterp, "tkConsoleExit"); + Tcl_DStringAppend(&dString, "tkConsoleExit", -1); + Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString)); + Tcl_DStringFree(&dString); Tcl_Release((ClientData) consoleInterp); } } diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 297cd3e..87b284d 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -6,12 +6,12 @@ * also avoids round-trips to the X server. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCursor.c,v 1.2 1998/09/14 18:23:09 stanton Exp $ + * RCS: @(#) $Id: tkCursor.c,v 1.3 1999/04/16 01:51:13 stanton Exp $ */ #include "tkPort.h" @@ -20,28 +20,11 @@ /* * A TkCursor structure exists for each cursor that is currently * active. Each structure is indexed with two hash tables defined - * below. One of the tables is idTable, and the other is either - * nameTable or dataTable, also defined below. + * below. One of the tables is cursorIdTable, and the other is either + * cursorNameTable or cursorDataTable, each of which are stored in the + * TkDisplay structure for the current thread. */ -/* - * Hash table to map from a textual description of a cursor to the - * TkCursor record for the cursor, and key structure used in that - * hash table: - */ - -static Tcl_HashTable nameTable; -typedef struct { - Tk_Uid name; /* Textual name for desired cursor. */ - Display *display; /* Display for which cursor will be used. */ -} NameKey; - -/* - * Hash table to map from a collection of in-core data about a - * cursor (bitmap contents, etc.) to a TkCursor structure: - */ - -static Tcl_HashTable dataTable; typedef struct { char *source; /* Cursor bits. */ char *mask; /* Mask bits. */ @@ -53,24 +36,129 @@ typedef struct { } DataKey; /* - * Hash table that maps from <display + cursor id> to the TkCursor structure - * for the cursor. This table is used by Tk_FreeCursor. + * Forward declarations for procedures defined in this file: */ -static Tcl_HashTable idTable; -typedef struct { - Display *display; /* Display for which cursor was allocated. */ - Tk_Cursor cursor; /* Cursor identifier. */ -} IdKey; +static void CursorInit _ANSI_ARGS_((TkDisplay *dispPtr)); +static void DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr, + Tcl_Obj *dupObjPtr)); +static void FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr)); +static void FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr)); +static TkCursor * GetCursor _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, char *name)); +static TkCursor * GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj *objPtr)); +static void InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr)); -static int initialized = 0; /* 0 means static structures haven't been - * initialized yet. */ +/* + * The following structure defines the implementation of the "cursor" Tcl + * object, used for drawing. The color object remembers the hash table + * entry associated with a color. The actual allocation and deallocation + * of the color should be done by the configuration package when the cursor + * option is set. + */ +static Tcl_ObjType cursorObjType = { + "cursor", /* name */ + FreeCursorObjProc, /* freeIntRepProc */ + DupCursorObjProc, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + /* - * Forward declarations for procedures defined in this file: + *---------------------------------------------------------------------- + * + * Tk_AllocCursorFromObj -- + * + * Given a Tcl_Obj *, map the value to a corresponding + * Tk_Cursor structure based on the tkwin given. + * + * Results: + * The return value is the X identifer for the desired cursor, + * unless objPtr couldn't be parsed correctly. In this case, + * None is returned and an error message is left in the interp's result. + * The caller should never modify the cursor that is returned, and + * should eventually call Tk_FreeCursorFromObj when the cursor is no + * longer needed. + * + * Side effects: + * The cursor is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeCursorFromObj, so that the database can be cleaned up + * when cursors aren't needed anymore. + * + *---------------------------------------------------------------------- */ -static void CursorInit _ANSI_ARGS_((void)); +Tk_Cursor +Tk_AllocCursorFromObj(interp, tkwin, objPtr) + Tcl_Interp *interp; /* Interp for error results. */ + Tk_Window tkwin; /* Window in which the cursor will be used.*/ + Tcl_Obj *objPtr; /* Object describing cursor; see manual + * entry for description of legal + * syntax of this obj's string rep. */ +{ + TkCursor *cursorPtr; + + if (objPtr->typePtr != &cursorObjType) { + InitCursorObj(objPtr); + } + cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + + /* + * If the object currently points to a TkCursor, see if it's the + * one we want. If so, increment its reference count and return. + */ + + if (cursorPtr != NULL) { + if (cursorPtr->resourceRefCount == 0) { + /* + * This is a stale reference: it refers to a TkCursor that's + * no longer in use. Clear the reference. + */ + FreeCursorObjProc(objPtr); + cursorPtr = NULL; + } else if (Tk_Display(tkwin) == cursorPtr->display) { + cursorPtr->resourceRefCount++; + return cursorPtr->cursor; + } + } + + /* + * The object didn't point to the TkCursor that we wanted. Search + * the list of TkCursors with the same name to see if one of the + * other TkCursors is the right one. + */ + + if (cursorPtr != NULL) { + TkCursor *firstCursorPtr = + (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr); + FreeCursorObjProc(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; + return cursorPtr->cursor; + } + } + } + + /* + * Still no luck. Call GetCursor to allocate a new TkCursor object. + */ + + cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr)); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + if (cursorPtr == NULL) { + return None; + } else { + cursorPtr->objRefCount++; + return cursorPtr->cursor; + } +} /* *---------------------------------------------------------------------- @@ -83,7 +171,7 @@ static void CursorInit _ANSI_ARGS_((void)); * Results: * The return value is the X identifer for the desired cursor, * unless string couldn't be parsed correctly. In this case, - * None is returned and an error message is left in interp->result. + * None is returned and an error message is left in the interp's result. * The caller should never modify the cursor that is returned, and * should eventually call Tk_FreeCursor when the cursor is no longer * needed. @@ -101,52 +189,103 @@ Tk_Cursor Tk_GetCursor(interp, tkwin, string) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ Tk_Window tkwin; /* Window in which cursor will be used. */ - Tk_Uid string; /* Description of cursor. See manual entry + char *string; /* Description of cursor. See manual entry + * for details on legal syntax. */ +{ + TkCursor *cursorPtr = GetCursor(interp, tkwin, string); + if (cursorPtr == NULL) { + return None; + } + return cursorPtr->cursor; +} + +/* + *---------------------------------------------------------------------- + * + * GetCursor -- + * + * Given a string describing a cursor, locate (or create if necessary) + * a cursor that fits the description. This routine returns the + * internal data structure for the cursor, which avoids extra + * hash table lookups in Tk_AllocCursorFromObj. + * + * Results: + * The return value is a pointer to the TkCursor for the desired + * cursor, unless string couldn't be parsed correctly. In this + * case, NULL is returned and an error message is left in the + * interp's result. The caller should never modify the cursor that + * is returned, and should eventually call Tk_FreeCursor when the + * cursor is no longer needed. + * + * Side effects: + * The cursor is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeCursor, so that the database can be cleaned up when cursors + * aren't needed anymore. + * + *---------------------------------------------------------------------- + */ + +static TkCursor * +GetCursor(interp, tkwin, string) + Tcl_Interp *interp; /* Interpreter to use for error reporting. */ + Tk_Window tkwin; /* Window in which cursor will be used. */ + char *string; /* Description of cursor. See manual entry * for details on legal syntax. */ { - NameKey nameKey; - IdKey idKey; - Tcl_HashEntry *nameHashPtr, *idHashPtr; + Tcl_HashEntry *nameHashPtr; register TkCursor *cursorPtr; + TkCursor *existingCursorPtr = NULL; int new; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - CursorInit(); + if (!dispPtr->cursorInit) { + CursorInit(dispPtr); } - nameKey.name = string; - nameKey.display = Tk_Display(tkwin); - nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new); + nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable, + string, &new); if (!new) { - cursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr); - cursorPtr->refCount++; - return cursorPtr->cursor; + existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr); + for (cursorPtr = existingCursorPtr; cursorPtr != NULL; + cursorPtr = cursorPtr->nextPtr) { + if (Tk_Display(tkwin) == cursorPtr->display) { + cursorPtr->resourceRefCount++; + return cursorPtr; + } + } + } else { + existingCursorPtr = NULL; } cursorPtr = TkGetCursorByName(interp, tkwin, string); if (cursorPtr == NULL) { - Tcl_DeleteHashEntry(nameHashPtr); - return None; + if (new) { + Tcl_DeleteHashEntry(nameHashPtr); + } + return NULL; } /* * Add information about this cursor to our database. */ - cursorPtr->refCount = 1; - cursorPtr->otherTable = &nameTable; + cursorPtr->display = Tk_Display(tkwin); + cursorPtr->resourceRefCount = 1; + cursorPtr->objRefCount = 0; + cursorPtr->otherTable = &dispPtr->cursorNameTable; cursorPtr->hashPtr = nameHashPtr; - idKey.display = nameKey.display; - idKey.cursor = cursorPtr->cursor; - idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new); + cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, + (char *) cursorPtr->cursor, &new); if (!new) { panic("cursor already registered in Tk_GetCursor"); } + cursorPtr->nextPtr = existingCursorPtr; Tcl_SetHashValue(nameHashPtr, cursorPtr); - Tcl_SetHashValue(idHashPtr, cursorPtr); + Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr); - return cursorPtr->cursor; + return cursorPtr; } /* @@ -160,7 +299,7 @@ Tk_GetCursor(interp, tkwin, string) * Results: * The return value is the X identifer for the desired cursor, * unless it couldn't be created properly. In this case, None is - * returned and an error message is left in interp->result. The + * returned and an error message is left in the interp's result. The * caller should never modify the cursor that is returned, and * should eventually call Tk_FreeCursor when the cursor is no * longer needed. @@ -187,14 +326,15 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, Tk_Uid bg; /* Background color for cursor. */ { DataKey dataKey; - IdKey idKey; - Tcl_HashEntry *dataHashPtr, *idHashPtr; + Tcl_HashEntry *dataHashPtr; register TkCursor *cursorPtr; int new; XColor fgColor, bgColor; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - CursorInit(); + + if (!dispPtr->cursorInit) { + CursorInit(dispPtr); } dataKey.source = source; @@ -206,10 +346,11 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, dataKey.fg = fg; dataKey.bg = bg; dataKey.display = Tk_Display(tkwin); - dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &dataKey, &new); + dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable, + (char *) &dataKey, &new); if (!new) { cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr); - cursorPtr->refCount++; + cursorPtr->resourceRefCount++; return cursorPtr->cursor; } @@ -236,17 +377,18 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, goto error; } - cursorPtr->refCount = 1; - cursorPtr->otherTable = &dataTable; + cursorPtr->resourceRefCount = 1; + cursorPtr->otherTable = &dispPtr->cursorDataTable; cursorPtr->hashPtr = dataHashPtr; - idKey.display = dataKey.display; - idKey.cursor = cursorPtr->cursor; - idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new); + cursorPtr->objRefCount = 0; + cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, + (char *) cursorPtr->cursor, &new); + if (!new) { panic("cursor already registered in Tk_GetCursorFromData"); } Tcl_SetHashValue(dataHashPtr, cursorPtr); - Tcl_SetHashValue(idHashPtr, cursorPtr); + Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr); return cursorPtr->cursor; error: @@ -281,27 +423,77 @@ Tk_NameOfCursor(display, cursor) Tk_Cursor cursor; /* Identifier for cursor whose name is * wanted. */ { - IdKey idKey; Tcl_HashEntry *idHashPtr; TkCursor *cursorPtr; - static char string[20]; + TkDisplay *dispPtr; - if (!initialized) { + dispPtr = TkGetDisplay(display); + + if (!dispPtr->cursorInit) { printid: - sprintf(string, "cursor id 0x%x", (unsigned int) cursor); - return string; + sprintf(dispPtr->cursorString, "cursor id 0x%x", + (unsigned int) cursor); + return dispPtr->cursorString; } - idKey.display = display; - idKey.cursor = cursor; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor); if (idHashPtr == NULL) { goto printid; } cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr); - if (cursorPtr->otherTable != &nameTable) { + if (cursorPtr->otherTable != &dispPtr->cursorNameTable) { goto printid; } - return ((NameKey *) cursorPtr->hashPtr->key.words)->name; + return cursorPtr->hashPtr->key.string; +} + +/* + *---------------------------------------------------------------------- + * + * FreeCursor -- + * + * This procedure is invoked by both Tk_FreeCursor and + * Tk_FreeCursorFromObj; it does all the real work of deallocating + * a cursor. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with cursor is decremented, and + * it is officially deallocated if no-one is using it anymore. + * + *---------------------------------------------------------------------- + */ + +static void +FreeCursor(cursorPtr) + TkCursor *cursorPtr; /* Cursor to be released. */ +{ + TkCursor *prevPtr; + + cursorPtr->resourceRefCount--; + if (cursorPtr->resourceRefCount > 0) { + return; + } + + Tcl_DeleteHashEntry(cursorPtr->idHashPtr); + prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr); + if (prevPtr == cursorPtr) { + if (cursorPtr->nextPtr == NULL) { + Tcl_DeleteHashEntry(cursorPtr->hashPtr); + } else { + Tcl_SetHashValue(cursorPtr->hashPtr, cursorPtr->nextPtr); + } + } else { + while (prevPtr->nextPtr != cursorPtr) { + prevPtr = prevPtr->nextPtr; + } + prevPtr->nextPtr = cursorPtr->nextPtr; + } + TkpFreeCursor(cursorPtr); + if (cursorPtr->objRefCount == 0) { + ckfree((char *) cursorPtr); + } } /* @@ -327,32 +519,258 @@ Tk_FreeCursor(display, cursor) Display *display; /* Display for which cursor was allocated. */ Tk_Cursor cursor; /* Identifier for cursor to be released. */ { - IdKey idKey; Tcl_HashEntry *idHashPtr; - register TkCursor *cursorPtr; + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { + if (!dispPtr->cursorInit) { panic("Tk_FreeCursor called before Tk_GetCursor"); } - idKey.display = display; - idKey.cursor = cursor; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor); if (idHashPtr == NULL) { panic("Tk_FreeCursor received unknown cursor argument"); } - cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr); - cursorPtr->refCount--; - if (cursorPtr->refCount == 0) { - Tcl_DeleteHashEntry(cursorPtr->hashPtr); - Tcl_DeleteHashEntry(idHashPtr); - TkFreeCursor(cursorPtr); + FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr)); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_FreeCursorFromObj -- + * + * This procedure is called to release a cursor allocated by + * Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *; + * it only gets rid of the hash table entry for this cursor + * and clears the cached value that is normally stored in the object. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with the cursor represented by + * objPtr is decremented, and the cursor is released to X if there are + * no remaining uses for it. + * + *---------------------------------------------------------------------- + */ + +void +Tk_FreeCursorFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window this cursor lives in. Needed + * for the display value. */ + Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */ +{ + FreeCursor(GetCursorFromObj(tkwin, objPtr)); +} + +/* + *--------------------------------------------------------------------------- + * + * FreeCursorFromObjProc -- + * + * 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 tkColPtr needs to be changed. + * + * Results: + * None. + * + * Side effects: + * The object reference count is decremented. When both it + * and the hash ref count go to zero, the color's resources + * are released. + * + *--------------------------------------------------------------------------- + */ + +static void +FreeCursorObjProc(objPtr) + Tcl_Obj *objPtr; /* The object we are releasing. */ +{ + TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + + if (cursorPtr != NULL) { + cursorPtr->objRefCount--; + if ((cursorPtr->objRefCount == 0) + && (cursorPtr->resourceRefCount == 0)) { + ckfree((char *) cursorPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; + } +} + +/* + *--------------------------------------------------------------------------- + * + * DupCursorObjProc -- + * + * When a cached cursor object is duplicated, this is called to + * update the internal reps. + * + * Results: + * None. + * + * Side effects: + * The color's objRefCount is incremented and the internal rep + * of the copy is set to point to it. + * + *--------------------------------------------------------------------------- + */ + +static void +DupCursorObjProc(srcObjPtr, dupObjPtr) + 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; + + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + + if (cursorPtr != NULL) { + cursorPtr->objRefCount++; } } /* *---------------------------------------------------------------------- * + * Tk_GetCursorFromObj -- + * + * Returns the cursor referred to buy a Tcl object. The cursor must + * already have been allocated via a call to Tk_AllocCursorFromObj or + * Tk_GetCursor. + * + * Results: + * Returns the Tk_Cursor that matches the tkwin and the string rep + * of the name of the cursor given in objPtr. + * + * Side effects: + * If the object is not already a cursor, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +Tk_Cursor +Tk_GetCursorFromObj(tkwin, objPtr) + Tk_Window tkwin; + Tcl_Obj *objPtr; /* The object from which to get pixels. */ +{ + TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr); + return cursorPtr->cursor; +} + +/* + *---------------------------------------------------------------------- + * + * GetCursorFromObj -- + * + * Returns the cursor referred to by a Tcl object. The cursor must + * already have been allocated via a call to Tk_AllocCursorFromObj + * or Tk_GetCursor. + * + * Results: + * Returns the TkCursor * that matches the tkwin and the string rep + * of the name of the cursor given in objPtr. + * + * Side effects: + * If the object is not already a cursor, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +static TkCursor * +GetCursorFromObj(tkwin, objPtr) + Tk_Window tkwin; /* Window in which the cursor will be used. */ + Tcl_Obj *objPtr; /* The object that describes the desired + * cursor. */ +{ + TkCursor *cursorPtr; + Tcl_HashEntry *hashPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + if (objPtr->typePtr != &cursorObjType) { + InitCursorObj(objPtr); + } + + cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + if (cursorPtr != NULL) { + if (Tk_Display(tkwin) == cursorPtr->display) { + return cursorPtr; + } + hashPtr = cursorPtr->hashPtr; + } else { + hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, + Tcl_GetString(objPtr)); + if (hashPtr == NULL) { + goto error; + } + } + + /* + * At this point we've got a hash table entry, off of which hang + * one or more TkCursor structures. See if any of them will work. + */ + + for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr); + cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { + if (Tk_Display(tkwin) != cursorPtr->display) { + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + cursorPtr->objRefCount++; + return cursorPtr; + } + } + + error: + panic("GetCursorFromObj called with non-existent cursor!"); + /* + * The following code isn't reached; it's just there to please compilers. + */ + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * InitCursorObj -- + * + * Bookeeping procedure to change an objPtr to a cursor type. + * + * Results: + * None. + * + * Side effects: + * The old internal rep of the object is freed. The internal + * rep is cleared. The final form of the object is set + * by either Tk_AllocCursorFromObj or GetCursorFromObj. + * + *---------------------------------------------------------------------- + */ + +static void +InitCursorObj(objPtr) + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + + /* + * Free the old internalRep before setting the new one. + */ + + Tcl_GetString(objPtr); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &cursorObjType; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; +} + +/* + *---------------------------------------------------------------------- + * * CursorInit -- * * Initialize the structures used for cursor management. @@ -367,11 +785,11 @@ Tk_FreeCursor(display, cursor) */ static void -CursorInit() +CursorInit(dispPtr) + TkDisplay *dispPtr; /* Display used to store thread-specific data. */ { - initialized = 1; - Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int)); - Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int)); + Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int)); /* * The call below is tricky: can't use sizeof(IdKey) because it @@ -379,6 +797,66 @@ CursorInit() * machines. */ - Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Tk_Cursor)) - /sizeof(int)); + /* + * Old code.... + * Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *) + * /sizeof(int)); + * + * The comment above doesn't make sense. + * However, XIDs should only be 32 bits, by the definition of X, + * so the code above causes Tk to crash. Here is the real code: + */ + + Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS); + + dispPtr->cursorInit = 1; +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugCursor -- + * + * This procedure returns debugging information about a cursor. + * + * Results: + * The return value is a list with one sublist for each TkCursor + * corresponding to "name". Each sublist has two elements that + * contain the resourceRefCount and objRefCount fields from the + * TkCursor structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkDebugCursor(tkwin, name) + Tk_Window tkwin; /* The window in which the cursor will be + * used (not currently used). */ + char *name; /* Name of the desired color. */ +{ + TkCursor *cursorPtr; + Tcl_HashEntry *hashPtr; + Tcl_Obj *resultPtr, *objPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + resultPtr = Tcl_NewObj(); + hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name); + if (hashPtr != NULL) { + cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr); + if (cursorPtr == NULL) { + panic("TkDebugCursor found empty hash table entry"); + } + for ( ; (cursorPtr != NULL); cursorPtr = cursorPtr->nextPtr) { + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(cursorPtr->resourceRefCount)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(cursorPtr->objRefCount)); + Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); + } + } + return resultPtr; } diff --git a/generic/tkDecls.h b/generic/tkDecls.h index ba3512c..f0bf66f 100644 --- a/generic/tkDecls.h +++ b/generic/tkDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkDecls.h,v 1.2 1999/03/10 07:04:39 stanton Exp $ + * RCS: @(#) $Id: tkDecls.h,v 1.3 1999/04/16 01:51:13 stanton Exp $ */ #ifndef _TKDECLS @@ -66,7 +66,7 @@ EXTERN void Tk_CanvasEventuallyRedraw _ANSI_ARGS_(( int y2)); /* 9 */ EXTERN int Tk_CanvasGetCoord _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Canvas canvas, char * string, + Tk_Canvas canvas, char * str, double * doublePtr)); /* 10 */ EXTERN Tk_CanvasTextInfo * Tk_CanvasGetTextInfo _ANSI_ARGS_(( @@ -146,7 +146,7 @@ EXTERN void Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin, XWindowChanges * valuePtr)); /* 31 */ EXTERN Tk_TextLayout Tk_ComputeTextLayout _ANSI_ARGS_((Tk_Font font, - CONST char * string, int numChars, + CONST char * str, int numChars, int wrapLength, Tk_Justify justify, int flags, int * widthPtr, int * heightPtr)); /* 32 */ @@ -155,7 +155,7 @@ EXTERN Tk_Window Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY, /* 33 */ EXTERN unsigned long Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, - ClientData object, char * eventString, + ClientData object, char * eventStr, char * command, int append)); /* 34 */ EXTERN Tk_BindingTable Tk_CreateBindingTable _ANSI_ARGS_(( @@ -195,7 +195,7 @@ EXTERN Tk_Window Tk_CreateWindowFromPath _ANSI_ARGS_(( char * pathName, char * screenName)); /* 44 */ EXTERN int Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Uid name, char * source, int width, + CONST char * name, char * source, int width, int height)); /* 45 */ EXTERN void Tk_DefineCursor _ANSI_ARGS_((Tk_Window window, @@ -207,7 +207,7 @@ EXTERN void Tk_DeleteAllBindings _ANSI_ARGS_(( /* 47 */ EXTERN int Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, - ClientData object, char * eventString)); + ClientData object, char * eventStr)); /* 48 */ EXTERN void Tk_DeleteBindingTable _ANSI_ARGS_(( Tk_BindingTable bindingTable)); @@ -247,7 +247,7 @@ EXTERN void Tk_Draw3DRectangle _ANSI_ARGS_((Tk_Window tkwin, /* 59 */ EXTERN void Tk_DrawChars _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, - CONST char * source, int numChars, int x, + CONST char * source, int numBytes, int x, int y)); /* 60 */ EXTERN void Tk_DrawFocusHighlight _ANSI_ARGS_((Tk_Window tkwin, @@ -318,24 +318,24 @@ EXTERN void Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp * interp, ClientData object)); /* 82 */ EXTERN int Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp * interp, - char * string, Tk_Anchor * anchorPtr)); + char * str, Tk_Anchor * anchorPtr)); /* 83 */ EXTERN char * Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin, Atom atom)); /* 84 */ EXTERN char * Tk_GetBinding _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, - ClientData object, char * eventString)); + ClientData object, char * eventStr)); /* 85 */ EXTERN Pixmap Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, Tk_Uid string)); + Tk_Window tkwin, CONST char * str)); /* 86 */ EXTERN Pixmap Tk_GetBitmapFromData _ANSI_ARGS_(( Tcl_Interp * interp, Tk_Window tkwin, char * source, int width, int height)); /* 87 */ EXTERN int Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int * capPtr)); + char * str, int * capPtr)); /* 88 */ EXTERN XColor * Tk_GetColor _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid name)); @@ -344,10 +344,10 @@ EXTERN XColor * Tk_GetColorByValue _ANSI_ARGS_((Tk_Window tkwin, XColor * colorPtr)); /* 90 */ EXTERN Colormap Tk_GetColormap _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, char * string)); + Tk_Window tkwin, char * str)); /* 91 */ EXTERN Tk_Cursor Tk_GetCursor _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, Tk_Uid string)); + Tk_Window tkwin, Tk_Uid str)); /* 92 */ EXTERN Tk_Cursor Tk_GetCursorFromData _ANSI_ARGS_(( Tcl_Interp * interp, Tk_Window tkwin, @@ -356,10 +356,10 @@ EXTERN Tk_Cursor Tk_GetCursorFromData _ANSI_ARGS_(( Tk_Uid bg)); /* 93 */ EXTERN Tk_Font Tk_GetFont _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, CONST char * string)); + Tk_Window tkwin, CONST char * str)); /* 94 */ -EXTERN Tk_Font Tk_GetFontFromObj _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, Tcl_Obj * objPtr)); +EXTERN Tk_Font Tk_GetFontFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); /* 95 */ EXTERN void Tk_GetFontMetrics _ANSI_ARGS_((Tk_Font font, Tk_FontMetrics * fmPtr)); @@ -380,10 +380,10 @@ EXTERN ClientData Tk_GetImageMasterData _ANSI_ARGS_(( EXTERN Tk_ItemType * Tk_GetItemTypes _ANSI_ARGS_((void)); /* 100 */ EXTERN int Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int * joinPtr)); + char * str, int * joinPtr)); /* 101 */ EXTERN int Tk_GetJustify _ANSI_ARGS_((Tcl_Interp * interp, - char * string, Tk_Justify * justifyPtr)); + char * str, Tk_Justify * justifyPtr)); /* 102 */ EXTERN int Tk_GetNumMainWindows _ANSI_ARGS_((void)); /* 103 */ @@ -391,7 +391,7 @@ EXTERN Tk_Uid Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin, char * name, char * className)); /* 104 */ EXTERN int Tk_GetPixels _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, char * string, int * intPtr)); + Tk_Window tkwin, char * str, int * intPtr)); /* 105 */ EXTERN Pixmap Tk_GetPixmap _ANSI_ARGS_((Display * display, Drawable d, int width, int height, int depth)); @@ -407,18 +407,18 @@ EXTERN int Tk_GetScrollInfo _ANSI_ARGS_((Tcl_Interp * interp, int * intPtr)); /* 109 */ EXTERN int Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, char * string, + Tk_Window tkwin, char * str, double * doublePtr)); /* 110 */ EXTERN int Tk_GetSelection _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc * proc, ClientData clientData)); /* 111 */ -EXTERN Tk_Uid Tk_GetUid _ANSI_ARGS_((CONST char * string)); +EXTERN Tk_Uid Tk_GetUid _ANSI_ARGS_((CONST char * str)); /* 112 */ EXTERN Visual * Tk_GetVisual _ANSI_ARGS_((Tcl_Interp * interp, - Tk_Window tkwin, char * string, - int * depthPtr, Colormap * colormapPtr)); + Tk_Window tkwin, char * str, int * depthPtr, + Colormap * colormapPtr)); /* 113 */ EXTERN void Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr, int * widthPtr, @@ -459,7 +459,7 @@ EXTERN void Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin, EXTERN void Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin)); /* 126 */ EXTERN int Tk_MeasureChars _ANSI_ARGS_((Tk_Font tkfont, - CONST char * source, int maxChars, + CONST char * source, int numBytes, int maxPixels, int flags, int * lengthPtr)); /* 127 */ EXTERN void Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin, @@ -611,14 +611,14 @@ EXTERN void Tk_TextLayoutToPostscript _ANSI_ARGS_(( Tcl_Interp * interp, Tk_TextLayout layout)); /* 176 */ EXTERN int Tk_TextWidth _ANSI_ARGS_((Tk_Font font, - CONST char * string, int numChars)); + CONST char * str, int numBytes)); /* 177 */ EXTERN void Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window)); /* 178 */ EXTERN void Tk_UnderlineChars _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int x, int y, - int firstChar, int lastChar)); + int firstByte, int lastByte)); /* 179 */ EXTERN void Tk_UnderlineTextLayout _ANSI_ARGS_(( Display * display, Drawable drawable, GC gc, @@ -636,6 +636,112 @@ EXTERN void Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin)); /* 184 */ EXTERN void Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int state)); +/* 185 */ +EXTERN Pixmap Tk_AllocBitmapFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 186 */ +EXTERN Tk_3DBorder Tk_Alloc3DBorderFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 187 */ +EXTERN XColor * Tk_AllocColorFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 188 */ +EXTERN Tk_Cursor Tk_AllocCursorFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 189 */ +EXTERN Tk_Font Tk_AllocFontFromObj _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, Tcl_Obj * objPtr)); +/* 190 */ +EXTERN Tk_OptionTable Tk_CreateOptionTable _ANSI_ARGS_(( + Tcl_Interp * interp, + CONST Tk_OptionSpec * templatePtr)); +/* 191 */ +EXTERN void Tk_DeleteOptionTable _ANSI_ARGS_(( + Tk_OptionTable optionTable)); +/* 192 */ +EXTERN void Tk_Free3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 193 */ +EXTERN void Tk_FreeBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 194 */ +EXTERN void Tk_FreeColorFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 195 */ +EXTERN void Tk_FreeConfigOptions _ANSI_ARGS_((char * recordPtr, + Tk_OptionTable optionToken, Tk_Window tkwin)); +/* 196 */ +EXTERN void Tk_FreeSavedOptions _ANSI_ARGS_(( + Tk_SavedOptions * savePtr)); +/* 197 */ +EXTERN void Tk_FreeCursorFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 198 */ +EXTERN void Tk_FreeFontFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 199 */ +EXTERN Tk_3DBorder Tk_Get3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 200 */ +EXTERN int Tk_GetAnchorFromObj _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Obj * objPtr, Tk_Anchor * anchorPtr)); +/* 201 */ +EXTERN Pixmap Tk_GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 202 */ +EXTERN XColor * Tk_GetColorFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 203 */ +EXTERN Tk_Cursor Tk_GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj * objPtr)); +/* 204 */ +EXTERN Tcl_Obj * Tk_GetOptionInfo _ANSI_ARGS_((Tcl_Interp * interp, + char * recordPtr, Tk_OptionTable optionTable, + Tcl_Obj * namePtr, Tk_Window tkwin)); +/* 205 */ +EXTERN Tcl_Obj * Tk_GetOptionValue _ANSI_ARGS_((Tcl_Interp * interp, + char * recordPtr, Tk_OptionTable optionTable, + Tcl_Obj * namePtr, Tk_Window tkwin)); +/* 206 */ +EXTERN int Tk_GetJustifyFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj * objPtr, + Tk_Justify * justifyPtr)); +/* 207 */ +EXTERN int Tk_GetMMFromObj _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, Tcl_Obj * objPtr, + double * doublePtr)); +/* 208 */ +EXTERN int Tk_GetPixelsFromObj _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, Tcl_Obj * objPtr, + int * intPtr)); +/* 209 */ +EXTERN int Tk_GetReliefFromObj _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Obj * objPtr, int * resultPtr)); +/* 210 */ +EXTERN int Tk_GetScrollInfoObj _ANSI_ARGS_((Tcl_Interp * interp, + int objc, Tcl_Obj *CONST objv[], + double * dblPtr, int * intPtr)); +/* 211 */ +EXTERN int Tk_InitOptions _ANSI_ARGS_((Tcl_Interp * interp, + char * recordPtr, Tk_OptionTable optionToken, + Tk_Window tkwin)); +/* 212 */ +EXTERN void Tk_MainEx _ANSI_ARGS_((int argc, char ** argv, + Tcl_AppInitProc * appInitProc, + Tcl_Interp * interp)); +/* 213 */ +EXTERN void Tk_RestoreSavedOptions _ANSI_ARGS_(( + Tk_SavedOptions * savePtr)); +/* 214 */ +EXTERN int Tk_SetOptions _ANSI_ARGS_((Tcl_Interp * interp, + char * recordPtr, Tk_OptionTable optionTable, + int objc, Tcl_Obj *CONST objv[], + Tk_Window tkwin, Tk_SavedOptions * savePtr, + int * maskPtr)); typedef struct TkStubHooks { struct TkPlatStubs *tkPlatStubs; @@ -657,7 +763,7 @@ typedef struct TkStubs { void (*tk_BindEvent) _ANSI_ARGS_((Tk_BindingTable bindingTable, XEvent * eventPtr, Tk_Window tkwin, int numObjects, ClientData * objectPtr)); /* 6 */ void (*tk_CanvasDrawableCoords) _ANSI_ARGS_((Tk_Canvas canvas, double x, double y, short * drawableXPtr, short * drawableYPtr)); /* 7 */ void (*tk_CanvasEventuallyRedraw) _ANSI_ARGS_((Tk_Canvas canvas, int x1, int y1, int x2, int y2)); /* 8 */ - int (*tk_CanvasGetCoord) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, char * string, double * doublePtr)); /* 9 */ + int (*tk_CanvasGetCoord) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, char * str, double * doublePtr)); /* 9 */ Tk_CanvasTextInfo * (*tk_CanvasGetTextInfo) _ANSI_ARGS_((Tk_Canvas canvas)); /* 10 */ int (*tk_CanvasPsBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Pixmap bitmap, int x, int y, int width, int height)); /* 11 */ int (*tk_CanvasPsColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, XColor * colorPtr)); /* 12 */ @@ -679,9 +785,9 @@ typedef struct TkStubs { int (*tk_ConfigureValue) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, char * widgRec, char * argvName, int flags)); /* 28 */ int (*tk_ConfigureWidget) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, int argc, char ** argv, char * widgRec, int flags)); /* 29 */ void (*tk_ConfigureWindow) _ANSI_ARGS_((Tk_Window tkwin, unsigned int valueMask, XWindowChanges * valuePtr)); /* 30 */ - Tk_TextLayout (*tk_ComputeTextLayout) _ANSI_ARGS_((Tk_Font font, CONST char * string, int numChars, int wrapLength, Tk_Justify justify, int flags, int * widthPtr, int * heightPtr)); /* 31 */ + Tk_TextLayout (*tk_ComputeTextLayout) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numChars, int wrapLength, Tk_Justify justify, int flags, int * widthPtr, int * heightPtr)); /* 31 */ Tk_Window (*tk_CoordsToWindow) _ANSI_ARGS_((int rootX, int rootY, Tk_Window tkwin)); /* 32 */ - unsigned long (*tk_CreateBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventString, char * command, int append)); /* 33 */ + unsigned long (*tk_CreateBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr, char * command, int append)); /* 33 */ Tk_BindingTable (*tk_CreateBindingTable) _ANSI_ARGS_((Tcl_Interp * interp)); /* 34 */ Tk_ErrorHandler (*tk_CreateErrorHandler) _ANSI_ARGS_((Display * display, int errNum, int request, int minorCode, Tk_ErrorProc * errorProc, ClientData clientData)); /* 35 */ void (*tk_CreateEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 36 */ @@ -692,10 +798,10 @@ typedef struct TkStubs { void (*tk_CreateSelHandler) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Atom target, Tk_SelectionProc * proc, ClientData clientData, Atom format)); /* 41 */ Tk_Window (*tk_CreateWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window parent, char * name, char * screenName)); /* 42 */ Tk_Window (*tk_CreateWindowFromPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * pathName, char * screenName)); /* 43 */ - int (*tk_DefineBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Uid name, char * source, int width, int height)); /* 44 */ + int (*tk_DefineBitmap) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, char * source, int width, int height)); /* 44 */ void (*tk_DefineCursor) _ANSI_ARGS_((Tk_Window window, Tk_Cursor cursor)); /* 45 */ void (*tk_DeleteAllBindings) _ANSI_ARGS_((Tk_BindingTable bindingTable, ClientData object)); /* 46 */ - int (*tk_DeleteBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventString)); /* 47 */ + int (*tk_DeleteBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr)); /* 47 */ void (*tk_DeleteBindingTable) _ANSI_ARGS_((Tk_BindingTable bindingTable)); /* 48 */ void (*tk_DeleteErrorHandler) _ANSI_ARGS_((Tk_ErrorHandler handler)); /* 49 */ void (*tk_DeleteEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 50 */ @@ -707,7 +813,7 @@ typedef struct TkStubs { int (*tk_DistanceToTextLayout) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y)); /* 56 */ void (*tk_Draw3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 57 */ void (*tk_Draw3DRectangle) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief)); /* 58 */ - void (*tk_DrawChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int numChars, int x, int y)); /* 59 */ + void (*tk_DrawChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int numBytes, int x, int y)); /* 59 */ void (*tk_DrawFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable)); /* 60 */ void (*tk_DrawTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int firstChar, int lastChar)); /* 61 */ void (*tk_Fill3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 62 */ @@ -730,37 +836,37 @@ typedef struct TkStubs { void (*tk_GeometryRequest) _ANSI_ARGS_((Tk_Window tkwin, int reqWidth, int reqHeight)); /* 79 */ Tk_3DBorder (*tk_Get3DBorder) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid colorName)); /* 80 */ void (*tk_GetAllBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object)); /* 81 */ - int (*tk_GetAnchor) _ANSI_ARGS_((Tcl_Interp * interp, char * string, Tk_Anchor * anchorPtr)); /* 82 */ + int (*tk_GetAnchor) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tk_Anchor * anchorPtr)); /* 82 */ char * (*tk_GetAtomName) _ANSI_ARGS_((Tk_Window tkwin, Atom atom)); /* 83 */ - char * (*tk_GetBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventString)); /* 84 */ - Pixmap (*tk_GetBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid string)); /* 85 */ + char * (*tk_GetBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr)); /* 84 */ + Pixmap (*tk_GetBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 85 */ Pixmap (*tk_GetBitmapFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * source, int width, int height)); /* 86 */ - int (*tk_GetCapStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int * capPtr)); /* 87 */ + int (*tk_GetCapStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * capPtr)); /* 87 */ XColor * (*tk_GetColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid name)); /* 88 */ XColor * (*tk_GetColorByValue) _ANSI_ARGS_((Tk_Window tkwin, XColor * colorPtr)); /* 89 */ - Colormap (*tk_GetColormap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * string)); /* 90 */ - Tk_Cursor (*tk_GetCursor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid string)); /* 91 */ + Colormap (*tk_GetColormap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str)); /* 90 */ + Tk_Cursor (*tk_GetCursor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid str)); /* 91 */ Tk_Cursor (*tk_GetCursorFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * source, char * mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg)); /* 92 */ - Tk_Font (*tk_GetFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * string)); /* 93 */ - Tk_Font (*tk_GetFontFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 94 */ + Tk_Font (*tk_GetFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 93 */ + Tk_Font (*tk_GetFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 94 */ void (*tk_GetFontMetrics) _ANSI_ARGS_((Tk_Font font, Tk_FontMetrics * fmPtr)); /* 95 */ GC (*tk_GetGC) _ANSI_ARGS_((Tk_Window tkwin, unsigned long valueMask, XGCValues * valuePtr)); /* 96 */ Tk_Image (*tk_GetImage) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * name, Tk_ImageChangedProc * changeProc, ClientData clientData)); /* 97 */ ClientData (*tk_GetImageMasterData) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tk_ImageType ** typePtrPtr)); /* 98 */ Tk_ItemType * (*tk_GetItemTypes) _ANSI_ARGS_((void)); /* 99 */ - int (*tk_GetJoinStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int * joinPtr)); /* 100 */ - int (*tk_GetJustify) _ANSI_ARGS_((Tcl_Interp * interp, char * string, Tk_Justify * justifyPtr)); /* 101 */ + int (*tk_GetJoinStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * joinPtr)); /* 100 */ + int (*tk_GetJustify) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tk_Justify * justifyPtr)); /* 101 */ int (*tk_GetNumMainWindows) _ANSI_ARGS_((void)); /* 102 */ Tk_Uid (*tk_GetOption) _ANSI_ARGS_((Tk_Window tkwin, char * name, char * className)); /* 103 */ - int (*tk_GetPixels) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * string, int * intPtr)); /* 104 */ + int (*tk_GetPixels) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, int * intPtr)); /* 104 */ Pixmap (*tk_GetPixmap) _ANSI_ARGS_((Display * display, Drawable d, int width, int height, int depth)); /* 105 */ int (*tk_GetRelief) _ANSI_ARGS_((Tcl_Interp * interp, char * name, int * reliefPtr)); /* 106 */ void (*tk_GetRootCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 107 */ int (*tk_GetScrollInfo) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, double * dblPtr, int * intPtr)); /* 108 */ - int (*tk_GetScreenMM) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * string, double * doublePtr)); /* 109 */ + int (*tk_GetScreenMM) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, double * doublePtr)); /* 109 */ int (*tk_GetSelection) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc * proc, ClientData clientData)); /* 110 */ - Tk_Uid (*tk_GetUid) _ANSI_ARGS_((CONST char * string)); /* 111 */ - Visual * (*tk_GetVisual) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * string, int * depthPtr, Colormap * colormapPtr)); /* 112 */ + Tk_Uid (*tk_GetUid) _ANSI_ARGS_((CONST char * str)); /* 111 */ + Visual * (*tk_GetVisual) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, int * depthPtr, Colormap * colormapPtr)); /* 112 */ void (*tk_GetVRootGeometry) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 113 */ int (*tk_Grab) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, int grabGlobal)); /* 114 */ void (*tk_HandleEvent) _ANSI_ARGS_((XEvent * eventPtr)); /* 115 */ @@ -774,7 +880,7 @@ typedef struct TkStubs { void (*tk_MakeWindowExist) _ANSI_ARGS_((Tk_Window tkwin)); /* 123 */ void (*tk_ManageGeometry) _ANSI_ARGS_((Tk_Window tkwin, Tk_GeomMgr * mgrPtr, ClientData clientData)); /* 124 */ void (*tk_MapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 125 */ - int (*tk_MeasureChars) _ANSI_ARGS_((Tk_Font tkfont, CONST char * source, int maxChars, int maxPixels, int flags, int * lengthPtr)); /* 126 */ + int (*tk_MeasureChars) _ANSI_ARGS_((Tk_Font tkfont, CONST char * source, int numBytes, int maxPixels, int flags, int * lengthPtr)); /* 126 */ void (*tk_MoveResizeWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height)); /* 127 */ void (*tk_MoveWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 128 */ void (*tk_MoveToplevelWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 129 */ @@ -824,15 +930,45 @@ typedef struct TkStubs { void (*tk_SizeOfImage) _ANSI_ARGS_((Tk_Image image, int * widthPtr, int * heightPtr)); /* 173 */ int (*tk_StrictMotif) _ANSI_ARGS_((Tk_Window tkwin)); /* 174 */ void (*tk_TextLayoutToPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_TextLayout layout)); /* 175 */ - int (*tk_TextWidth) _ANSI_ARGS_((Tk_Font font, CONST char * string, int numChars)); /* 176 */ + int (*tk_TextWidth) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numBytes)); /* 176 */ void (*tk_UndefineCursor) _ANSI_ARGS_((Tk_Window window)); /* 177 */ - void (*tk_UnderlineChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int x, int y, int firstChar, int lastChar)); /* 178 */ + void (*tk_UnderlineChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int x, int y, int firstByte, int lastByte)); /* 178 */ void (*tk_UnderlineTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int underline)); /* 179 */ void (*tk_Ungrab) _ANSI_ARGS_((Tk_Window tkwin)); /* 180 */ void (*tk_UnmaintainGeometry) _ANSI_ARGS_((Tk_Window slave, Tk_Window master)); /* 181 */ void (*tk_UnmapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 182 */ void (*tk_UnsetGrid) _ANSI_ARGS_((Tk_Window tkwin)); /* 183 */ void (*tk_UpdatePointer) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int state)); /* 184 */ + Pixmap (*tk_AllocBitmapFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 185 */ + Tk_3DBorder (*tk_Alloc3DBorderFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 186 */ + XColor * (*tk_AllocColorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 187 */ + Tk_Cursor (*tk_AllocCursorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 188 */ + Tk_Font (*tk_AllocFontFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 189 */ + Tk_OptionTable (*tk_CreateOptionTable) _ANSI_ARGS_((Tcl_Interp * interp, CONST Tk_OptionSpec * templatePtr)); /* 190 */ + void (*tk_DeleteOptionTable) _ANSI_ARGS_((Tk_OptionTable optionTable)); /* 191 */ + void (*tk_Free3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 192 */ + void (*tk_FreeBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 193 */ + void (*tk_FreeColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 194 */ + void (*tk_FreeConfigOptions) _ANSI_ARGS_((char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 195 */ + void (*tk_FreeSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 196 */ + void (*tk_FreeCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 197 */ + void (*tk_FreeFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 198 */ + Tk_3DBorder (*tk_Get3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 199 */ + int (*tk_GetAnchorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Anchor * anchorPtr)); /* 200 */ + Pixmap (*tk_GetBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 201 */ + XColor * (*tk_GetColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 202 */ + Tk_Cursor (*tk_GetCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 203 */ + Tcl_Obj * (*tk_GetOptionInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 204 */ + Tcl_Obj * (*tk_GetOptionValue) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 205 */ + int (*tk_GetJustifyFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Justify * justifyPtr)); /* 206 */ + int (*tk_GetMMFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, double * doublePtr)); /* 207 */ + int (*tk_GetPixelsFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, int * intPtr)); /* 208 */ + int (*tk_GetReliefFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * resultPtr)); /* 209 */ + int (*tk_GetScrollInfoObj) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], double * dblPtr, int * intPtr)); /* 210 */ + int (*tk_InitOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 211 */ + void (*tk_MainEx) _ANSI_ARGS_((int argc, char ** argv, Tcl_AppInitProc * appInitProc, Tcl_Interp * interp)); /* 212 */ + void (*tk_RestoreSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 213 */ + int (*tk_SetOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, int objc, Tcl_Obj *CONST objv[], Tk_Window tkwin, Tk_SavedOptions * savePtr, int * maskPtr)); /* 214 */ } TkStubs; extern TkStubs *tkStubsPtr; @@ -844,744 +980,864 @@ extern TkStubs *tkStubsPtr; */ #ifndef Tk_MainLoop -#define Tk_MainLoop() \ - (tkStubsPtr->tk_MainLoop)() /* 0 */ +#define Tk_MainLoop \ + (tkStubsPtr->tk_MainLoop) /* 0 */ #endif #ifndef Tk_3DBorderColor -#define Tk_3DBorderColor(border) \ - (tkStubsPtr->tk_3DBorderColor)(border) /* 1 */ +#define Tk_3DBorderColor \ + (tkStubsPtr->tk_3DBorderColor) /* 1 */ #endif #ifndef Tk_3DBorderGC -#define Tk_3DBorderGC(tkwin, border, which) \ - (tkStubsPtr->tk_3DBorderGC)(tkwin, border, which) /* 2 */ +#define Tk_3DBorderGC \ + (tkStubsPtr->tk_3DBorderGC) /* 2 */ #endif #ifndef Tk_3DHorizontalBevel -#define Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, height, leftIn, rightIn, topBevel, relief) \ - (tkStubsPtr->tk_3DHorizontalBevel)(tkwin, drawable, border, x, y, width, height, leftIn, rightIn, topBevel, relief) /* 3 */ +#define Tk_3DHorizontalBevel \ + (tkStubsPtr->tk_3DHorizontalBevel) /* 3 */ #endif #ifndef Tk_3DVerticalBevel -#define Tk_3DVerticalBevel(tkwin, drawable, border, x, y, width, height, leftBevel, relief) \ - (tkStubsPtr->tk_3DVerticalBevel)(tkwin, drawable, border, x, y, width, height, leftBevel, relief) /* 4 */ +#define Tk_3DVerticalBevel \ + (tkStubsPtr->tk_3DVerticalBevel) /* 4 */ #endif #ifndef Tk_AddOption -#define Tk_AddOption(tkwin, name, value, priority) \ - (tkStubsPtr->tk_AddOption)(tkwin, name, value, priority) /* 5 */ +#define Tk_AddOption \ + (tkStubsPtr->tk_AddOption) /* 5 */ #endif #ifndef Tk_BindEvent -#define Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) \ - (tkStubsPtr->tk_BindEvent)(bindingTable, eventPtr, tkwin, numObjects, objectPtr) /* 6 */ +#define Tk_BindEvent \ + (tkStubsPtr->tk_BindEvent) /* 6 */ #endif #ifndef Tk_CanvasDrawableCoords -#define Tk_CanvasDrawableCoords(canvas, x, y, drawableXPtr, drawableYPtr) \ - (tkStubsPtr->tk_CanvasDrawableCoords)(canvas, x, y, drawableXPtr, drawableYPtr) /* 7 */ +#define Tk_CanvasDrawableCoords \ + (tkStubsPtr->tk_CanvasDrawableCoords) /* 7 */ #endif #ifndef Tk_CanvasEventuallyRedraw -#define Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2) \ - (tkStubsPtr->tk_CanvasEventuallyRedraw)(canvas, x1, y1, x2, y2) /* 8 */ +#define Tk_CanvasEventuallyRedraw \ + (tkStubsPtr->tk_CanvasEventuallyRedraw) /* 8 */ #endif #ifndef Tk_CanvasGetCoord -#define Tk_CanvasGetCoord(interp, canvas, string, doublePtr) \ - (tkStubsPtr->tk_CanvasGetCoord)(interp, canvas, string, doublePtr) /* 9 */ +#define Tk_CanvasGetCoord \ + (tkStubsPtr->tk_CanvasGetCoord) /* 9 */ #endif #ifndef Tk_CanvasGetTextInfo -#define Tk_CanvasGetTextInfo(canvas) \ - (tkStubsPtr->tk_CanvasGetTextInfo)(canvas) /* 10 */ +#define Tk_CanvasGetTextInfo \ + (tkStubsPtr->tk_CanvasGetTextInfo) /* 10 */ #endif #ifndef Tk_CanvasPsBitmap -#define Tk_CanvasPsBitmap(interp, canvas, bitmap, x, y, width, height) \ - (tkStubsPtr->tk_CanvasPsBitmap)(interp, canvas, bitmap, x, y, width, height) /* 11 */ +#define Tk_CanvasPsBitmap \ + (tkStubsPtr->tk_CanvasPsBitmap) /* 11 */ #endif #ifndef Tk_CanvasPsColor -#define Tk_CanvasPsColor(interp, canvas, colorPtr) \ - (tkStubsPtr->tk_CanvasPsColor)(interp, canvas, colorPtr) /* 12 */ +#define Tk_CanvasPsColor \ + (tkStubsPtr->tk_CanvasPsColor) /* 12 */ #endif #ifndef Tk_CanvasPsFont -#define Tk_CanvasPsFont(interp, canvas, font) \ - (tkStubsPtr->tk_CanvasPsFont)(interp, canvas, font) /* 13 */ +#define Tk_CanvasPsFont \ + (tkStubsPtr->tk_CanvasPsFont) /* 13 */ #endif #ifndef Tk_CanvasPsPath -#define Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints) \ - (tkStubsPtr->tk_CanvasPsPath)(interp, canvas, coordPtr, numPoints) /* 14 */ +#define Tk_CanvasPsPath \ + (tkStubsPtr->tk_CanvasPsPath) /* 14 */ #endif #ifndef Tk_CanvasPsStipple -#define Tk_CanvasPsStipple(interp, canvas, bitmap) \ - (tkStubsPtr->tk_CanvasPsStipple)(interp, canvas, bitmap) /* 15 */ +#define Tk_CanvasPsStipple \ + (tkStubsPtr->tk_CanvasPsStipple) /* 15 */ #endif #ifndef Tk_CanvasPsY -#define Tk_CanvasPsY(canvas, y) \ - (tkStubsPtr->tk_CanvasPsY)(canvas, y) /* 16 */ +#define Tk_CanvasPsY \ + (tkStubsPtr->tk_CanvasPsY) /* 16 */ #endif #ifndef Tk_CanvasSetStippleOrigin -#define Tk_CanvasSetStippleOrigin(canvas, gc) \ - (tkStubsPtr->tk_CanvasSetStippleOrigin)(canvas, gc) /* 17 */ +#define Tk_CanvasSetStippleOrigin \ + (tkStubsPtr->tk_CanvasSetStippleOrigin) /* 17 */ #endif #ifndef Tk_CanvasTagsParseProc -#define Tk_CanvasTagsParseProc(clientData, interp, tkwin, value, widgRec, offset) \ - (tkStubsPtr->tk_CanvasTagsParseProc)(clientData, interp, tkwin, value, widgRec, offset) /* 18 */ +#define Tk_CanvasTagsParseProc \ + (tkStubsPtr->tk_CanvasTagsParseProc) /* 18 */ #endif #ifndef Tk_CanvasTagsPrintProc -#define Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) \ - (tkStubsPtr->tk_CanvasTagsPrintProc)(clientData, tkwin, widgRec, offset, freeProcPtr) /* 19 */ +#define Tk_CanvasTagsPrintProc \ + (tkStubsPtr->tk_CanvasTagsPrintProc) /* 19 */ #endif #ifndef Tk_CanvasTkwin -#define Tk_CanvasTkwin(canvas) \ - (tkStubsPtr->tk_CanvasTkwin)(canvas) /* 20 */ +#define Tk_CanvasTkwin \ + (tkStubsPtr->tk_CanvasTkwin) /* 20 */ #endif #ifndef Tk_CanvasWindowCoords -#define Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr) \ - (tkStubsPtr->tk_CanvasWindowCoords)(canvas, x, y, screenXPtr, screenYPtr) /* 21 */ +#define Tk_CanvasWindowCoords \ + (tkStubsPtr->tk_CanvasWindowCoords) /* 21 */ #endif #ifndef Tk_ChangeWindowAttributes -#define Tk_ChangeWindowAttributes(tkwin, valueMask, attsPtr) \ - (tkStubsPtr->tk_ChangeWindowAttributes)(tkwin, valueMask, attsPtr) /* 22 */ +#define Tk_ChangeWindowAttributes \ + (tkStubsPtr->tk_ChangeWindowAttributes) /* 22 */ #endif #ifndef Tk_CharBbox -#define Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr) \ - (tkStubsPtr->tk_CharBbox)(layout, index, xPtr, yPtr, widthPtr, heightPtr) /* 23 */ +#define Tk_CharBbox \ + (tkStubsPtr->tk_CharBbox) /* 23 */ #endif #ifndef Tk_ClearSelection -#define Tk_ClearSelection(tkwin, selection) \ - (tkStubsPtr->tk_ClearSelection)(tkwin, selection) /* 24 */ +#define Tk_ClearSelection \ + (tkStubsPtr->tk_ClearSelection) /* 24 */ #endif #ifndef Tk_ClipboardAppend -#define Tk_ClipboardAppend(interp, tkwin, target, format, buffer) \ - (tkStubsPtr->tk_ClipboardAppend)(interp, tkwin, target, format, buffer) /* 25 */ +#define Tk_ClipboardAppend \ + (tkStubsPtr->tk_ClipboardAppend) /* 25 */ #endif #ifndef Tk_ClipboardClear -#define Tk_ClipboardClear(interp, tkwin) \ - (tkStubsPtr->tk_ClipboardClear)(interp, tkwin) /* 26 */ +#define Tk_ClipboardClear \ + (tkStubsPtr->tk_ClipboardClear) /* 26 */ #endif #ifndef Tk_ConfigureInfo -#define Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags) \ - (tkStubsPtr->tk_ConfigureInfo)(interp, tkwin, specs, widgRec, argvName, flags) /* 27 */ +#define Tk_ConfigureInfo \ + (tkStubsPtr->tk_ConfigureInfo) /* 27 */ #endif #ifndef Tk_ConfigureValue -#define Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags) \ - (tkStubsPtr->tk_ConfigureValue)(interp, tkwin, specs, widgRec, argvName, flags) /* 28 */ +#define Tk_ConfigureValue \ + (tkStubsPtr->tk_ConfigureValue) /* 28 */ #endif #ifndef Tk_ConfigureWidget -#define Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags) \ - (tkStubsPtr->tk_ConfigureWidget)(interp, tkwin, specs, argc, argv, widgRec, flags) /* 29 */ +#define Tk_ConfigureWidget \ + (tkStubsPtr->tk_ConfigureWidget) /* 29 */ #endif #ifndef Tk_ConfigureWindow -#define Tk_ConfigureWindow(tkwin, valueMask, valuePtr) \ - (tkStubsPtr->tk_ConfigureWindow)(tkwin, valueMask, valuePtr) /* 30 */ +#define Tk_ConfigureWindow \ + (tkStubsPtr->tk_ConfigureWindow) /* 30 */ #endif #ifndef Tk_ComputeTextLayout -#define Tk_ComputeTextLayout(font, string, numChars, wrapLength, justify, flags, widthPtr, heightPtr) \ - (tkStubsPtr->tk_ComputeTextLayout)(font, string, numChars, wrapLength, justify, flags, widthPtr, heightPtr) /* 31 */ +#define Tk_ComputeTextLayout \ + (tkStubsPtr->tk_ComputeTextLayout) /* 31 */ #endif #ifndef Tk_CoordsToWindow -#define Tk_CoordsToWindow(rootX, rootY, tkwin) \ - (tkStubsPtr->tk_CoordsToWindow)(rootX, rootY, tkwin) /* 32 */ +#define Tk_CoordsToWindow \ + (tkStubsPtr->tk_CoordsToWindow) /* 32 */ #endif #ifndef Tk_CreateBinding -#define Tk_CreateBinding(interp, bindingTable, object, eventString, command, append) \ - (tkStubsPtr->tk_CreateBinding)(interp, bindingTable, object, eventString, command, append) /* 33 */ +#define Tk_CreateBinding \ + (tkStubsPtr->tk_CreateBinding) /* 33 */ #endif #ifndef Tk_CreateBindingTable -#define Tk_CreateBindingTable(interp) \ - (tkStubsPtr->tk_CreateBindingTable)(interp) /* 34 */ +#define Tk_CreateBindingTable \ + (tkStubsPtr->tk_CreateBindingTable) /* 34 */ #endif #ifndef Tk_CreateErrorHandler -#define Tk_CreateErrorHandler(display, errNum, request, minorCode, errorProc, clientData) \ - (tkStubsPtr->tk_CreateErrorHandler)(display, errNum, request, minorCode, errorProc, clientData) /* 35 */ +#define Tk_CreateErrorHandler \ + (tkStubsPtr->tk_CreateErrorHandler) /* 35 */ #endif #ifndef Tk_CreateEventHandler -#define Tk_CreateEventHandler(token, mask, proc, clientData) \ - (tkStubsPtr->tk_CreateEventHandler)(token, mask, proc, clientData) /* 36 */ +#define Tk_CreateEventHandler \ + (tkStubsPtr->tk_CreateEventHandler) /* 36 */ #endif #ifndef Tk_CreateGenericHandler -#define Tk_CreateGenericHandler(proc, clientData) \ - (tkStubsPtr->tk_CreateGenericHandler)(proc, clientData) /* 37 */ +#define Tk_CreateGenericHandler \ + (tkStubsPtr->tk_CreateGenericHandler) /* 37 */ #endif #ifndef Tk_CreateImageType -#define Tk_CreateImageType(typePtr) \ - (tkStubsPtr->tk_CreateImageType)(typePtr) /* 38 */ +#define Tk_CreateImageType \ + (tkStubsPtr->tk_CreateImageType) /* 38 */ #endif #ifndef Tk_CreateItemType -#define Tk_CreateItemType(typePtr) \ - (tkStubsPtr->tk_CreateItemType)(typePtr) /* 39 */ +#define Tk_CreateItemType \ + (tkStubsPtr->tk_CreateItemType) /* 39 */ #endif #ifndef Tk_CreatePhotoImageFormat -#define Tk_CreatePhotoImageFormat(formatPtr) \ - (tkStubsPtr->tk_CreatePhotoImageFormat)(formatPtr) /* 40 */ +#define Tk_CreatePhotoImageFormat \ + (tkStubsPtr->tk_CreatePhotoImageFormat) /* 40 */ #endif #ifndef Tk_CreateSelHandler -#define Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format) \ - (tkStubsPtr->tk_CreateSelHandler)(tkwin, selection, target, proc, clientData, format) /* 41 */ +#define Tk_CreateSelHandler \ + (tkStubsPtr->tk_CreateSelHandler) /* 41 */ #endif #ifndef Tk_CreateWindow -#define Tk_CreateWindow(interp, parent, name, screenName) \ - (tkStubsPtr->tk_CreateWindow)(interp, parent, name, screenName) /* 42 */ +#define Tk_CreateWindow \ + (tkStubsPtr->tk_CreateWindow) /* 42 */ #endif #ifndef Tk_CreateWindowFromPath -#define Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName) \ - (tkStubsPtr->tk_CreateWindowFromPath)(interp, tkwin, pathName, screenName) /* 43 */ +#define Tk_CreateWindowFromPath \ + (tkStubsPtr->tk_CreateWindowFromPath) /* 43 */ #endif #ifndef Tk_DefineBitmap -#define Tk_DefineBitmap(interp, name, source, width, height) \ - (tkStubsPtr->tk_DefineBitmap)(interp, name, source, width, height) /* 44 */ +#define Tk_DefineBitmap \ + (tkStubsPtr->tk_DefineBitmap) /* 44 */ #endif #ifndef Tk_DefineCursor -#define Tk_DefineCursor(window, cursor) \ - (tkStubsPtr->tk_DefineCursor)(window, cursor) /* 45 */ +#define Tk_DefineCursor \ + (tkStubsPtr->tk_DefineCursor) /* 45 */ #endif #ifndef Tk_DeleteAllBindings -#define Tk_DeleteAllBindings(bindingTable, object) \ - (tkStubsPtr->tk_DeleteAllBindings)(bindingTable, object) /* 46 */ +#define Tk_DeleteAllBindings \ + (tkStubsPtr->tk_DeleteAllBindings) /* 46 */ #endif #ifndef Tk_DeleteBinding -#define Tk_DeleteBinding(interp, bindingTable, object, eventString) \ - (tkStubsPtr->tk_DeleteBinding)(interp, bindingTable, object, eventString) /* 47 */ +#define Tk_DeleteBinding \ + (tkStubsPtr->tk_DeleteBinding) /* 47 */ #endif #ifndef Tk_DeleteBindingTable -#define Tk_DeleteBindingTable(bindingTable) \ - (tkStubsPtr->tk_DeleteBindingTable)(bindingTable) /* 48 */ +#define Tk_DeleteBindingTable \ + (tkStubsPtr->tk_DeleteBindingTable) /* 48 */ #endif #ifndef Tk_DeleteErrorHandler -#define Tk_DeleteErrorHandler(handler) \ - (tkStubsPtr->tk_DeleteErrorHandler)(handler) /* 49 */ +#define Tk_DeleteErrorHandler \ + (tkStubsPtr->tk_DeleteErrorHandler) /* 49 */ #endif #ifndef Tk_DeleteEventHandler -#define Tk_DeleteEventHandler(token, mask, proc, clientData) \ - (tkStubsPtr->tk_DeleteEventHandler)(token, mask, proc, clientData) /* 50 */ +#define Tk_DeleteEventHandler \ + (tkStubsPtr->tk_DeleteEventHandler) /* 50 */ #endif #ifndef Tk_DeleteGenericHandler -#define Tk_DeleteGenericHandler(proc, clientData) \ - (tkStubsPtr->tk_DeleteGenericHandler)(proc, clientData) /* 51 */ +#define Tk_DeleteGenericHandler \ + (tkStubsPtr->tk_DeleteGenericHandler) /* 51 */ #endif #ifndef Tk_DeleteImage -#define Tk_DeleteImage(interp, name) \ - (tkStubsPtr->tk_DeleteImage)(interp, name) /* 52 */ +#define Tk_DeleteImage \ + (tkStubsPtr->tk_DeleteImage) /* 52 */ #endif #ifndef Tk_DeleteSelHandler -#define Tk_DeleteSelHandler(tkwin, selection, target) \ - (tkStubsPtr->tk_DeleteSelHandler)(tkwin, selection, target) /* 53 */ +#define Tk_DeleteSelHandler \ + (tkStubsPtr->tk_DeleteSelHandler) /* 53 */ #endif #ifndef Tk_DestroyWindow -#define Tk_DestroyWindow(tkwin) \ - (tkStubsPtr->tk_DestroyWindow)(tkwin) /* 54 */ +#define Tk_DestroyWindow \ + (tkStubsPtr->tk_DestroyWindow) /* 54 */ #endif #ifndef Tk_DisplayName -#define Tk_DisplayName(tkwin) \ - (tkStubsPtr->tk_DisplayName)(tkwin) /* 55 */ +#define Tk_DisplayName \ + (tkStubsPtr->tk_DisplayName) /* 55 */ #endif #ifndef Tk_DistanceToTextLayout -#define Tk_DistanceToTextLayout(layout, x, y) \ - (tkStubsPtr->tk_DistanceToTextLayout)(layout, x, y) /* 56 */ +#define Tk_DistanceToTextLayout \ + (tkStubsPtr->tk_DistanceToTextLayout) /* 56 */ #endif #ifndef Tk_Draw3DPolygon -#define Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief) \ - (tkStubsPtr->tk_Draw3DPolygon)(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief) /* 57 */ +#define Tk_Draw3DPolygon \ + (tkStubsPtr->tk_Draw3DPolygon) /* 57 */ #endif #ifndef Tk_Draw3DRectangle -#define Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width, height, borderWidth, relief) \ - (tkStubsPtr->tk_Draw3DRectangle)(tkwin, drawable, border, x, y, width, height, borderWidth, relief) /* 58 */ +#define Tk_Draw3DRectangle \ + (tkStubsPtr->tk_Draw3DRectangle) /* 58 */ #endif #ifndef Tk_DrawChars -#define Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) \ - (tkStubsPtr->tk_DrawChars)(display, drawable, gc, tkfont, source, numChars, x, y) /* 59 */ +#define Tk_DrawChars \ + (tkStubsPtr->tk_DrawChars) /* 59 */ #endif #ifndef Tk_DrawFocusHighlight -#define Tk_DrawFocusHighlight(tkwin, gc, width, drawable) \ - (tkStubsPtr->tk_DrawFocusHighlight)(tkwin, gc, width, drawable) /* 60 */ +#define Tk_DrawFocusHighlight \ + (tkStubsPtr->tk_DrawFocusHighlight) /* 60 */ #endif #ifndef Tk_DrawTextLayout -#define Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar) \ - (tkStubsPtr->tk_DrawTextLayout)(display, drawable, gc, layout, x, y, firstChar, lastChar) /* 61 */ +#define Tk_DrawTextLayout \ + (tkStubsPtr->tk_DrawTextLayout) /* 61 */ #endif #ifndef Tk_Fill3DPolygon -#define Tk_Fill3DPolygon(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief) \ - (tkStubsPtr->tk_Fill3DPolygon)(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief) /* 62 */ +#define Tk_Fill3DPolygon \ + (tkStubsPtr->tk_Fill3DPolygon) /* 62 */ #endif #ifndef Tk_Fill3DRectangle -#define Tk_Fill3DRectangle(tkwin, drawable, border, x, y, width, height, borderWidth, relief) \ - (tkStubsPtr->tk_Fill3DRectangle)(tkwin, drawable, border, x, y, width, height, borderWidth, relief) /* 63 */ +#define Tk_Fill3DRectangle \ + (tkStubsPtr->tk_Fill3DRectangle) /* 63 */ #endif #ifndef Tk_FindPhoto -#define Tk_FindPhoto(interp, imageName) \ - (tkStubsPtr->tk_FindPhoto)(interp, imageName) /* 64 */ +#define Tk_FindPhoto \ + (tkStubsPtr->tk_FindPhoto) /* 64 */ #endif #ifndef Tk_FontId -#define Tk_FontId(font) \ - (tkStubsPtr->tk_FontId)(font) /* 65 */ +#define Tk_FontId \ + (tkStubsPtr->tk_FontId) /* 65 */ #endif #ifndef Tk_Free3DBorder -#define Tk_Free3DBorder(border) \ - (tkStubsPtr->tk_Free3DBorder)(border) /* 66 */ +#define Tk_Free3DBorder \ + (tkStubsPtr->tk_Free3DBorder) /* 66 */ #endif #ifndef Tk_FreeBitmap -#define Tk_FreeBitmap(display, bitmap) \ - (tkStubsPtr->tk_FreeBitmap)(display, bitmap) /* 67 */ +#define Tk_FreeBitmap \ + (tkStubsPtr->tk_FreeBitmap) /* 67 */ #endif #ifndef Tk_FreeColor -#define Tk_FreeColor(colorPtr) \ - (tkStubsPtr->tk_FreeColor)(colorPtr) /* 68 */ +#define Tk_FreeColor \ + (tkStubsPtr->tk_FreeColor) /* 68 */ #endif #ifndef Tk_FreeColormap -#define Tk_FreeColormap(display, colormap) \ - (tkStubsPtr->tk_FreeColormap)(display, colormap) /* 69 */ +#define Tk_FreeColormap \ + (tkStubsPtr->tk_FreeColormap) /* 69 */ #endif #ifndef Tk_FreeCursor -#define Tk_FreeCursor(display, cursor) \ - (tkStubsPtr->tk_FreeCursor)(display, cursor) /* 70 */ +#define Tk_FreeCursor \ + (tkStubsPtr->tk_FreeCursor) /* 70 */ #endif #ifndef Tk_FreeFont -#define Tk_FreeFont(f) \ - (tkStubsPtr->tk_FreeFont)(f) /* 71 */ +#define Tk_FreeFont \ + (tkStubsPtr->tk_FreeFont) /* 71 */ #endif #ifndef Tk_FreeGC -#define Tk_FreeGC(display, gc) \ - (tkStubsPtr->tk_FreeGC)(display, gc) /* 72 */ +#define Tk_FreeGC \ + (tkStubsPtr->tk_FreeGC) /* 72 */ #endif #ifndef Tk_FreeImage -#define Tk_FreeImage(image) \ - (tkStubsPtr->tk_FreeImage)(image) /* 73 */ +#define Tk_FreeImage \ + (tkStubsPtr->tk_FreeImage) /* 73 */ #endif #ifndef Tk_FreeOptions -#define Tk_FreeOptions(specs, widgRec, display, needFlags) \ - (tkStubsPtr->tk_FreeOptions)(specs, widgRec, display, needFlags) /* 74 */ +#define Tk_FreeOptions \ + (tkStubsPtr->tk_FreeOptions) /* 74 */ #endif #ifndef Tk_FreePixmap -#define Tk_FreePixmap(display, pixmap) \ - (tkStubsPtr->tk_FreePixmap)(display, pixmap) /* 75 */ +#define Tk_FreePixmap \ + (tkStubsPtr->tk_FreePixmap) /* 75 */ #endif #ifndef Tk_FreeTextLayout -#define Tk_FreeTextLayout(textLayout) \ - (tkStubsPtr->tk_FreeTextLayout)(textLayout) /* 76 */ +#define Tk_FreeTextLayout \ + (tkStubsPtr->tk_FreeTextLayout) /* 76 */ #endif #ifndef Tk_FreeXId -#define Tk_FreeXId(display, xid) \ - (tkStubsPtr->tk_FreeXId)(display, xid) /* 77 */ +#define Tk_FreeXId \ + (tkStubsPtr->tk_FreeXId) /* 77 */ #endif #ifndef Tk_GCForColor -#define Tk_GCForColor(colorPtr, drawable) \ - (tkStubsPtr->tk_GCForColor)(colorPtr, drawable) /* 78 */ +#define Tk_GCForColor \ + (tkStubsPtr->tk_GCForColor) /* 78 */ #endif #ifndef Tk_GeometryRequest -#define Tk_GeometryRequest(tkwin, reqWidth, reqHeight) \ - (tkStubsPtr->tk_GeometryRequest)(tkwin, reqWidth, reqHeight) /* 79 */ +#define Tk_GeometryRequest \ + (tkStubsPtr->tk_GeometryRequest) /* 79 */ #endif #ifndef Tk_Get3DBorder -#define Tk_Get3DBorder(interp, tkwin, colorName) \ - (tkStubsPtr->tk_Get3DBorder)(interp, tkwin, colorName) /* 80 */ +#define Tk_Get3DBorder \ + (tkStubsPtr->tk_Get3DBorder) /* 80 */ #endif #ifndef Tk_GetAllBindings -#define Tk_GetAllBindings(interp, bindingTable, object) \ - (tkStubsPtr->tk_GetAllBindings)(interp, bindingTable, object) /* 81 */ +#define Tk_GetAllBindings \ + (tkStubsPtr->tk_GetAllBindings) /* 81 */ #endif #ifndef Tk_GetAnchor -#define Tk_GetAnchor(interp, string, anchorPtr) \ - (tkStubsPtr->tk_GetAnchor)(interp, string, anchorPtr) /* 82 */ +#define Tk_GetAnchor \ + (tkStubsPtr->tk_GetAnchor) /* 82 */ #endif #ifndef Tk_GetAtomName -#define Tk_GetAtomName(tkwin, atom) \ - (tkStubsPtr->tk_GetAtomName)(tkwin, atom) /* 83 */ +#define Tk_GetAtomName \ + (tkStubsPtr->tk_GetAtomName) /* 83 */ #endif #ifndef Tk_GetBinding -#define Tk_GetBinding(interp, bindingTable, object, eventString) \ - (tkStubsPtr->tk_GetBinding)(interp, bindingTable, object, eventString) /* 84 */ +#define Tk_GetBinding \ + (tkStubsPtr->tk_GetBinding) /* 84 */ #endif #ifndef Tk_GetBitmap -#define Tk_GetBitmap(interp, tkwin, string) \ - (tkStubsPtr->tk_GetBitmap)(interp, tkwin, string) /* 85 */ +#define Tk_GetBitmap \ + (tkStubsPtr->tk_GetBitmap) /* 85 */ #endif #ifndef Tk_GetBitmapFromData -#define Tk_GetBitmapFromData(interp, tkwin, source, width, height) \ - (tkStubsPtr->tk_GetBitmapFromData)(interp, tkwin, source, width, height) /* 86 */ +#define Tk_GetBitmapFromData \ + (tkStubsPtr->tk_GetBitmapFromData) /* 86 */ #endif #ifndef Tk_GetCapStyle -#define Tk_GetCapStyle(interp, string, capPtr) \ - (tkStubsPtr->tk_GetCapStyle)(interp, string, capPtr) /* 87 */ +#define Tk_GetCapStyle \ + (tkStubsPtr->tk_GetCapStyle) /* 87 */ #endif #ifndef Tk_GetColor -#define Tk_GetColor(interp, tkwin, name) \ - (tkStubsPtr->tk_GetColor)(interp, tkwin, name) /* 88 */ +#define Tk_GetColor \ + (tkStubsPtr->tk_GetColor) /* 88 */ #endif #ifndef Tk_GetColorByValue -#define Tk_GetColorByValue(tkwin, colorPtr) \ - (tkStubsPtr->tk_GetColorByValue)(tkwin, colorPtr) /* 89 */ +#define Tk_GetColorByValue \ + (tkStubsPtr->tk_GetColorByValue) /* 89 */ #endif #ifndef Tk_GetColormap -#define Tk_GetColormap(interp, tkwin, string) \ - (tkStubsPtr->tk_GetColormap)(interp, tkwin, string) /* 90 */ +#define Tk_GetColormap \ + (tkStubsPtr->tk_GetColormap) /* 90 */ #endif #ifndef Tk_GetCursor -#define Tk_GetCursor(interp, tkwin, string) \ - (tkStubsPtr->tk_GetCursor)(interp, tkwin, string) /* 91 */ +#define Tk_GetCursor \ + (tkStubsPtr->tk_GetCursor) /* 91 */ #endif #ifndef Tk_GetCursorFromData -#define Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, xHot, yHot, fg, bg) \ - (tkStubsPtr->tk_GetCursorFromData)(interp, tkwin, source, mask, width, height, xHot, yHot, fg, bg) /* 92 */ +#define Tk_GetCursorFromData \ + (tkStubsPtr->tk_GetCursorFromData) /* 92 */ #endif #ifndef Tk_GetFont -#define Tk_GetFont(interp, tkwin, string) \ - (tkStubsPtr->tk_GetFont)(interp, tkwin, string) /* 93 */ +#define Tk_GetFont \ + (tkStubsPtr->tk_GetFont) /* 93 */ #endif #ifndef Tk_GetFontFromObj -#define Tk_GetFontFromObj(interp, tkwin, objPtr) \ - (tkStubsPtr->tk_GetFontFromObj)(interp, tkwin, objPtr) /* 94 */ +#define Tk_GetFontFromObj \ + (tkStubsPtr->tk_GetFontFromObj) /* 94 */ #endif #ifndef Tk_GetFontMetrics -#define Tk_GetFontMetrics(font, fmPtr) \ - (tkStubsPtr->tk_GetFontMetrics)(font, fmPtr) /* 95 */ +#define Tk_GetFontMetrics \ + (tkStubsPtr->tk_GetFontMetrics) /* 95 */ #endif #ifndef Tk_GetGC -#define Tk_GetGC(tkwin, valueMask, valuePtr) \ - (tkStubsPtr->tk_GetGC)(tkwin, valueMask, valuePtr) /* 96 */ +#define Tk_GetGC \ + (tkStubsPtr->tk_GetGC) /* 96 */ #endif #ifndef Tk_GetImage -#define Tk_GetImage(interp, tkwin, name, changeProc, clientData) \ - (tkStubsPtr->tk_GetImage)(interp, tkwin, name, changeProc, clientData) /* 97 */ +#define Tk_GetImage \ + (tkStubsPtr->tk_GetImage) /* 97 */ #endif #ifndef Tk_GetImageMasterData -#define Tk_GetImageMasterData(interp, name, typePtrPtr) \ - (tkStubsPtr->tk_GetImageMasterData)(interp, name, typePtrPtr) /* 98 */ +#define Tk_GetImageMasterData \ + (tkStubsPtr->tk_GetImageMasterData) /* 98 */ #endif #ifndef Tk_GetItemTypes -#define Tk_GetItemTypes() \ - (tkStubsPtr->tk_GetItemTypes)() /* 99 */ +#define Tk_GetItemTypes \ + (tkStubsPtr->tk_GetItemTypes) /* 99 */ #endif #ifndef Tk_GetJoinStyle -#define Tk_GetJoinStyle(interp, string, joinPtr) \ - (tkStubsPtr->tk_GetJoinStyle)(interp, string, joinPtr) /* 100 */ +#define Tk_GetJoinStyle \ + (tkStubsPtr->tk_GetJoinStyle) /* 100 */ #endif #ifndef Tk_GetJustify -#define Tk_GetJustify(interp, string, justifyPtr) \ - (tkStubsPtr->tk_GetJustify)(interp, string, justifyPtr) /* 101 */ +#define Tk_GetJustify \ + (tkStubsPtr->tk_GetJustify) /* 101 */ #endif #ifndef Tk_GetNumMainWindows -#define Tk_GetNumMainWindows() \ - (tkStubsPtr->tk_GetNumMainWindows)() /* 102 */ +#define Tk_GetNumMainWindows \ + (tkStubsPtr->tk_GetNumMainWindows) /* 102 */ #endif #ifndef Tk_GetOption -#define Tk_GetOption(tkwin, name, className) \ - (tkStubsPtr->tk_GetOption)(tkwin, name, className) /* 103 */ +#define Tk_GetOption \ + (tkStubsPtr->tk_GetOption) /* 103 */ #endif #ifndef Tk_GetPixels -#define Tk_GetPixels(interp, tkwin, string, intPtr) \ - (tkStubsPtr->tk_GetPixels)(interp, tkwin, string, intPtr) /* 104 */ +#define Tk_GetPixels \ + (tkStubsPtr->tk_GetPixels) /* 104 */ #endif #ifndef Tk_GetPixmap -#define Tk_GetPixmap(display, d, width, height, depth) \ - (tkStubsPtr->tk_GetPixmap)(display, d, width, height, depth) /* 105 */ +#define Tk_GetPixmap \ + (tkStubsPtr->tk_GetPixmap) /* 105 */ #endif #ifndef Tk_GetRelief -#define Tk_GetRelief(interp, name, reliefPtr) \ - (tkStubsPtr->tk_GetRelief)(interp, name, reliefPtr) /* 106 */ +#define Tk_GetRelief \ + (tkStubsPtr->tk_GetRelief) /* 106 */ #endif #ifndef Tk_GetRootCoords -#define Tk_GetRootCoords(tkwin, xPtr, yPtr) \ - (tkStubsPtr->tk_GetRootCoords)(tkwin, xPtr, yPtr) /* 107 */ +#define Tk_GetRootCoords \ + (tkStubsPtr->tk_GetRootCoords) /* 107 */ #endif #ifndef Tk_GetScrollInfo -#define Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr) \ - (tkStubsPtr->tk_GetScrollInfo)(interp, argc, argv, dblPtr, intPtr) /* 108 */ +#define Tk_GetScrollInfo \ + (tkStubsPtr->tk_GetScrollInfo) /* 108 */ #endif #ifndef Tk_GetScreenMM -#define Tk_GetScreenMM(interp, tkwin, string, doublePtr) \ - (tkStubsPtr->tk_GetScreenMM)(interp, tkwin, string, doublePtr) /* 109 */ +#define Tk_GetScreenMM \ + (tkStubsPtr->tk_GetScreenMM) /* 109 */ #endif #ifndef Tk_GetSelection -#define Tk_GetSelection(interp, tkwin, selection, target, proc, clientData) \ - (tkStubsPtr->tk_GetSelection)(interp, tkwin, selection, target, proc, clientData) /* 110 */ +#define Tk_GetSelection \ + (tkStubsPtr->tk_GetSelection) /* 110 */ #endif #ifndef Tk_GetUid -#define Tk_GetUid(string) \ - (tkStubsPtr->tk_GetUid)(string) /* 111 */ +#define Tk_GetUid \ + (tkStubsPtr->tk_GetUid) /* 111 */ #endif #ifndef Tk_GetVisual -#define Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr) \ - (tkStubsPtr->tk_GetVisual)(interp, tkwin, string, depthPtr, colormapPtr) /* 112 */ +#define Tk_GetVisual \ + (tkStubsPtr->tk_GetVisual) /* 112 */ #endif #ifndef Tk_GetVRootGeometry -#define Tk_GetVRootGeometry(tkwin, xPtr, yPtr, widthPtr, heightPtr) \ - (tkStubsPtr->tk_GetVRootGeometry)(tkwin, xPtr, yPtr, widthPtr, heightPtr) /* 113 */ +#define Tk_GetVRootGeometry \ + (tkStubsPtr->tk_GetVRootGeometry) /* 113 */ #endif #ifndef Tk_Grab -#define Tk_Grab(interp, tkwin, grabGlobal) \ - (tkStubsPtr->tk_Grab)(interp, tkwin, grabGlobal) /* 114 */ +#define Tk_Grab \ + (tkStubsPtr->tk_Grab) /* 114 */ #endif #ifndef Tk_HandleEvent -#define Tk_HandleEvent(eventPtr) \ - (tkStubsPtr->tk_HandleEvent)(eventPtr) /* 115 */ +#define Tk_HandleEvent \ + (tkStubsPtr->tk_HandleEvent) /* 115 */ #endif #ifndef Tk_IdToWindow -#define Tk_IdToWindow(display, window) \ - (tkStubsPtr->tk_IdToWindow)(display, window) /* 116 */ +#define Tk_IdToWindow \ + (tkStubsPtr->tk_IdToWindow) /* 116 */ #endif #ifndef Tk_ImageChanged -#define Tk_ImageChanged(master, x, y, width, height, imageWidth, imageHeight) \ - (tkStubsPtr->tk_ImageChanged)(master, x, y, width, height, imageWidth, imageHeight) /* 117 */ +#define Tk_ImageChanged \ + (tkStubsPtr->tk_ImageChanged) /* 117 */ #endif #ifndef Tk_Init -#define Tk_Init(interp) \ - (tkStubsPtr->tk_Init)(interp) /* 118 */ +#define Tk_Init \ + (tkStubsPtr->tk_Init) /* 118 */ #endif #ifndef Tk_InternAtom -#define Tk_InternAtom(tkwin, name) \ - (tkStubsPtr->tk_InternAtom)(tkwin, name) /* 119 */ +#define Tk_InternAtom \ + (tkStubsPtr->tk_InternAtom) /* 119 */ #endif #ifndef Tk_IntersectTextLayout -#define Tk_IntersectTextLayout(layout, x, y, width, height) \ - (tkStubsPtr->tk_IntersectTextLayout)(layout, x, y, width, height) /* 120 */ +#define Tk_IntersectTextLayout \ + (tkStubsPtr->tk_IntersectTextLayout) /* 120 */ #endif #ifndef Tk_MaintainGeometry -#define Tk_MaintainGeometry(slave, master, x, y, width, height) \ - (tkStubsPtr->tk_MaintainGeometry)(slave, master, x, y, width, height) /* 121 */ +#define Tk_MaintainGeometry \ + (tkStubsPtr->tk_MaintainGeometry) /* 121 */ #endif #ifndef Tk_MainWindow -#define Tk_MainWindow(interp) \ - (tkStubsPtr->tk_MainWindow)(interp) /* 122 */ +#define Tk_MainWindow \ + (tkStubsPtr->tk_MainWindow) /* 122 */ #endif #ifndef Tk_MakeWindowExist -#define Tk_MakeWindowExist(tkwin) \ - (tkStubsPtr->tk_MakeWindowExist)(tkwin) /* 123 */ +#define Tk_MakeWindowExist \ + (tkStubsPtr->tk_MakeWindowExist) /* 123 */ #endif #ifndef Tk_ManageGeometry -#define Tk_ManageGeometry(tkwin, mgrPtr, clientData) \ - (tkStubsPtr->tk_ManageGeometry)(tkwin, mgrPtr, clientData) /* 124 */ +#define Tk_ManageGeometry \ + (tkStubsPtr->tk_ManageGeometry) /* 124 */ #endif #ifndef Tk_MapWindow -#define Tk_MapWindow(tkwin) \ - (tkStubsPtr->tk_MapWindow)(tkwin) /* 125 */ +#define Tk_MapWindow \ + (tkStubsPtr->tk_MapWindow) /* 125 */ #endif #ifndef Tk_MeasureChars -#define Tk_MeasureChars(tkfont, source, maxChars, maxPixels, flags, lengthPtr) \ - (tkStubsPtr->tk_MeasureChars)(tkfont, source, maxChars, maxPixels, flags, lengthPtr) /* 126 */ +#define Tk_MeasureChars \ + (tkStubsPtr->tk_MeasureChars) /* 126 */ #endif #ifndef Tk_MoveResizeWindow -#define Tk_MoveResizeWindow(tkwin, x, y, width, height) \ - (tkStubsPtr->tk_MoveResizeWindow)(tkwin, x, y, width, height) /* 127 */ +#define Tk_MoveResizeWindow \ + (tkStubsPtr->tk_MoveResizeWindow) /* 127 */ #endif #ifndef Tk_MoveWindow -#define Tk_MoveWindow(tkwin, x, y) \ - (tkStubsPtr->tk_MoveWindow)(tkwin, x, y) /* 128 */ +#define Tk_MoveWindow \ + (tkStubsPtr->tk_MoveWindow) /* 128 */ #endif #ifndef Tk_MoveToplevelWindow -#define Tk_MoveToplevelWindow(tkwin, x, y) \ - (tkStubsPtr->tk_MoveToplevelWindow)(tkwin, x, y) /* 129 */ +#define Tk_MoveToplevelWindow \ + (tkStubsPtr->tk_MoveToplevelWindow) /* 129 */ #endif #ifndef Tk_NameOf3DBorder -#define Tk_NameOf3DBorder(border) \ - (tkStubsPtr->tk_NameOf3DBorder)(border) /* 130 */ +#define Tk_NameOf3DBorder \ + (tkStubsPtr->tk_NameOf3DBorder) /* 130 */ #endif #ifndef Tk_NameOfAnchor -#define Tk_NameOfAnchor(anchor) \ - (tkStubsPtr->tk_NameOfAnchor)(anchor) /* 131 */ +#define Tk_NameOfAnchor \ + (tkStubsPtr->tk_NameOfAnchor) /* 131 */ #endif #ifndef Tk_NameOfBitmap -#define Tk_NameOfBitmap(display, bitmap) \ - (tkStubsPtr->tk_NameOfBitmap)(display, bitmap) /* 132 */ +#define Tk_NameOfBitmap \ + (tkStubsPtr->tk_NameOfBitmap) /* 132 */ #endif #ifndef Tk_NameOfCapStyle -#define Tk_NameOfCapStyle(cap) \ - (tkStubsPtr->tk_NameOfCapStyle)(cap) /* 133 */ +#define Tk_NameOfCapStyle \ + (tkStubsPtr->tk_NameOfCapStyle) /* 133 */ #endif #ifndef Tk_NameOfColor -#define Tk_NameOfColor(colorPtr) \ - (tkStubsPtr->tk_NameOfColor)(colorPtr) /* 134 */ +#define Tk_NameOfColor \ + (tkStubsPtr->tk_NameOfColor) /* 134 */ #endif #ifndef Tk_NameOfCursor -#define Tk_NameOfCursor(display, cursor) \ - (tkStubsPtr->tk_NameOfCursor)(display, cursor) /* 135 */ +#define Tk_NameOfCursor \ + (tkStubsPtr->tk_NameOfCursor) /* 135 */ #endif #ifndef Tk_NameOfFont -#define Tk_NameOfFont(font) \ - (tkStubsPtr->tk_NameOfFont)(font) /* 136 */ +#define Tk_NameOfFont \ + (tkStubsPtr->tk_NameOfFont) /* 136 */ #endif #ifndef Tk_NameOfImage -#define Tk_NameOfImage(imageMaster) \ - (tkStubsPtr->tk_NameOfImage)(imageMaster) /* 137 */ +#define Tk_NameOfImage \ + (tkStubsPtr->tk_NameOfImage) /* 137 */ #endif #ifndef Tk_NameOfJoinStyle -#define Tk_NameOfJoinStyle(join) \ - (tkStubsPtr->tk_NameOfJoinStyle)(join) /* 138 */ +#define Tk_NameOfJoinStyle \ + (tkStubsPtr->tk_NameOfJoinStyle) /* 138 */ #endif #ifndef Tk_NameOfJustify -#define Tk_NameOfJustify(justify) \ - (tkStubsPtr->tk_NameOfJustify)(justify) /* 139 */ +#define Tk_NameOfJustify \ + (tkStubsPtr->tk_NameOfJustify) /* 139 */ #endif #ifndef Tk_NameOfRelief -#define Tk_NameOfRelief(relief) \ - (tkStubsPtr->tk_NameOfRelief)(relief) /* 140 */ +#define Tk_NameOfRelief \ + (tkStubsPtr->tk_NameOfRelief) /* 140 */ #endif #ifndef Tk_NameToWindow -#define Tk_NameToWindow(interp, pathName, tkwin) \ - (tkStubsPtr->tk_NameToWindow)(interp, pathName, tkwin) /* 141 */ +#define Tk_NameToWindow \ + (tkStubsPtr->tk_NameToWindow) /* 141 */ #endif #ifndef Tk_OwnSelection -#define Tk_OwnSelection(tkwin, selection, proc, clientData) \ - (tkStubsPtr->tk_OwnSelection)(tkwin, selection, proc, clientData) /* 142 */ +#define Tk_OwnSelection \ + (tkStubsPtr->tk_OwnSelection) /* 142 */ #endif #ifndef Tk_ParseArgv -#define Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags) \ - (tkStubsPtr->tk_ParseArgv)(interp, tkwin, argcPtr, argv, argTable, flags) /* 143 */ +#define Tk_ParseArgv \ + (tkStubsPtr->tk_ParseArgv) /* 143 */ #endif #ifndef Tk_PhotoPutBlock -#define Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height) \ - (tkStubsPtr->tk_PhotoPutBlock)(handle, blockPtr, x, y, width, height) /* 144 */ +#define Tk_PhotoPutBlock \ + (tkStubsPtr->tk_PhotoPutBlock) /* 144 */ #endif #ifndef Tk_PhotoPutZoomedBlock -#define Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY, subsampleX, subsampleY) \ - (tkStubsPtr->tk_PhotoPutZoomedBlock)(handle, blockPtr, x, y, width, height, zoomX, zoomY, subsampleX, subsampleY) /* 145 */ +#define Tk_PhotoPutZoomedBlock \ + (tkStubsPtr->tk_PhotoPutZoomedBlock) /* 145 */ #endif #ifndef Tk_PhotoGetImage -#define Tk_PhotoGetImage(handle, blockPtr) \ - (tkStubsPtr->tk_PhotoGetImage)(handle, blockPtr) /* 146 */ +#define Tk_PhotoGetImage \ + (tkStubsPtr->tk_PhotoGetImage) /* 146 */ #endif #ifndef Tk_PhotoBlank -#define Tk_PhotoBlank(handle) \ - (tkStubsPtr->tk_PhotoBlank)(handle) /* 147 */ +#define Tk_PhotoBlank \ + (tkStubsPtr->tk_PhotoBlank) /* 147 */ #endif #ifndef Tk_PhotoExpand -#define Tk_PhotoExpand(handle, width, height) \ - (tkStubsPtr->tk_PhotoExpand)(handle, width, height) /* 148 */ +#define Tk_PhotoExpand \ + (tkStubsPtr->tk_PhotoExpand) /* 148 */ #endif #ifndef Tk_PhotoGetSize -#define Tk_PhotoGetSize(handle, widthPtr, heightPtr) \ - (tkStubsPtr->tk_PhotoGetSize)(handle, widthPtr, heightPtr) /* 149 */ +#define Tk_PhotoGetSize \ + (tkStubsPtr->tk_PhotoGetSize) /* 149 */ #endif #ifndef Tk_PhotoSetSize -#define Tk_PhotoSetSize(handle, width, height) \ - (tkStubsPtr->tk_PhotoSetSize)(handle, width, height) /* 150 */ +#define Tk_PhotoSetSize \ + (tkStubsPtr->tk_PhotoSetSize) /* 150 */ #endif #ifndef Tk_PointToChar -#define Tk_PointToChar(layout, x, y) \ - (tkStubsPtr->tk_PointToChar)(layout, x, y) /* 151 */ +#define Tk_PointToChar \ + (tkStubsPtr->tk_PointToChar) /* 151 */ #endif #ifndef Tk_PostscriptFontName -#define Tk_PostscriptFontName(tkfont, dsPtr) \ - (tkStubsPtr->tk_PostscriptFontName)(tkfont, dsPtr) /* 152 */ +#define Tk_PostscriptFontName \ + (tkStubsPtr->tk_PostscriptFontName) /* 152 */ #endif #ifndef Tk_PreserveColormap -#define Tk_PreserveColormap(display, colormap) \ - (tkStubsPtr->tk_PreserveColormap)(display, colormap) /* 153 */ +#define Tk_PreserveColormap \ + (tkStubsPtr->tk_PreserveColormap) /* 153 */ #endif #ifndef Tk_QueueWindowEvent -#define Tk_QueueWindowEvent(eventPtr, position) \ - (tkStubsPtr->tk_QueueWindowEvent)(eventPtr, position) /* 154 */ +#define Tk_QueueWindowEvent \ + (tkStubsPtr->tk_QueueWindowEvent) /* 154 */ #endif #ifndef Tk_RedrawImage -#define Tk_RedrawImage(image, imageX, imageY, width, height, drawable, drawableX, drawableY) \ - (tkStubsPtr->tk_RedrawImage)(image, imageX, imageY, width, height, drawable, drawableX, drawableY) /* 155 */ +#define Tk_RedrawImage \ + (tkStubsPtr->tk_RedrawImage) /* 155 */ #endif #ifndef Tk_ResizeWindow -#define Tk_ResizeWindow(tkwin, width, height) \ - (tkStubsPtr->tk_ResizeWindow)(tkwin, width, height) /* 156 */ +#define Tk_ResizeWindow \ + (tkStubsPtr->tk_ResizeWindow) /* 156 */ #endif #ifndef Tk_RestackWindow -#define Tk_RestackWindow(tkwin, aboveBelow, other) \ - (tkStubsPtr->tk_RestackWindow)(tkwin, aboveBelow, other) /* 157 */ +#define Tk_RestackWindow \ + (tkStubsPtr->tk_RestackWindow) /* 157 */ #endif #ifndef Tk_RestrictEvents -#define Tk_RestrictEvents(proc, arg, prevArgPtr) \ - (tkStubsPtr->tk_RestrictEvents)(proc, arg, prevArgPtr) /* 158 */ +#define Tk_RestrictEvents \ + (tkStubsPtr->tk_RestrictEvents) /* 158 */ #endif #ifndef Tk_SafeInit -#define Tk_SafeInit(interp) \ - (tkStubsPtr->tk_SafeInit)(interp) /* 159 */ +#define Tk_SafeInit \ + (tkStubsPtr->tk_SafeInit) /* 159 */ #endif #ifndef Tk_SetAppName -#define Tk_SetAppName(tkwin, name) \ - (tkStubsPtr->tk_SetAppName)(tkwin, name) /* 160 */ +#define Tk_SetAppName \ + (tkStubsPtr->tk_SetAppName) /* 160 */ #endif #ifndef Tk_SetBackgroundFromBorder -#define Tk_SetBackgroundFromBorder(tkwin, border) \ - (tkStubsPtr->tk_SetBackgroundFromBorder)(tkwin, border) /* 161 */ +#define Tk_SetBackgroundFromBorder \ + (tkStubsPtr->tk_SetBackgroundFromBorder) /* 161 */ #endif #ifndef Tk_SetClass -#define Tk_SetClass(tkwin, className) \ - (tkStubsPtr->tk_SetClass)(tkwin, className) /* 162 */ +#define Tk_SetClass \ + (tkStubsPtr->tk_SetClass) /* 162 */ #endif #ifndef Tk_SetGrid -#define Tk_SetGrid(tkwin, reqWidth, reqHeight, gridWidth, gridHeight) \ - (tkStubsPtr->tk_SetGrid)(tkwin, reqWidth, reqHeight, gridWidth, gridHeight) /* 163 */ +#define Tk_SetGrid \ + (tkStubsPtr->tk_SetGrid) /* 163 */ #endif #ifndef Tk_SetInternalBorder -#define Tk_SetInternalBorder(tkwin, width) \ - (tkStubsPtr->tk_SetInternalBorder)(tkwin, width) /* 164 */ +#define Tk_SetInternalBorder \ + (tkStubsPtr->tk_SetInternalBorder) /* 164 */ #endif #ifndef Tk_SetWindowBackground -#define Tk_SetWindowBackground(tkwin, pixel) \ - (tkStubsPtr->tk_SetWindowBackground)(tkwin, pixel) /* 165 */ +#define Tk_SetWindowBackground \ + (tkStubsPtr->tk_SetWindowBackground) /* 165 */ #endif #ifndef Tk_SetWindowBackgroundPixmap -#define Tk_SetWindowBackgroundPixmap(tkwin, pixmap) \ - (tkStubsPtr->tk_SetWindowBackgroundPixmap)(tkwin, pixmap) /* 166 */ +#define Tk_SetWindowBackgroundPixmap \ + (tkStubsPtr->tk_SetWindowBackgroundPixmap) /* 166 */ #endif #ifndef Tk_SetWindowBorder -#define Tk_SetWindowBorder(tkwin, pixel) \ - (tkStubsPtr->tk_SetWindowBorder)(tkwin, pixel) /* 167 */ +#define Tk_SetWindowBorder \ + (tkStubsPtr->tk_SetWindowBorder) /* 167 */ #endif #ifndef Tk_SetWindowBorderWidth -#define Tk_SetWindowBorderWidth(tkwin, width) \ - (tkStubsPtr->tk_SetWindowBorderWidth)(tkwin, width) /* 168 */ +#define Tk_SetWindowBorderWidth \ + (tkStubsPtr->tk_SetWindowBorderWidth) /* 168 */ #endif #ifndef Tk_SetWindowBorderPixmap -#define Tk_SetWindowBorderPixmap(tkwin, pixmap) \ - (tkStubsPtr->tk_SetWindowBorderPixmap)(tkwin, pixmap) /* 169 */ +#define Tk_SetWindowBorderPixmap \ + (tkStubsPtr->tk_SetWindowBorderPixmap) /* 169 */ #endif #ifndef Tk_SetWindowColormap -#define Tk_SetWindowColormap(tkwin, colormap) \ - (tkStubsPtr->tk_SetWindowColormap)(tkwin, colormap) /* 170 */ +#define Tk_SetWindowColormap \ + (tkStubsPtr->tk_SetWindowColormap) /* 170 */ #endif #ifndef Tk_SetWindowVisual -#define Tk_SetWindowVisual(tkwin, visual, depth, colormap) \ - (tkStubsPtr->tk_SetWindowVisual)(tkwin, visual, depth, colormap) /* 171 */ +#define Tk_SetWindowVisual \ + (tkStubsPtr->tk_SetWindowVisual) /* 171 */ #endif #ifndef Tk_SizeOfBitmap -#define Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr) \ - (tkStubsPtr->tk_SizeOfBitmap)(display, bitmap, widthPtr, heightPtr) /* 172 */ +#define Tk_SizeOfBitmap \ + (tkStubsPtr->tk_SizeOfBitmap) /* 172 */ #endif #ifndef Tk_SizeOfImage -#define Tk_SizeOfImage(image, widthPtr, heightPtr) \ - (tkStubsPtr->tk_SizeOfImage)(image, widthPtr, heightPtr) /* 173 */ +#define Tk_SizeOfImage \ + (tkStubsPtr->tk_SizeOfImage) /* 173 */ #endif #ifndef Tk_StrictMotif -#define Tk_StrictMotif(tkwin) \ - (tkStubsPtr->tk_StrictMotif)(tkwin) /* 174 */ +#define Tk_StrictMotif \ + (tkStubsPtr->tk_StrictMotif) /* 174 */ #endif #ifndef Tk_TextLayoutToPostscript -#define Tk_TextLayoutToPostscript(interp, layout) \ - (tkStubsPtr->tk_TextLayoutToPostscript)(interp, layout) /* 175 */ +#define Tk_TextLayoutToPostscript \ + (tkStubsPtr->tk_TextLayoutToPostscript) /* 175 */ #endif #ifndef Tk_TextWidth -#define Tk_TextWidth(font, string, numChars) \ - (tkStubsPtr->tk_TextWidth)(font, string, numChars) /* 176 */ +#define Tk_TextWidth \ + (tkStubsPtr->tk_TextWidth) /* 176 */ #endif #ifndef Tk_UndefineCursor -#define Tk_UndefineCursor(window) \ - (tkStubsPtr->tk_UndefineCursor)(window) /* 177 */ +#define Tk_UndefineCursor \ + (tkStubsPtr->tk_UndefineCursor) /* 177 */ #endif #ifndef Tk_UnderlineChars -#define Tk_UnderlineChars(display, drawable, gc, tkfont, source, x, y, firstChar, lastChar) \ - (tkStubsPtr->tk_UnderlineChars)(display, drawable, gc, tkfont, source, x, y, firstChar, lastChar) /* 178 */ +#define Tk_UnderlineChars \ + (tkStubsPtr->tk_UnderlineChars) /* 178 */ #endif #ifndef Tk_UnderlineTextLayout -#define Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline) \ - (tkStubsPtr->tk_UnderlineTextLayout)(display, drawable, gc, layout, x, y, underline) /* 179 */ +#define Tk_UnderlineTextLayout \ + (tkStubsPtr->tk_UnderlineTextLayout) /* 179 */ #endif #ifndef Tk_Ungrab -#define Tk_Ungrab(tkwin) \ - (tkStubsPtr->tk_Ungrab)(tkwin) /* 180 */ +#define Tk_Ungrab \ + (tkStubsPtr->tk_Ungrab) /* 180 */ #endif #ifndef Tk_UnmaintainGeometry -#define Tk_UnmaintainGeometry(slave, master) \ - (tkStubsPtr->tk_UnmaintainGeometry)(slave, master) /* 181 */ +#define Tk_UnmaintainGeometry \ + (tkStubsPtr->tk_UnmaintainGeometry) /* 181 */ #endif #ifndef Tk_UnmapWindow -#define Tk_UnmapWindow(tkwin) \ - (tkStubsPtr->tk_UnmapWindow)(tkwin) /* 182 */ +#define Tk_UnmapWindow \ + (tkStubsPtr->tk_UnmapWindow) /* 182 */ #endif #ifndef Tk_UnsetGrid -#define Tk_UnsetGrid(tkwin) \ - (tkStubsPtr->tk_UnsetGrid)(tkwin) /* 183 */ +#define Tk_UnsetGrid \ + (tkStubsPtr->tk_UnsetGrid) /* 183 */ #endif #ifndef Tk_UpdatePointer -#define Tk_UpdatePointer(tkwin, x, y, state) \ - (tkStubsPtr->tk_UpdatePointer)(tkwin, x, y, state) /* 184 */ +#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 #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 9dc65ee..855d22d 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -6,12 +6,12 @@ * the string to be edited. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkEntry.c,v 1.2 1998/09/14 18:23:09 stanton Exp $ + * RCS: @(#) $Id: tkEntry.c,v 1.3 1999/04/16 01:51:13 stanton Exp $ */ #include "tkInt.h" @@ -32,6 +32,9 @@ typedef struct { * freed even after tkwin has gone away. */ Tcl_Interp *interp; /* Interpreter associated with entry. */ Tcl_Command widgetCmd; /* Token for entry's widget command. */ + Tk_OptionTable optionTable; /* Table that defines configuration options + * available for this widget. */ + /* * Fields that are set by widget commands other than "configure". @@ -39,17 +42,17 @@ typedef struct { char *string; /* Pointer to storage for string; * NULL-terminated; malloc-ed. */ - int insertPos; /* Index of character before which next - * typed character will be inserted. */ + int insertPos; /* Character index before which next typed + * character will be inserted. */ /* * Information about what's selected, if any. */ - int selectFirst; /* Index of first selected character (-1 means - * nothing selected. */ - int selectLast; /* Index of last selected character (-1 means - * nothing selected. */ + int selectFirst; /* Character index of first selected + * character (-1 means nothing selected. */ + int selectLast; /* Character index just after last selected + * character (-1 means nothing selected. */ int selectAnchor; /* Fixed end of selection (i.e. "select to" * operation will use this as one end of the * selection). */ @@ -60,8 +63,8 @@ typedef struct { int scanMarkX; /* X-position at which scan started (e.g. * button was pressed here). */ - int scanMarkIndex; /* Index of character that was at left of - * window when scan started. */ + int scanMarkIndex; /* Character index of character that was at + * left of window when scan started. */ /* * Configuration settings that are updated by Tk_ConfigureWidget. @@ -99,7 +102,7 @@ typedef struct { char *showChar; /* Value of -show option. If non-NULL, first * character is used for displaying all * characters in entry. Malloc'ed. */ - Tk_Uid state; /* Normal or disabled. Entry is read-only + int state; /* Normal or disabled. Entry is read-only * when disabled. */ char *textVarName; /* Name of variable (malloc'ed) or NULL. * If non-NULL, entry's string tracks the @@ -118,20 +121,27 @@ typedef struct { * configuration settings above. */ - int numChars; /* Number of non-NULL characters in - * string (may be 0). */ - char *displayString; /* If non-NULL, points to string with same + int numBytes; /* Length of string in bytes. */ + int numChars; /* Length of string in characters. Both + * string and displayString have the same + * character length, but may have different + * byte lengths due to being made from + * different UTF-8 characters. */ + 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 all equal to showChar. Malloc'ed. */ + * are all equal to showChar. */ + int numDisplayBytes; /* Length of displayString in bytes. */ int inset; /* Number of pixels on the left and right * sides that are taken up by XPAD, borderWidth * (if any), and highlightWidth (if any). */ Tk_TextLayout textLayout; /* Cached text layout information. */ int layoutX, layoutY; /* Origin for layout. */ - int leftIndex; /* Index of left-most character visible in - * window. */ int leftX; /* X position at which character at leftIndex * is drawn (varies depending on justify). */ + int leftIndex; /* Character index of left-most character + * visible in window. */ Tcl_TimerToken insertBlinkHandler; /* Timer handler used to blink cursor on and * off. */ @@ -167,6 +177,7 @@ typedef struct { #define GOT_FOCUS 8 #define UPDATE_SCROLLBAR 0x10 #define GOT_SELECTION 0x20 +#define ENTRY_DELETED 0x40 /* * The following macro defines how many extra pixels to leave on each @@ -177,93 +188,108 @@ typedef struct { #define YPAD 1 /* + * The following enum is used to define a type for the -state option + * of the Entry widget. These values are used as indices into the + * string table below. + */ + +enum state { + STATE_DISABLED, STATE_NORMAL +}; + +static char *stateStrings[] = { + "disabled", "normal", (char *) NULL +}; + +/* * Information used for argv parsing. */ -static Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_ENTRY_BG_COLOR, Tk_Offset(Entry, normalBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_ENTRY_BG_MONO, Tk_Offset(Entry, normalBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_ENTRY_BORDER_WIDTH, Tk_Offset(Entry, borderWidth), 0}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_ENTRY_CURSOR, Tk_Offset(Entry, cursor), TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection", - "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, - Tk_Offset(Entry, exportSelection), 0}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_FONT, "-font", "font", "Font", - DEF_ENTRY_FONT, Tk_Offset(Entry, tkfont), 0}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_ENTRY_FG, Tk_Offset(Entry, fgColorPtr), 0}, - {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", +static Tk_OptionSpec optionSpecs[] = { + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder), + 0, (ClientData) DEF_ENTRY_BG_MONO, 0}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-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", + DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection", + "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1, + Tk_Offset(Entry, exportSelection), 0, 0, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-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", + DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0, + 0, 0}, + {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground", "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG, - Tk_Offset(Entry, highlightBgColorPtr), 0}, - {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_ENTRY_HIGHLIGHT, Tk_Offset(Entry, highlightColorPtr), 0}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", - "HighlightThickness", - DEF_ENTRY_HIGHLIGHT_WIDTH, Tk_Offset(Entry, highlightWidth), 0}, - {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground", - DEF_ENTRY_INSERT_BG, Tk_Offset(Entry, insertBorder), 0}, - {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", - DEF_ENTRY_INSERT_BD_COLOR, Tk_Offset(Entry, insertBorderWidth), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", - DEF_ENTRY_INSERT_BD_MONO, Tk_Offset(Entry, insertBorderWidth), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime", - DEF_ENTRY_INSERT_OFF_TIME, Tk_Offset(Entry, insertOffTime), 0}, - {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime", - DEF_ENTRY_INSERT_ON_TIME, Tk_Offset(Entry, insertOnTime), 0}, - {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", - DEF_ENTRY_INSERT_WIDTH, Tk_Offset(Entry, insertWidth), 0}, - {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", - DEF_ENTRY_JUSTIFY, Tk_Offset(Entry, justify), 0}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_ENTRY_RELIEF, Tk_Offset(Entry, relief), 0}, - {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", - DEF_ENTRY_SELECT_COLOR, Tk_Offset(Entry, selBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", - DEF_ENTRY_SELECT_MONO, Tk_Offset(Entry, selBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", - DEF_ENTRY_SELECT_BD_COLOR, Tk_Offset(Entry, selBorderWidth), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", - DEF_ENTRY_SELECT_BD_MONO, Tk_Offset(Entry, selBorderWidth), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", - DEF_ENTRY_SELECT_FG_COLOR, Tk_Offset(Entry, selFgColorPtr), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", - DEF_ENTRY_SELECT_FG_MONO, Tk_Offset(Entry, selFgColorPtr), - TK_CONFIG_MONO_ONLY}, + -1, Tk_Offset(Entry, highlightBgColorPtr), + 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1, + Tk_Offset(Entry, highlightWidth), 0, 0, 0}, + {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground", + DEF_ENTRY_INSERT_BG, + -1, Tk_Offset(Entry, insertBorder), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth", + "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1, + Tk_Offset(Entry, insertBorderWidth), 0, + (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0}, + {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime", + DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime), + 0, 0, 0}, + {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime", + DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", + DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth), + 0, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + 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}, + {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth", + "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1, + Tk_Offset(Entry, selBorderWidth), + 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0}, + {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr), + 0, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0}, {TK_CONFIG_STRING, "-show", "show", "Show", - DEF_ENTRY_SHOW, Tk_Offset(Entry, showChar), TK_CONFIG_NULL_OK}, - {TK_CONFIG_UID, "-state", "state", "State", - DEF_ENTRY_STATE, Tk_Offset(Entry, state), 0}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_ENTRY_TAKE_FOCUS, Tk_Offset(Entry, takeFocus), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", - DEF_ENTRY_TEXT_VARIABLE, Tk_Offset(Entry, textVarName), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_INT, "-width", "width", "Width", - DEF_ENTRY_WIDTH, Tk_Offset(Entry, prefWidth), 0}, - {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", - DEF_ENTRY_SCROLL_COMMAND, Tk_Offset(Entry, scrollCmd), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} + 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}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus), + TK_CONFIG_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", + DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName), + TK_CONFIG_NULL_OK, 0, 0}, + {TK_OPTION_INT, "-width", "width", "Width", + DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", + DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd), + TK_CONFIG_NULL_OK, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, 0, 0} }; /* @@ -274,12 +300,38 @@ static Tk_ConfigSpec configSpecs[] = { #define LAST_PLUS_ONE_OK 2 /* + * The following tables define the entry widget commands (and sub- + * commands) and map the indexes into the string tables into + * enumerated types used to dispatch the entry widget command. + */ + +static char *commandNames[] = { + "bbox", "cget", "configure", "delete", "get", "icursor", "index", + "insert", "scan", "selection", "xview", (char *) NULL +}; + +enum command { + COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELETE, + COMMAND_GET, COMMAND_ICURSOR, COMMAND_INDEX, COMMAND_INSERT, + COMMAND_SCAN, COMMAND_SELECTION, COMMAND_XVIEW +}; + +static char *selCommandNames[] = { + "adjust", "clear", "from", "present", "range", "to", (char *) NULL +}; + +enum selcommand { + SELECTION_ADJUST, SELECTION_CLEAR, SELECTION_FROM, + SELECTION_PRESENT, SELECTION_RANGE, SELECTION_TO +}; + +/* * Forward declarations for procedures defined later in this file: */ static int ConfigureEntry _ANSI_ARGS_((Tcl_Interp *interp, - Entry *entryPtr, int argc, char **argv, - int flags)); + Entry *entryPtr, int objc, + Tcl_Obj *CONST objv[], int flags)); static void DeleteChars _ANSI_ARGS_((Entry *entryPtr, int index, int count)); static void DestroyEntry _ANSI_ARGS_((char *memPtr)); @@ -309,8 +361,9 @@ static void EntryUpdateScrollbar _ANSI_ARGS_((Entry *entryPtr)); static void EntryValueChanged _ANSI_ARGS_((Entry *entryPtr)); static void EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr, double *firstPtr, double *lastPtr)); -static int EntryWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +static int EntryWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static void EntryWorldChanged _ANSI_ARGS_(( ClientData instanceData)); static int GetEntryIndex _ANSI_ARGS_((Tcl_Interp *interp, @@ -333,7 +386,7 @@ static TkClassProcs entryClass = { /* *-------------------------------------------------------------- * - * Tk_EntryCmd -- + * Tk_EntryObjCmd -- * * This procedure is invoked to process the "entry" Tcl * command. See the user documentation for details on what @@ -349,25 +402,43 @@ static TkClassProcs entryClass = { */ int -Tk_EntryCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_EntryObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; register Entry *entryPtr; - Tk_Window new; + Tk_OptionTable optionTable; + Tk_Window tkwin; + + optionTable = (Tk_OptionTable) clientData; + if (optionTable == NULL) { + Tcl_CmdInfo info; + char *name; + + /* + * We haven't created the option table for this widget class + * yet. Do it now and save the table as the clientData for + * the command, so we'll have access to it in future + * invocations of the command. + */ + + optionTable = Tk_CreateOptionTable(interp, optionSpecs); + name = Tcl_GetString(objv[0]); + Tcl_GetCommandInfo(interp, name, &info); + info.objClientData = (ClientData) optionTable; + Tcl_SetCommandInfo(interp, name, &info); + } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } - new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL); - if (new == NULL) { + tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), + Tcl_GetString(objv[1]), (char *) NULL); + if (tkwin == NULL) { return TCL_ERROR; } @@ -378,12 +449,13 @@ Tk_EntryCmd(clientData, interp, argc, argv) */ entryPtr = (Entry *) ckalloc(sizeof(Entry)); - entryPtr->tkwin = new; - entryPtr->display = Tk_Display(new); + entryPtr->tkwin = tkwin; + entryPtr->display = Tk_Display(tkwin); entryPtr->interp = interp; - entryPtr->widgetCmd = Tcl_CreateCommand(interp, - Tk_PathName(entryPtr->tkwin), EntryWidgetCmd, + entryPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd, (ClientData) entryPtr, EntryCmdDeletedProc); + entryPtr->optionTable = optionTable; entryPtr->string = (char *) ckalloc(1); entryPtr->string[0] = '\0'; entryPtr->insertPos = 0; @@ -413,20 +485,21 @@ Tk_EntryCmd(clientData, interp, argc, argv) entryPtr->selBorderWidth = 0; entryPtr->selFgColorPtr = NULL; entryPtr->showChar = NULL; - entryPtr->state = tkNormalUid; + entryPtr->state = STATE_NORMAL; entryPtr->textVarName = NULL; entryPtr->takeFocus = NULL; entryPtr->prefWidth = 0; entryPtr->scrollCmd = NULL; - + entryPtr->numBytes = 0; entryPtr->numChars = 0; - entryPtr->displayString = NULL; + entryPtr->displayString = entryPtr->string; + entryPtr->numDisplayBytes = 0; entryPtr->inset = XPAD; entryPtr->textLayout = NULL; entryPtr->layoutX = 0; entryPtr->layoutY = 0; - entryPtr->leftIndex = 0; entryPtr->leftX = 0; + entryPtr->leftIndex = 0; entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; entryPtr->textGC = None; entryPtr->selTextGC = None; @@ -441,11 +514,17 @@ Tk_EntryCmd(clientData, interp, argc, argv) EntryEventProc, (ClientData) entryPtr); Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING, EntryFetchSelection, (ClientData) entryPtr, XA_STRING); - if (ConfigureEntry(interp, entryPtr, argc-2, argv+2, 0) != TCL_OK) { + + if (Tk_InitOptions(interp, (char *) entryPtr, optionTable, tkwin) + != TCL_OK) { + Tk_DestroyWindow(entryPtr->tkwin); + return TCL_ERROR; + } + if (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK) { goto error; } - - interp->result = Tk_PathName(entryPtr->tkwin); + + Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); return TCL_OK; error: @@ -456,7 +535,7 @@ Tk_EntryCmd(clientData, interp, argc, argv) /* *-------------------------------------------------------------- * - * EntryWidgetCmd -- + * EntryWidgetObjCmd -- * * This procedure is invoked to process the Tcl command * that corresponds to a widget managed by this module. @@ -472,321 +551,405 @@ Tk_EntryCmd(clientData, interp, argc, argv) */ static int -EntryWidgetCmd(clientData, interp, argc, argv) - ClientData clientData; /* Information about entry widget. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ +EntryWidgetObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Information about entry widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - register Entry *entryPtr = (Entry *) clientData; - int result = TCL_OK; - size_t length; - int c; + Entry *entryPtr = (Entry *) clientData; + int cmdIndex, selIndex, result; + Tcl_Obj *objPtr; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg arg ...?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } Tcl_Preserve((ClientData) entryPtr); - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) { - int index; - int x, y, width, height; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " bbox index\"", - (char *) NULL); - goto error; - } - if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) { - goto error; - } - if ((index == entryPtr->numChars) && (index > 0)) { - index--; - } - Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - sprintf(interp->result, "%d %d %d %d", - x + entryPtr->layoutX, y + entryPtr->layoutY, width, height); - } 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\"", - (char *) NULL); - goto error; - } - result = Tk_ConfigureValue(interp, entryPtr->tkwin, configSpecs, - (char *) entryPtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs, - (char *) entryPtr, (char *) NULL, 0); - } else if (argc == 3) { - result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs, - (char *) entryPtr, argv[2], 0); - } else { - result = ConfigureEntry(interp, entryPtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); - } - } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) { - int first, last; - - if ((argc < 3) || (argc > 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delete firstIndex ?lastIndex?\"", - (char *) NULL); - goto error; - } - if (GetEntryIndex(interp, entryPtr, argv[2], &first) != TCL_OK) { - goto error; - } - if (argc == 3) { - last = first+1; - } else { - if (GetEntryIndex(interp, entryPtr, argv[3], &last) != TCL_OK) { + + /* + * Parse the widget command by looking up the second token in + * the list of valid command names. + */ + + result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, + "option", 0, &cmdIndex); + if (result != TCL_OK) { + return result; + } + + switch (cmdIndex) { + case COMMAND_BBOX: { + int index, x, y, width, height; + char *string; + char buf[TCL_INTEGER_SPACE * 4]; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "bbox index"); goto error; } - } - if ((last >= first) && (entryPtr->state == tkNormalUid)) { - DeleteChars(entryPtr, first, last-first); - } - } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get\"", (char *) NULL); - goto error; - } - interp->result = entryPtr->string; - } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0) - && (length >= 2)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " icursor pos\"", - (char *) NULL); - goto error; - } - if (GetEntryIndex(interp, entryPtr, argv[2], &entryPtr->insertPos) - != TCL_OK) { - goto error; - } - EventuallyRedraw(entryPtr); - } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) - && (length >= 3)) { - int index; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " index string\"", (char *) NULL); - goto error; - } - if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) { - goto error; - } - sprintf(interp->result, "%d", index); - } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) - && (length >= 3)) { - int index; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " insert index text\"", - (char *) NULL); - goto error; - } - if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) { - goto error; - } - if (entryPtr->state == tkNormalUid) { - InsertChars(entryPtr, index, argv[3]); - } - } else if ((c == 's') && (length >= 2) - && (strncmp(argv[1], "scan", length) == 0)) { - int x; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " scan mark|dragto x\"", (char *) NULL); - goto error; - } - if (Tcl_GetInt(interp, argv[3], &x) != TCL_OK) { - goto error; - } - if ((argv[2][0] == 'm') - && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) { - entryPtr->scanMarkX = x; - entryPtr->scanMarkIndex = entryPtr->leftIndex; - } else if ((argv[2][0] == 'd') - && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) { - EntryScanTo(entryPtr, x); - } else { - Tcl_AppendResult(interp, "bad scan option \"", argv[2], - "\": must be mark or dragto", (char *) NULL); - goto error; - } - } else if ((c == 's') && (length >= 2) - && (strncmp(argv[1], "selection", length) == 0)) { - int index, index2; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " select option ?index?\"", (char *) NULL); - goto error; - } - length = strlen(argv[2]); - c = argv[2][0]; - if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " selection clear\"", (char *) NULL); - goto error; + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; } - if (entryPtr->selectFirst != -1) { - entryPtr->selectFirst = entryPtr->selectLast = -1; - EventuallyRedraw(entryPtr); + if ((index == entryPtr->numChars) && (index > 0)) { + index--; } - goto done; - } else if ((c == 'p') && (strncmp(argv[2], "present", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " selection present\"", (char *) NULL); + string = entryPtr->displayString; + 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); + break; + } + + case COMMAND_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); goto error; } - if (entryPtr->selectFirst == -1) { - interp->result = "0"; + + objPtr = Tk_GetOptionValue(interp, (char *) entryPtr, + entryPtr->optionTable, objv[2], entryPtr->tkwin); + if (objPtr == NULL) { + goto error; } else { - interp->result = "1"; + Tcl_SetObjResult(interp, objPtr); } - goto done; + break; } - if (argc >= 4) { - if (GetEntryIndex(interp, entryPtr, argv[3], &index) != TCL_OK) { - goto error; + + case COMMAND_CONFIGURE: { + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr, + entryPtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + entryPtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } + } else { + result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0); } + break; } - if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " selection adjust index\"", - (char *) NULL); + + case COMMAND_DELETE: { + int first, last; + + if ((objc < 3) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 1, objv, + "delete firstIndex ?lastIndex?"); goto error; } - if (entryPtr->selectFirst >= 0) { - int half1, half2; - - half1 = (entryPtr->selectFirst + entryPtr->selectLast)/2; - half2 = (entryPtr->selectFirst + entryPtr->selectLast + 1)/2; - if (index < half1) { - entryPtr->selectAnchor = entryPtr->selectLast; - } else if (index > half2) { - entryPtr->selectAnchor = entryPtr->selectFirst; - } else { - /* - * We're at about the halfway point in the selection; - * just keep the existing anchor. - */ + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &first) != TCL_OK) { + goto error; + } + if (objc == 3) { + last = first + 1; + } else { + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]), + &last) != TCL_OK) { + goto error; } } - EntrySelectTo(entryPtr, index); - } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " selection from index\"", - (char *) NULL); + if ((last >= first) && (entryPtr->state == STATE_NORMAL)) { + DeleteChars(entryPtr, first, last - first); + } + break; + } + + case COMMAND_GET: { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "get"); goto error; } - entryPtr->selectAnchor = index; - } else if ((c == 'r') && (strncmp(argv[2], "range", length) == 0)) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " selection range start end\"", - (char *) NULL); + Tcl_SetResult(interp, entryPtr->string, TCL_STATIC); + break; + } + + case COMMAND_ICURSOR: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "icursor pos"); goto error; } - if (GetEntryIndex(interp, entryPtr, argv[4], &index2) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &entryPtr->insertPos) != TCL_OK) { + goto error; + } + EventuallyRedraw(entryPtr); + break; + } + + case COMMAND_INDEX: { + int index; + char buf[TCL_INTEGER_SPACE]; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "index string"); goto error; } - if (index >= index2) { - entryPtr->selectFirst = entryPtr->selectLast = -1; - } else { - entryPtr->selectFirst = index; - entryPtr->selectLast = index2; + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; } - if (!(entryPtr->flags & GOT_SELECTION) - && (entryPtr->exportSelection)) { - Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, - EntryLostSelection, (ClientData) entryPtr); - entryPtr->flags |= GOT_SELECTION; + sprintf(buf, "%d", index); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + break; + } + + case COMMAND_INSERT: { + int index; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "insert index text"); + goto error; } - EventuallyRedraw(entryPtr); - } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " selection to index\"", - (char *) NULL); + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; + } + if (entryPtr->state == STATE_NORMAL) { + InsertChars(entryPtr, index, Tcl_GetString(objv[3])); + } + break; + } + + case COMMAND_SCAN: { + int x; + char *minorCmd; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "scan mark|dragto x"); goto error; } - EntrySelectTo(entryPtr, index); - } else { - Tcl_AppendResult(interp, "bad selection option \"", argv[2], - "\": must be adjust, clear, from, present, range, or to", - (char *) NULL); - goto error; + if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) { + goto error; + } + + minorCmd = Tcl_GetString(objv[2]); + if (minorCmd[0] == 'm' + && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) { + entryPtr->scanMarkX = x; + entryPtr->scanMarkIndex = entryPtr->leftIndex; + } else if ((minorCmd[0] == 'd') + && (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", + (char *) NULL); + goto error; + } + break; } - } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { - int index, type, count, charsPerPage; - double fraction, first, last; - - if (argc == 2) { - EntryVisibleRange(entryPtr, &first, &last); - sprintf(interp->result, "%g %g", first, last); - goto done; - } else if (argc == 3) { - if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) { + + case COMMAND_SELECTION: { + int index, index2; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "select option ?index?"); goto error; } - } else { - type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); - index = entryPtr->leftIndex; - switch (type) { - case TK_SCROLL_ERROR: - goto error; - case TK_SCROLL_MOVETO: - index = (int) ((fraction * entryPtr->numChars) + 0.5); + + /* + * Parse the selection sub-command, using the command + * table "selCommandNames" defined above. + */ + + result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames, + "selection option", 0, &selIndex); + if (result != TCL_OK) { + goto error; + } + + switch(selIndex) { + case SELECTION_ADJUST: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "selection adjust index"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + if (entryPtr->selectFirst >= 0) { + int half1, half2; + + half1 = (entryPtr->selectFirst + + entryPtr->selectLast)/2; + half2 = (entryPtr->selectFirst + + entryPtr->selectLast + 1)/2; + if (index < half1) { + entryPtr->selectAnchor = entryPtr->selectLast; + } else if (index > half2) { + entryPtr->selectAnchor = entryPtr->selectFirst; + } else { + /* + * We're at about the halfway point in the + * selection; just keep the existing anchor. + */ + } + } + EntrySelectTo(entryPtr, index); break; - case TK_SCROLL_PAGES: - charsPerPage = ((Tk_Width(entryPtr->tkwin) - - 2*entryPtr->inset) / entryPtr->avgWidth) - 2; - if (charsPerPage < 1) { - charsPerPage = 1; + } + + case SELECTION_CLEAR: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "selection clear"); + goto error; + } + if (entryPtr->selectFirst >= 0) { + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; + EventuallyRedraw(entryPtr); + } + goto done; + } + + case SELECTION_FROM: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "selection from index"); + goto error; } - index += charsPerPage*count; + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + entryPtr->selectAnchor = index; break; - case TK_SCROLL_UNITS: - index += count; + } + + case SELECTION_PRESENT: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "selection present"); + goto error; + } + if (entryPtr->selectFirst < 0) { + Tcl_SetResult(interp, "0", TCL_STATIC); + } else { + Tcl_SetResult(interp, "1", TCL_STATIC); + } + goto done; + } + + case SELECTION_RANGE: { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, + "selection range start end"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[4]),& index2) != TCL_OK) { + goto error; + } + if (index >= index2) { + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; + } else { + entryPtr->selectFirst = index; + entryPtr->selectLast = index2; + } + if (!(entryPtr->flags & GOT_SELECTION) + && (entryPtr->exportSelection)) { + Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, + EntryLostSelection, (ClientData) entryPtr); + entryPtr->flags |= GOT_SELECTION; + } + EventuallyRedraw(entryPtr); + break; + } + + case SELECTION_TO: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "selection to index"); + goto error; + } + if (GetEntryIndex(interp, entryPtr, + Tcl_GetString(objv[3]), &index) != TCL_OK) { + goto error; + } + EntrySelectTo(entryPtr, index); break; + } } + break; + } + + case COMMAND_XVIEW: { + int index; + + if (objc == 2) { + double first, last; + char buf[TCL_DOUBLE_SPACE * 2]; + + EntryVisibleRange(entryPtr, &first, &last); + sprintf(buf, "%g %g", first, last); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + goto done; + } else if (objc == 3) { + if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), + &index) != TCL_OK) { + goto error; + } + } else { + double fraction; + int count; + + index = entryPtr->leftIndex; + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, + &count)) { + case TK_SCROLL_ERROR: { + goto error; + } + case TK_SCROLL_MOVETO: { + index = (int) ((fraction * entryPtr->numChars) + 0.5); + break; + } + case TK_SCROLL_PAGES: { + int charsPerPage; + + charsPerPage = ((Tk_Width(entryPtr->tkwin) + - 2 * entryPtr->inset) + / entryPtr->avgWidth) - 2; + if (charsPerPage < 1) { + charsPerPage = 1; + } + index += count * charsPerPage; + break; + } + case TK_SCROLL_UNITS: { + index += count; + break; + } + } + } + if (index >= entryPtr->numChars) { + index = entryPtr->numChars - 1; + } + if (index < 0) { + index = 0; + } + entryPtr->leftIndex = index; + entryPtr->flags |= UPDATE_SCROLLBAR; + EntryComputeGeometry(entryPtr); + EventuallyRedraw(entryPtr); + break; } - if (index >= entryPtr->numChars) { - index = entryPtr->numChars-1; - } - if (index < 0) { - index = 0; - } - entryPtr->leftIndex = index; - entryPtr->flags |= UPDATE_SCROLLBAR; - EntryComputeGeometry(entryPtr); - EventuallyRedraw(entryPtr); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be bbox, cget, configure, delete, get, ", - "icursor, index, insert, scan, selection, or xview", - (char *) NULL); - goto error; } + done: Tcl_Release((ClientData) entryPtr); return result; @@ -818,7 +981,13 @@ static void DestroyEntry(memPtr) char *memPtr; /* Info about entry widget. */ { - register Entry *entryPtr = (Entry *) memPtr; + Entry *entryPtr = (Entry *) memPtr; + entryPtr->flags |= ENTRY_DELETED; + + Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd); + if (entryPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr); + } /* * Free up all the stuff that requires special handling, then @@ -839,11 +1008,13 @@ DestroyEntry(memPtr) Tk_FreeGC(entryPtr->display, entryPtr->selTextGC); } Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler); - if (entryPtr->displayString != NULL) { + if (entryPtr->displayString != entryPtr->string) { ckfree(entryPtr->displayString); } Tk_FreeTextLayout(entryPtr->textLayout); - Tk_FreeOptions(configSpecs, (char *) entryPtr, entryPtr->display, 0); + Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable, + entryPtr->tkwin); + entryPtr->tkwin = NULL; ckfree((char *) entryPtr); } @@ -858,7 +1029,7 @@ DestroyEntry(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as colors, border width, @@ -869,14 +1040,17 @@ DestroyEntry(memPtr) */ static int -ConfigureEntry(interp, entryPtr, argc, argv, flags) +ConfigureEntry(interp, entryPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ - register Entry *entryPtr; /* Information about widget; may or may - * not already have values for some fields. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ + Entry *entryPtr; /* 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[]; /* Argument objects. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { + Tk_SavedOptions savedOptions; + Tcl_Obj *errorResult = NULL; + int error; int oldExport; /* @@ -890,9 +1064,79 @@ ConfigureEntry(interp, entryPtr, argc, argv, flags) } oldExport = entryPtr->exportSelection; - if (Tk_ConfigureWidget(interp, entryPtr->tkwin, configSpecs, - argc, argv, (char *) entryPtr, flags) != TCL_OK) { - return TCL_ERROR; + + for (error = 0; error <= 1; error++) { + if (!error) { + /* + * First pass: set options to new values. + */ + + if (Tk_SetOptions(interp, (char *) entryPtr, + entryPtr->optionTable, objc, objv, + entryPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { + continue; + } + } else { + /* + * Second pass: restore options to old values. + */ + + errorResult = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(errorResult); + Tk_RestoreSavedOptions(&savedOptions); + } + + /* + * A few other options also need special processing, such as parsing + * the geometry and setting the background from a 3-D border. + */ + + Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder); + + if (entryPtr->insertWidth <= 0) { + entryPtr->insertWidth = 2; + } + if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) { + entryPtr->insertBorderWidth = entryPtr->insertWidth/2; + } + + /* + * Restart the cursor timing sequence in case the on-time or + * off-time just changed. + */ + + if (entryPtr->flags & GOT_FOCUS) { + EntryFocusProc(entryPtr, 1); + } + + /* + * Claim the selection if we've suddenly started exporting it. + */ + + if (entryPtr->exportSelection && (!oldExport) + && (entryPtr->selectFirst != -1) + && !(entryPtr->flags & GOT_SELECTION)) { + Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, + (ClientData) entryPtr); + entryPtr->flags |= GOT_SELECTION; + } + + /* + * Recompute the window's geometry and arrange for it to be + * redisplayed. + */ + + Tk_SetInternalBorder(entryPtr->tkwin, + entryPtr->borderWidth + entryPtr->highlightWidth); + if (entryPtr->highlightWidth <= 0) { + entryPtr->highlightWidth = 0; + } + entryPtr->inset = entryPtr->highlightWidth + + entryPtr->borderWidth + XPAD; + break; + } + if (!error) { + Tk_FreeSavedOptions(&savedOptions); } /* @@ -915,63 +1159,14 @@ ConfigureEntry(interp, entryPtr, argc, argv, flags) EntryTextVarProc, (ClientData) entryPtr); } - /* - * A few other options also need special processing, such as parsing - * the geometry and setting the background from a 3-D border. - */ - - if ((entryPtr->state != tkNormalUid) - && (entryPtr->state != tkDisabledUid)) { - Tcl_AppendResult(interp, "bad state value \"", entryPtr->state, - "\": must be normal or disabled", (char *) NULL); - entryPtr->state = tkNormalUid; + EntryWorldChanged((ClientData) entryPtr); + if (error) { + Tcl_SetObjResult(interp, errorResult); + Tcl_DecrRefCount(errorResult); return TCL_ERROR; + } else { + return TCL_OK; } - - Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder); - - if (entryPtr->insertWidth <= 0) { - entryPtr->insertWidth = 2; - } - if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) { - entryPtr->insertBorderWidth = entryPtr->insertWidth/2; - } - - /* - * Restart the cursor timing sequence in case the on-time or off-time - * just changed. - */ - - if (entryPtr->flags & GOT_FOCUS) { - EntryFocusProc(entryPtr, 1); - } - - /* - * Claim the selection if we've suddenly started exporting it. - */ - - if (entryPtr->exportSelection && (!oldExport) - && (entryPtr->selectFirst != -1) - && !(entryPtr->flags & GOT_SELECTION)) { - Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, - (ClientData) entryPtr); - entryPtr->flags |= GOT_SELECTION; - } - - /* - * Recompute the window's geometry and arrange for it to be - * redisplayed. - */ - - Tk_SetInternalBorder(entryPtr->tkwin, - entryPtr->borderWidth + entryPtr->highlightWidth); - if (entryPtr->highlightWidth <= 0) { - entryPtr->highlightWidth = 0; - } - entryPtr->inset = entryPtr->highlightWidth + entryPtr->borderWidth + XPAD; - - EntryWorldChanged((ClientData) entryPtr); - return TCL_OK; } /* @@ -1057,13 +1252,14 @@ static void DisplayEntry(clientData) ClientData clientData; /* Information about window. */ { - register Entry *entryPtr = (Entry *) clientData; - register Tk_Window tkwin = entryPtr->tkwin; - int baseY, selStartX, selEndX, cursorX, x, w; + Entry *entryPtr = (Entry *) clientData; + Tk_Window tkwin = entryPtr->tkwin; + int baseY, selStartX, selEndX, cursorX; int xBound; Tk_FontMetrics fm; Pixmap pixmap; int showSelection; + char *string; entryPtr->flags &= ~REDRAW_PENDING; if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { @@ -1118,18 +1314,21 @@ DisplayEntry(clientData) Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); - if (showSelection && (entryPtr->selectLast > entryPtr->leftIndex)) { + + string = entryPtr->displayString; + if (showSelection + && (entryPtr->selectLast > entryPtr->leftIndex)) { if (entryPtr->selectFirst <= entryPtr->leftIndex) { selStartX = entryPtr->leftX; } else { Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst, - &x, NULL, NULL, NULL); - selStartX = x + entryPtr->layoutX; + &selStartX, NULL, NULL, NULL); + selStartX += entryPtr->layoutX; } if ((selStartX - entryPtr->selBorderWidth) < xBound) { - Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast - 1, - &x, NULL, &w, NULL); - selEndX = x + w + entryPtr->layoutX; + Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast, + &selEndX, NULL, NULL, NULL); + selEndX += entryPtr->layoutX; Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->selBorder, selStartX - entryPtr->selBorderWidth, baseY - fm.ascent - entryPtr->selBorderWidth, @@ -1149,32 +1348,22 @@ DisplayEntry(clientData) */ if ((entryPtr->insertPos >= entryPtr->leftIndex) - && (entryPtr->state == tkNormalUid) + && (entryPtr->state == STATE_NORMAL) && (entryPtr->flags & GOT_FOCUS)) { - if (entryPtr->insertPos == 0) { - cursorX = 0; - } else if (entryPtr->insertPos >= entryPtr->numChars) { - Tk_CharBbox(entryPtr->textLayout, entryPtr->numChars - 1, - &x, NULL, &w, NULL); - cursorX = x + w; - } else { - Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, - &x, NULL, NULL, NULL); - cursorX = x; - } + Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, &cursorX, NULL, + NULL, NULL); cursorX += entryPtr->layoutX; cursorX -= (entryPtr->insertWidth)/2; if (cursorX < xBound) { if (entryPtr->flags & CURSOR_ON) { Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->insertBorder, - cursorX, baseY - fm.ascent, - entryPtr->insertWidth, fm.ascent + fm.descent, - entryPtr->insertBorderWidth, TK_RELIEF_RAISED); + cursorX, baseY - fm.ascent, entryPtr->insertWidth, + fm.ascent + fm.descent, entryPtr->insertBorderWidth, + TK_RELIEF_RAISED); } else if (entryPtr->insertBorder == entryPtr->selBorder) { Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder, - cursorX, baseY - fm.ascent, - entryPtr->insertWidth, fm.ascent + fm.descent, - 0, TK_RELIEF_FLAT); + cursorX, baseY - fm.ascent, entryPtr->insertWidth, + fm.ascent + fm.descent, 0, TK_RELIEF_FLAT); } } } @@ -1188,18 +1377,19 @@ DisplayEntry(clientData) entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY, entryPtr->leftIndex, entryPtr->numChars); - if (showSelection && (entryPtr->selTextGC != entryPtr->textGC) && - (entryPtr->selectFirst < entryPtr->selectLast)) { - int first; + if (showSelection + && (entryPtr->selTextGC != entryPtr->textGC) + && (entryPtr->selectFirst < entryPtr->selectLast)) { + int selFirst; - if (entryPtr->selectFirst - entryPtr->leftIndex < 0) { - first = entryPtr->leftIndex; + if (entryPtr->selectFirst < entryPtr->leftIndex) { + selFirst = entryPtr->leftIndex; } else { - first = entryPtr->selectFirst; + selFirst = entryPtr->selectFirst; } Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC, entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY, - first, entryPtr->selectLast); + selFirst, entryPtr->selectLast); } /* @@ -1210,8 +1400,8 @@ DisplayEntry(clientData) if (entryPtr->relief != TK_RELIEF_FLAT) { Tk_Draw3DRectangle(tkwin, pixmap, entryPtr->normalBorder, entryPtr->highlightWidth, entryPtr->highlightWidth, - Tk_Width(tkwin) - 2*entryPtr->highlightWidth, - Tk_Height(tkwin) - 2*entryPtr->highlightWidth, + Tk_Width(tkwin) - 2 * entryPtr->highlightWidth, + Tk_Height(tkwin) - 2 * entryPtr->highlightWidth, entryPtr->borderWidth, entryPtr->relief); } if (entryPtr->highlightWidth != 0) { @@ -1259,38 +1449,53 @@ DisplayEntry(clientData) static void EntryComputeGeometry(entryPtr) - Entry *entryPtr; /* Widget record for entry. */ + Entry *entryPtr; /* Widget record for entry. */ { int totalLength, overflow, maxOffScreen, rightX; int height, width, i; Tk_FontMetrics fm; - char *p, *displayString; + char *p; + + if (entryPtr->displayString != entryPtr->string) { + ckfree(entryPtr->displayString); + entryPtr->displayString = entryPtr->string; + entryPtr->numDisplayBytes = entryPtr->numBytes; + } /* * If we're displaying a special character instead of the value of * the entry, recompute the displayString. */ - if (entryPtr->displayString != NULL) { - ckfree(entryPtr->displayString); - entryPtr->displayString = NULL; - } if (entryPtr->showChar != NULL) { - entryPtr->displayString = (char *) ckalloc((unsigned) - (entryPtr->numChars + 1)); - for (p = entryPtr->displayString, i = entryPtr->numChars; i > 0; - i--, p++) { - *p = entryPtr->showChar[0]; + Tcl_UniChar ch; + char buf[TCL_UTF_MAX]; + int size; + + /* + * Normalize the special character so we can safely duplicate it + * in the display string. If we didn't do this, then two malformed + * characters might end up looking like one valid UTF character in + * the resulting string. + */ + + Tcl_UtfToUniChar(entryPtr->showChar, &ch); + size = Tcl_UniCharToUtf(ch, buf); + + entryPtr->numDisplayBytes = entryPtr->numChars * size; + entryPtr->displayString = + (char *) ckalloc((unsigned) (entryPtr->numDisplayBytes + 1)); + + p = entryPtr->displayString; + for (i = entryPtr->numChars; --i >= 0; ) { + p += Tcl_UniCharToUtf(ch, p); } - *p = 0; - displayString = entryPtr->displayString; - } else { - displayString = entryPtr->string; + *p = '\0'; } Tk_FreeTextLayout(entryPtr->textLayout); entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont, - displayString, entryPtr->numChars, 0, entryPtr->justify, - TK_IGNORE_NEWLINES, &totalLength, &height); + entryPtr->displayString, entryPtr->numChars, 0, + entryPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height); entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2; @@ -1325,13 +1530,13 @@ EntryComputeGeometry(entryPtr) Tk_CharBbox(entryPtr->textLayout, maxOffScreen, &rightX, NULL, NULL, NULL); if (rightX < overflow) { - maxOffScreen += 1; + maxOffScreen++; } if (entryPtr->leftIndex > maxOffScreen) { entryPtr->leftIndex = maxOffScreen; } - Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex, - &rightX, NULL, NULL, NULL); + Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex, &rightX, + NULL, NULL, NULL); entryPtr->leftX = entryPtr->inset; entryPtr->layoutX = entryPtr->leftX - rightX; } @@ -1368,28 +1573,51 @@ EntryComputeGeometry(entryPtr) */ static void -InsertChars(entryPtr, index, string) - register Entry *entryPtr; /* Entry that is to get the new - * elements. */ +InsertChars(entryPtr, index, value) + Entry *entryPtr; /* Entry that is to get the new elements. */ int index; /* Add the new elements before this - * element. */ - char *string; /* New characters to add (NULL-terminated + * character index. */ + char *value; /* New characters to add (NULL-terminated * string). */ { - int length; - char *new; + int byteIndex, byteCount, oldChars, charsAdded, newByteCount; + char *new, *string; - length = strlen(string); - if (length == 0) { + string = entryPtr->string; + byteIndex = Tcl_UtfAtIndex(string, index) - string; + byteCount = strlen(value); + if (byteCount == 0) { return; } - new = (char *) ckalloc((unsigned) (entryPtr->numChars + length + 1)); - strncpy(new, entryPtr->string, (size_t) index); - strcpy(new+index, string); - strcpy(new+index+length, entryPtr->string+index); - ckfree(entryPtr->string); + + newByteCount = entryPtr->numBytes + byteCount + 1; + new = (char *) ckalloc((unsigned) newByteCount); + memcpy(new, string, (size_t) byteIndex); + strcpy(new + byteIndex, value); + strcpy(new + byteIndex + byteCount, string + byteIndex); + + ckfree(string); entryPtr->string = new; - entryPtr->numChars += length; + + /* + * The following construction is used because inserting improperly + * formed UTF-8 sequences between other improperly formed UTF-8 + * sequences could result in actually forming valid UTF-8 sequences; + * the number of characters added may not be Tcl_NumUtfChars(string, -1), + * because of context. The actual number of characters added is how + * many characters are in the string now minus the number that + * used to be there. + */ + + oldChars = entryPtr->numChars; + entryPtr->numChars = Tcl_NumUtfChars(new, -1); + charsAdded = entryPtr->numChars - oldChars; + entryPtr->numBytes += byteCount; + + if (entryPtr->displayString == string) { + entryPtr->displayString = new; + entryPtr->numDisplayBytes = entryPtr->numBytes; + } /* * Inserting characters invalidates all indexes into the string. @@ -1400,19 +1628,20 @@ InsertChars(entryPtr, index, string) */ if (entryPtr->selectFirst >= index) { - entryPtr->selectFirst += length; + entryPtr->selectFirst += charsAdded; } if (entryPtr->selectLast > index) { - entryPtr->selectLast += length; + entryPtr->selectLast += charsAdded; } - if ((entryPtr->selectAnchor > index) || (entryPtr->selectFirst >= index)) { - entryPtr->selectAnchor += length; + if ((entryPtr->selectAnchor > index) + || (entryPtr->selectFirst >= index)) { + entryPtr->selectAnchor += charsAdded; } if (entryPtr->leftIndex > index) { - entryPtr->leftIndex += length; + entryPtr->leftIndex += charsAdded; } if (entryPtr->insertPos >= index) { - entryPtr->insertPos += length; + entryPtr->insertPos += charsAdded; } EntryValueChanged(entryPtr); } @@ -1436,11 +1665,12 @@ InsertChars(entryPtr, index, string) static void DeleteChars(entryPtr, index, count) - register Entry *entryPtr; /* Entry widget to modify. */ + Entry *entryPtr; /* Entry widget to modify. */ int index; /* Index of first character to delete. */ int count; /* How many characters to delete. */ { - char *new; + int byteIndex, byteCount, newByteCount; + char *new, *string; if ((index + count) > entryPtr->numChars) { count = entryPtr->numChars - index; @@ -1449,12 +1679,24 @@ DeleteChars(entryPtr, index, count) return; } - new = (char *) ckalloc((unsigned) (entryPtr->numChars + 1 - count)); - strncpy(new, entryPtr->string, (size_t) index); - strcpy(new+index, entryPtr->string+index+count); + string = entryPtr->string; + byteIndex = Tcl_UtfAtIndex(string, index) - string; + byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string + byteIndex); + + newByteCount = entryPtr->numBytes + 1 - byteCount; + new = (char *) ckalloc((unsigned) newByteCount); + memcpy(new, string, (size_t) byteIndex); + strcpy(new + byteIndex, string + byteIndex + byteCount); + ckfree(entryPtr->string); entryPtr->string = new; entryPtr->numChars -= count; + entryPtr->numBytes -= byteCount; + + if (entryPtr->displayString == string) { + entryPtr->displayString = new; + entryPtr->numDisplayBytes = entryPtr->numBytes; + } /* * Deleting characters results in the remaining characters being @@ -1463,21 +1705,22 @@ DeleteChars(entryPtr, index, count) */ if (entryPtr->selectFirst >= index) { - if (entryPtr->selectFirst >= (index+count)) { + if (entryPtr->selectFirst >= (index + count)) { entryPtr->selectFirst -= count; } else { entryPtr->selectFirst = index; } } if (entryPtr->selectLast >= index) { - if (entryPtr->selectLast >= (index+count)) { + if (entryPtr->selectLast >= (index + count)) { entryPtr->selectLast -= count; } else { entryPtr->selectLast = index; } } if (entryPtr->selectLast <= entryPtr->selectFirst) { - entryPtr->selectFirst = entryPtr->selectLast = -1; + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; } if (entryPtr->selectAnchor >= index) { if (entryPtr->selectAnchor >= (index+count)) { @@ -1487,14 +1730,14 @@ DeleteChars(entryPtr, index, count) } } if (entryPtr->leftIndex > index) { - if (entryPtr->leftIndex >= (index+count)) { + if (entryPtr->leftIndex >= (index + count)) { entryPtr->leftIndex -= count; } else { entryPtr->leftIndex = index; } } if (entryPtr->insertPos >= index) { - if (entryPtr->insertPos >= (index+count)) { + if (entryPtr->insertPos >= (index + count)) { entryPtr->insertPos -= count; } else { entryPtr->insertPos = index; @@ -1580,24 +1823,37 @@ EntryValueChanged(entryPtr) static void EntrySetValue(entryPtr, value) - register Entry *entryPtr; /* Entry whose value is to be - * changed. */ - char *value; /* New text to display in entry. */ + Entry *entryPtr; /* Entry whose value is to be changed. */ + char *value; /* New text to display in entry. */ { + char *oldSource; + + oldSource = entryPtr->string; + ckfree(entryPtr->string); - entryPtr->numChars = strlen(value); - entryPtr->string = (char *) ckalloc((unsigned) (entryPtr->numChars + 1)); + entryPtr->numBytes = strlen(value); + entryPtr->numChars = Tcl_NumUtfChars(value, entryPtr->numBytes); + entryPtr->string = + (char *) ckalloc((unsigned) (entryPtr->numBytes + 1)); strcpy(entryPtr->string, value); - if (entryPtr->selectFirst != -1) { + + if (entryPtr->displayString == oldSource) { + entryPtr->displayString = entryPtr->string; + entryPtr->numDisplayBytes = entryPtr->numBytes; + } + + if (entryPtr->selectFirst >= 0) { if (entryPtr->selectFirst >= entryPtr->numChars) { - entryPtr->selectFirst = entryPtr->selectLast = -1; + entryPtr->selectFirst = -1; + entryPtr->selectLast = -1; } else if (entryPtr->selectLast > entryPtr->numChars) { entryPtr->selectLast = entryPtr->numChars; } } if (entryPtr->leftIndex >= entryPtr->numChars) { - entryPtr->leftIndex = entryPtr->numChars-1; - if (entryPtr->leftIndex < 0) { + if (entryPtr->numChars > 0) { + entryPtr->leftIndex = entryPtr->numChars - 1; + } else { entryPtr->leftIndex = 0; } } @@ -1638,14 +1894,7 @@ EntryEventProc(clientData, eventPtr) EventuallyRedraw(entryPtr); entryPtr->flags |= BORDER_NEEDED; } else if (eventPtr->type == DestroyNotify) { - if (entryPtr->tkwin != NULL) { - entryPtr->tkwin = NULL; - Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd); - } - if (entryPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr); - } - Tcl_EventuallyFree((ClientData) entryPtr, DestroyEntry); + DestroyEntry((char *) clientData); } else if (eventPtr->type == ConfigureNotify) { Tcl_Preserve((ClientData) entryPtr); entryPtr->flags |= UPDATE_SCROLLBAR; @@ -1686,7 +1935,6 @@ EntryCmdDeletedProc(clientData) ClientData clientData; /* Pointer to widget record for widget. */ { Entry *entryPtr = (Entry *) clientData; - Tk_Window tkwin = entryPtr->tkwin; /* * This procedure could be invoked either because the window was @@ -1695,14 +1943,13 @@ EntryCmdDeletedProc(clientData) * destroys the widget. */ - if (tkwin != NULL) { - entryPtr->tkwin = NULL; - Tk_DestroyWindow(tkwin); + if (! entryPtr->flags & ENTRY_DELETED) { + Tk_DestroyWindow(entryPtr->tkwin); } } /* - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- * * GetEntryIndex -- * @@ -1711,15 +1958,15 @@ EntryCmdDeletedProc(clientData) * * Results: * A standard Tcl result. If all went well, then *indexPtr is - * filled in with the index (into entryPtr) corresponding to + * filled in with the character index (into entryPtr) corresponding to * string. The index value is guaranteed to lie between 0 and * the number of characters in the string, inclusive. If an - * error occurs then an error message is left in interp->result. + * error occurs then an error message is left in the interp's result. * * Side effects: * None. * - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- */ static int @@ -1728,7 +1975,8 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) Entry *entryPtr; /* Entry for which the index is being * specified. */ char *string; /* Specifies character in entryPtr. */ - int *indexPtr; /* Where to store converted index. */ + int *indexPtr; /* Where to store converted character + * index. */ { size_t length; @@ -1741,7 +1989,7 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) badIndex: /* - * Some of the paths here leave messages in interp->result, + * Some of the paths here leave messages in the interp's result, * so we have to clear it out before storing our own message. */ @@ -1763,8 +2011,8 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) goto badIndex; } } else if (string[0] == 's') { - if (entryPtr->selectFirst == -1) { - interp->result = "selection isn't in entry"; + if (entryPtr->selectFirst < 0) { + Tcl_SetResult(interp, "selection isn't in entry", TCL_STATIC); return TCL_ERROR; } if (length < 5) { @@ -1780,7 +2028,7 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) } else if (string[0] == '@') { int x, roundUp; - if (Tcl_GetInt(interp, string+1, &x) != TCL_OK) { + if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) { goto badIndex; } if (x < entryPtr->inset) { @@ -1812,7 +2060,7 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) *indexPtr = 0; } else if (*indexPtr > entryPtr->numChars) { *indexPtr = entryPtr->numChars; - } + } } return TCL_OK; } @@ -1836,9 +2084,8 @@ GetEntryIndex(interp, entryPtr, string, indexPtr) static void EntryScanTo(entryPtr, x) - register Entry *entryPtr; /* Information about widget. */ - int x; /* X-coordinate to use for scan - * operation. */ + Entry *entryPtr; /* Information about widget. */ + int x; /* X-coordinate to use for scan operation. */ { int newLeftIndex; @@ -1854,19 +2101,24 @@ EntryScanTo(entryPtr, x) */ newLeftIndex = entryPtr->scanMarkIndex - - (10*(x - entryPtr->scanMarkX))/entryPtr->avgWidth; + - (10 * (x - entryPtr->scanMarkX)) / entryPtr->avgWidth; if (newLeftIndex >= entryPtr->numChars) { - newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars-1; + newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars - 1; entryPtr->scanMarkX = x; } if (newLeftIndex < 0) { newLeftIndex = entryPtr->scanMarkIndex = 0; entryPtr->scanMarkX = x; } + if (newLeftIndex != entryPtr->leftIndex) { entryPtr->leftIndex = newLeftIndex; entryPtr->flags |= UPDATE_SCROLLBAR; EntryComputeGeometry(entryPtr); + if (newLeftIndex != entryPtr->leftIndex) { + entryPtr->scanMarkIndex = entryPtr->leftIndex; + entryPtr->scanMarkX = x; + } EventuallyRedraw(entryPtr); } } @@ -1890,10 +2142,9 @@ EntryScanTo(entryPtr, x) static void EntrySelectTo(entryPtr, index) - register Entry *entryPtr; /* Information about widget. */ - int index; /* Index of element that is to - * become the "other" end of the - * selection. */ + Entry *entryPtr; /* Information about widget. */ + int index; /* Character index of element that is to + * become the "other" end of the selection. */ { int newFirst, newLast; @@ -1956,38 +2207,35 @@ EntrySelectTo(entryPtr, index) static int EntryFetchSelection(clientData, offset, buffer, maxBytes) - ClientData clientData; /* Information about entry widget. */ - int offset; /* Offset within selection of first - * character to be returned. */ - char *buffer; /* Location in which to place - * selection. */ - int maxBytes; /* Maximum number of bytes to place - * at buffer, not including terminating - * NULL character. */ + ClientData clientData; /* Information about entry widget. */ + int offset; /* Byte offset within selection of first + * character to be returned. */ + char *buffer; /* Location in which to place selection. */ + int maxBytes; /* Maximum number of bytes to place at + * buffer, not including terminating NULL + * character. */ { Entry *entryPtr = (Entry *) clientData; - int count; - char *displayString; + int byteCount; + char *string, *selStart, *selEnd; if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) { return -1; } - count = entryPtr->selectLast - entryPtr->selectFirst - offset; - if (count > maxBytes) { - count = maxBytes; + string = entryPtr->displayString; + selStart = Tcl_UtfAtIndex(string, entryPtr->selectFirst); + selEnd = Tcl_UtfAtIndex(selStart, + entryPtr->selectLast - entryPtr->selectFirst); + byteCount = selEnd - selStart - offset; + if (byteCount > maxBytes) { + byteCount = maxBytes; } - if (count <= 0) { + if (byteCount <= 0) { return 0; } - if (entryPtr->displayString == NULL) { - displayString = entryPtr->string; - } else { - displayString = entryPtr->displayString; - } - strncpy(buffer, displayString + entryPtr->selectFirst + offset, - (size_t) count); - buffer[count] = '\0'; - return count; + memcpy(buffer, selStart + offset, (size_t) byteCount); + buffer[byteCount] = '\0'; + return byteCount; } /* @@ -2010,7 +2258,7 @@ EntryFetchSelection(clientData, offset, buffer, maxBytes) static void EntryLostSelection(clientData) - ClientData clientData; /* Information about entry widget. */ + ClientData clientData; /* Information about entry widget. */ { Entry *entryPtr = (Entry *) clientData; @@ -2023,7 +2271,7 @@ EntryLostSelection(clientData) */ #ifdef ALWAYS_SHOW_SELECTION - if ((entryPtr->selectFirst != -1) && entryPtr->exportSelection) { + if ((entryPtr->selectFirst >= 0) && entryPtr->exportSelection) { entryPtr->selectFirst = -1; entryPtr->selectLast = -1; EventuallyRedraw(entryPtr); @@ -2052,7 +2300,7 @@ EntryLostSelection(clientData) static void EventuallyRedraw(entryPtr) - register Entry *entryPtr; /* Information about widget. */ + Entry *entryPtr; /* Information about widget. */ { if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(entryPtr->tkwin)) { return; @@ -2091,11 +2339,11 @@ EventuallyRedraw(entryPtr) static void EntryVisibleRange(entryPtr, firstPtr, lastPtr) - Entry *entryPtr; /* Information about widget. */ - double *firstPtr; /* Return position of first visible - * character in widget. */ - double *lastPtr; /* Return position of char just after - * last visible one. */ + Entry *entryPtr; /* Information about widget. */ + double *firstPtr; /* Return position of first visible + * character in widget. */ + double *lastPtr; /* Return position of char just after last + * visible one. */ { int charsInWindow; @@ -2105,22 +2353,18 @@ EntryVisibleRange(entryPtr, firstPtr, lastPtr) } else { charsInWindow = Tk_PointToChar(entryPtr->textLayout, Tk_Width(entryPtr->tkwin) - entryPtr->inset - - entryPtr->layoutX - 1, 0) + 1; - if (charsInWindow > entryPtr->numChars) { - /* - * If all chars were visible, then charsInWindow will be - * the index just after the last char that was visible. - */ - - charsInWindow = entryPtr->numChars; + - entryPtr->layoutX - 1, 0); + if (charsInWindow < entryPtr->numChars) { + charsInWindow++; } charsInWindow -= entryPtr->leftIndex; if (charsInWindow == 0) { charsInWindow = 1; } - *firstPtr = ((double) entryPtr->leftIndex)/entryPtr->numChars; - *lastPtr = ((double) (entryPtr->leftIndex + charsInWindow)) - /entryPtr->numChars; + + *firstPtr = (double) entryPtr->leftIndex / entryPtr->numChars; + *lastPtr = (double) (entryPtr->leftIndex + charsInWindow) + / entryPtr->numChars; } } @@ -2148,7 +2392,7 @@ static void EntryUpdateScrollbar(entryPtr) Entry *entryPtr; /* Information about widget. */ { - char args[100]; + char args[TCL_DOUBLE_SPACE * 2]; int code; double first, last; Tcl_Interp *interp; @@ -2193,7 +2437,7 @@ static void EntryBlinkProc(clientData) ClientData clientData; /* Pointer to record describing entry. */ { - register Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = (Entry *) clientData; if (!(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) { return; @@ -2230,7 +2474,7 @@ EntryBlinkProc(clientData) static void EntryFocusProc(entryPtr, gotFocus) - register Entry *entryPtr; /* Entry that got or lost focus. */ + Entry *entryPtr; /* Entry that got or lost focus. */ int gotFocus; /* 1 means window is getting focus, 0 means * it's losing it. */ { @@ -2276,7 +2520,7 @@ EntryTextVarProc(clientData, interp, name1, name2, flags) char *name2; /* Not used. */ int flags; /* Information about what happened. */ { - register Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = (Entry *) clientData; char *value; /* diff --git a/generic/tkEvent.c b/generic/tkEvent.c index 6403001..a72be72 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkEvent.c,v 1.3 1998/10/10 00:30:36 rjohnson Exp $ + * RCS: @(#) $Id: tkEvent.c,v 1.4 1999/04/16 01:51:13 stanton Exp $ */ #include "tkPort.h" @@ -39,10 +39,6 @@ typedef struct InProgress { struct InProgress *nextPtr; /* Next higher nested search. */ } InProgress; -static InProgress *pendingPtr = NULL; - /* Topmost search in progress, or - * NULL if none. */ - /* * For each call to Tk_CreateGenericHandler, an instance of the following * structure will be created. All of the active handlers are linked into a @@ -58,11 +54,6 @@ typedef struct GenericHandler { * handlers, or NULL for end of list. */ } GenericHandler; -static GenericHandler *genericList = NULL; - /* First handler in the list, or NULL. */ -static GenericHandler *lastGenericPtr = NULL; - /* Last handler in list. */ - /* * There's a potential problem if Tk_HandleEvent is entered recursively. * A handler cannot be deleted physically until we have returned from @@ -70,11 +61,8 @@ static GenericHandler *lastGenericPtr = NULL; * its `next' entry. We deal with the problem by using the `delete flag' and * deleting handlers only when it's known that there's no handler active. * - * The following variable has a non-zero value when a handler is active. */ -static int genericHandlersActive = 0; - /* * The following structure is used for queueing X-style events on the * Tcl event queue. @@ -134,15 +122,37 @@ static unsigned long eventMasks[TK_LASTEVENT] = { MouseWheelMask /* MouseWheelEvent */ }; + /* - * If someone has called Tk_RestrictEvents, the information below - * keeps track of it. + * The structure below is used to store Data for the Event module that + * must be kept thread-local. The "dataKey" is used to fetch the + * thread-specific storage for the current thread. */ -static Tk_RestrictProc *restrictProc; +typedef struct ThreadSpecificData { + + int genericHandlersActive; + /* The following variable has a non-zero + * value when a handler is active. */ + InProgress *pendingPtr; + /* Topmost search in progress, or + * NULL if none. */ + GenericHandler *genericList; + /* First handler in the list, or NULL. */ + GenericHandler *lastGenericPtr; + /* Last handler in list. */ + + /* + * If someone has called Tk_RestrictEvents, the information below + * keeps track of it. + */ + + Tk_RestrictProc *restrictProc; /* Procedure to call. NULL means no * restrictProc is currently in effect. */ -static ClientData restrictArg; /* Argument to pass to restrictProc. */ + ClientData restrictArg; /* Argument to pass to restrictProc. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Prototypes for procedures that are only referenced locally within @@ -266,6 +276,8 @@ Tk_DeleteEventHandler(token, mask, proc, clientData) register InProgress *ipPtr; TkEventHandler *prevPtr; register TkWindow *winPtr = (TkWindow *) token; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Find the event handler to be deleted, or return @@ -288,7 +300,7 @@ Tk_DeleteEventHandler(token, mask, proc, clientData) * process the next one instead. */ - for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->nextHandler == handlerPtr) { ipPtr->nextHandler = handlerPtr->nextPtr; } @@ -337,6 +349,8 @@ Tk_CreateGenericHandler(proc, clientData) ClientData clientData; /* One-word value to pass to proc. */ { GenericHandler *handlerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler)); @@ -344,12 +358,12 @@ Tk_CreateGenericHandler(proc, clientData) handlerPtr->clientData = clientData; handlerPtr->deleteFlag = 0; handlerPtr->nextPtr = NULL; - if (genericList == NULL) { - genericList = handlerPtr; + if (tsdPtr->genericList == NULL) { + tsdPtr->genericList = handlerPtr; } else { - lastGenericPtr->nextPtr = handlerPtr; + tsdPtr->lastGenericPtr->nextPtr = handlerPtr; } - lastGenericPtr = handlerPtr; + tsdPtr->lastGenericPtr = handlerPtr; } /* @@ -377,8 +391,10 @@ Tk_DeleteGenericHandler(proc, clientData) ClientData clientData; { GenericHandler * handler; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - for (handler = genericList; handler; handler = handler->nextPtr) { + for (handler = tsdPtr->genericList; handler; handler = handler->nextPtr) { if ((handler->proc == proc) && (handler->clientData == clientData)) { handler->deleteFlag = 1; } @@ -388,6 +404,39 @@ Tk_DeleteGenericHandler(proc, clientData) /* *-------------------------------------------------------------- * + * TkEventInit -- + * + * This procedures initializes all the event module + * structures used by the current thread. It must be + * called before any other procedure in this file is + * called. + * + * Results: + * None. + * + * Side Effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +TkEventInit(void) +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + tsdPtr->genericHandlersActive = 0; + tsdPtr->pendingPtr = NULL; + tsdPtr->genericList = NULL; + tsdPtr->lastGenericPtr = NULL; + tsdPtr->restrictProc = NULL; + tsdPtr->restrictArg = NULL; +} + +/* + *-------------------------------------------------------------- + * * Tk_HandleEvent -- * * Given an event, invoke all the handlers that have @@ -415,6 +464,8 @@ Tk_HandleEvent(eventPtr) Window handlerWindow; TkDisplay *dispPtr; Tcl_Interp *interp = (Tcl_Interp *) NULL; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Next, invoke all the generic event handlers (those that are @@ -422,9 +473,10 @@ Tk_HandleEvent(eventPtr) * an event is fully processed, go no further. */ - for (genPrevPtr = NULL, genericPtr = genericList; genericPtr != NULL; ) { + for (genPrevPtr = NULL, genericPtr = tsdPtr->genericList; + genericPtr != NULL; ) { if (genericPtr->deleteFlag) { - if (!genericHandlersActive) { + if (!tsdPtr->genericHandlersActive) { GenericHandler *tmpPtr; /* @@ -435,12 +487,12 @@ Tk_HandleEvent(eventPtr) tmpPtr = genericPtr->nextPtr; if (genPrevPtr == NULL) { - genericList = tmpPtr; + tsdPtr->genericList = tmpPtr; } else { genPrevPtr->nextPtr = tmpPtr; } if (tmpPtr == NULL) { - lastGenericPtr = genPrevPtr; + tsdPtr->lastGenericPtr = genPrevPtr; } (void) ckfree((char *) genericPtr); genericPtr = tmpPtr; @@ -449,9 +501,9 @@ Tk_HandleEvent(eventPtr) } else { int done; - genericHandlersActive++; + tsdPtr->genericHandlersActive++; done = (*genericPtr->proc)(genericPtr->clientData, eventPtr); - genericHandlersActive--; + tsdPtr->genericHandlersActive--; if (done) { return; } @@ -623,8 +675,8 @@ Tk_HandleEvent(eventPtr) ip.eventPtr = eventPtr; ip.winPtr = winPtr; ip.nextHandler = NULL; - ip.nextPtr = pendingPtr; - pendingPtr = &ip; + ip.nextPtr = tsdPtr->pendingPtr; + tsdPtr->pendingPtr = &ip; if (mask == 0) { if ((eventPtr->type == SelectionClear) || (eventPtr->type == SelectionRequest) @@ -657,7 +709,7 @@ Tk_HandleEvent(eventPtr) TkBindEventProc(winPtr, eventPtr); } } - pendingPtr = ip.nextPtr; + tsdPtr->pendingPtr = ip.nextPtr; done: /* @@ -695,6 +747,8 @@ TkEventDeadWindow(winPtr) { register TkEventHandler *handlerPtr; register InProgress *ipPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * While deleting all the handlers, be careful to check for @@ -706,7 +760,8 @@ TkEventDeadWindow(winPtr) while (winPtr->handlerList != NULL) { handlerPtr = winPtr->handlerList; winPtr->handlerList = handlerPtr->nextPtr; - for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; + ipPtr = ipPtr->nextPtr) { if (ipPtr->nextHandler == handlerPtr) { ipPtr->nextHandler = NULL; } @@ -744,11 +799,13 @@ TkCurrentTime(dispPtr) TkDisplay *dispPtr; /* Display for which the time is desired. */ { register XEvent *eventPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (pendingPtr == NULL) { + if (tsdPtr->pendingPtr == NULL) { return dispPtr->lastEventTime; } - eventPtr = pendingPtr->eventPtr; + eventPtr = tsdPtr->pendingPtr->eventPtr; switch (eventPtr->type) { case ButtonPress: case ButtonRelease: @@ -798,11 +855,13 @@ Tk_RestrictEvents(proc, arg, prevArgPtr) * argument. */ { Tk_RestrictProc *prev; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - prev = restrictProc; - *prevArgPtr = restrictArg; - restrictProc = proc; - restrictArg = arg; + prev = tsdPtr->restrictProc; + *prevArgPtr = tsdPtr->restrictArg; + tsdPtr->restrictProc = proc; + tsdPtr->restrictArg = arg; return prev; } @@ -841,7 +900,7 @@ Tk_QueueWindowEvent(eventPtr, position) * Find our display structure for the event's display. */ - for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) { + for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) { if (dispPtr == NULL) { return; } @@ -962,12 +1021,14 @@ WindowEventProc(evPtr, flags) { TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr; Tk_RestrictAction result; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!(flags & TCL_WINDOW_EVENTS)) { return 0; } - if (restrictProc != NULL) { - result = (*restrictProc)(restrictArg, &wevPtr->event); + if (tsdPtr->restrictProc != NULL) { + result = (*tsdPtr->restrictProc)(tsdPtr->restrictArg, &wevPtr->event); if (result != TK_PROCESS_EVENT) { if (result == TK_DEFER_EVENT) { return 0; diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c index 6a8c54a..0528351 100644 --- a/generic/tkFileFilter.c +++ b/generic/tkFileFilter.c @@ -9,8 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFileFilter.c,v 1.2 1998/09/14 18:23:10 stanton Exp $ - * + * RCS: @(#) $Id: tkFileFilter.c,v 1.3 1999/04/16 01:51:13 stanton Exp $ */ #include "tkInt.h" diff --git a/generic/tkFocus.c b/generic/tkFocus.c index 0db24ff..31ca652 100644 --- a/generic/tkFocus.c +++ b/generic/tkFocus.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFocus.c,v 1.3 1999/02/04 20:53:53 stanton Exp $ + * RCS: @(#) $Id: tkFocus.c,v 1.4 1999/04/16 01:51:14 stanton Exp $ */ #include "tkInt.h" @@ -76,12 +76,6 @@ typedef struct TkDisplayFocusInfo { } DisplayFocusInfo; /* - * Global used for debugging. - */ - -int tclFocusDebug = 0; - -/* * 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 @@ -106,7 +100,7 @@ static void SetFocus _ANSI_ARGS_((TkWindow *winPtr, int force)); /* *-------------------------------------------------------------- * - * Tk_FocusCmd -- + * Tk_FocusObjCmd -- * * This procedure is invoked to process the "focus" Tcl command. * See the user documentation for details on what it does. @@ -121,28 +115,30 @@ static void SetFocus _ANSI_ARGS_((TkWindow *winPtr, int force)); */ int -Tk_FocusCmd(clientData, interp, argc, argv) +Tk_FocusObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { + static char *focusOptions[] = {"-displayof", "-force", "-lastfor", + (char *) NULL}; Tk_Window tkwin = (Tk_Window) clientData; TkWindow *winPtr = (TkWindow *) clientData; TkWindow *newPtr, *focusWinPtr, *topLevelPtr; ToplevelFocusInfo *tlFocusPtr; - char c; - size_t length; + char *windowName; + int index; /* * If invoked with no arguments, just return the current focus window. */ - if (argc == 1) { + if (objc == 1) { focusWinPtr = TkGetFocusWin(winPtr); if (focusWinPtr != NULL) { - interp->result = focusWinPtr->pathName; + Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC); } return TCL_OK; } @@ -152,12 +148,18 @@ Tk_FocusCmd(clientData, interp, argc, argv) * on that window. */ - if (argc == 2) { - if (argv[1][0] == 0) { + if (objc == 2) { + windowName = Tcl_GetStringFromObj(objv[1], (int *) NULL); + + /* + * The empty string case exists for backwards compatibility. + */ + + if (windowName[0] == '\0') { return TCL_OK; } - if (argv[1][0] == '.') { - newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); + if (windowName[0] == '.') { + newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin); if (newPtr == NULL) { return TCL_ERROR; } @@ -168,65 +170,72 @@ Tk_FocusCmd(clientData, interp, argc, argv) } } - length = strlen(argv[1]); - c = argv[1][1]; - if ((c == 'd') && (strncmp(argv[1], "-displayof", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " -displayof window\"", (char *) NULL); - return TCL_ERROR; - } - newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin); - if (newPtr == NULL) { - return TCL_ERROR; - } - newPtr = TkGetFocusWin(newPtr); - if (newPtr != NULL) { - interp->result = newPtr->pathName; - } - } else if ((c == 'f') && (strncmp(argv[1], "-force", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " -force window\"", (char *) NULL); - return TCL_ERROR; - } - if (argv[2][0] == 0) { - return TCL_OK; - } - newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin); - if (newPtr == NULL) { - return TCL_ERROR; - } - SetFocus(newPtr, 1); - } else if ((c == 'l') && (strncmp(argv[1], "-lastfor", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " -lastfor window\"", (char *) NULL); - return TCL_ERROR; + if (Tcl_GetIndexFromObj(interp, objv[1], focusOptions, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + switch (index) { + case 0: { /* -displayof */ + windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL); + newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin); + if (newPtr == NULL) { + return TCL_ERROR; + } + newPtr = TkGetFocusWin(newPtr); + if (newPtr != NULL) { + Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC); + } + break; } - newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin); - if (newPtr == NULL) { - return TCL_ERROR; + case 1: { /* -force */ + windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL); + + /* + * The empty string case exists for backwards compatibility. + */ + + if (windowName[0] == '\0') { + return TCL_OK; + } + newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin); + if (newPtr == NULL) { + return TCL_ERROR; + } + SetFocus(newPtr, 1); + break; } - for (topLevelPtr = newPtr; topLevelPtr != NULL; - topLevelPtr = topLevelPtr->parentPtr) { - if (topLevelPtr->flags & TK_TOP_LEVEL) { - for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr; - tlFocusPtr != NULL; - tlFocusPtr = tlFocusPtr->nextPtr) { - if (tlFocusPtr->topLevelPtr == topLevelPtr) { - interp->result = tlFocusPtr->focusWinPtr->pathName; - return TCL_OK; + case 2: { /* -lastfor */ + windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL); + newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin); + if (newPtr == NULL) { + return TCL_ERROR; + } + for (topLevelPtr = newPtr; topLevelPtr != NULL; + topLevelPtr = topLevelPtr->parentPtr) { + if (topLevelPtr->flags & TK_TOP_LEVEL) { + for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr; + tlFocusPtr != NULL; + tlFocusPtr = tlFocusPtr->nextPtr) { + if (tlFocusPtr->topLevelPtr == topLevelPtr) { + Tcl_SetResult(interp, + tlFocusPtr->focusWinPtr->pathName, + TCL_STATIC); + return TCL_OK; + } } + Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC); + return TCL_OK; } - interp->result = topLevelPtr->pathName; - return TCL_OK; } + break; + } + default: { + panic("bad const entries to focusOptions in focus command"); } - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be -displayof, -force, or -lastfor", (char *) NULL); - return TCL_ERROR; } return TCL_OK; } @@ -479,7 +488,7 @@ TkFocusFilterEvent(winPtr, eventPtr) if (eventPtr->xcrossing.focus && (displayFocusPtr->focusWinPtr == NULL) && !(winPtr->flags & TK_EMBEDDED)) { - if (tclFocusDebug) { + if (dispPtr->focusDebug) { printf("Focussed implicitly on %s\n", newFocusPtr->pathName); } @@ -504,7 +513,7 @@ TkFocusFilterEvent(winPtr, eventPtr) if ((dispPtr->implicitWinPtr != NULL) && !(winPtr->flags & TK_EMBEDDED)) { - if (tclFocusDebug) { + if (dispPtr->focusDebug) { printf("Defocussed implicit Async\n"); } GenerateFocusEvents(displayFocusPtr->focusWinPtr, @@ -820,7 +829,7 @@ TkFocusDeadWindow(winPtr) */ if (dispPtr->implicitWinPtr == winPtr) { - if (tclFocusDebug) { + if (dispPtr->focusDebug) { printf("releasing focus to root after %s died\n", tlFocusPtr->topLevelPtr->pathName); } @@ -848,7 +857,7 @@ TkFocusDeadWindow(winPtr) tlFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr; if ((displayFocusPtr->focusWinPtr == winPtr) && !(tlFocusPtr->topLevelPtr->flags & TK_ALREADY_DEAD)) { - if (tclFocusDebug) { + if (dispPtr->focusDebug) { printf("forwarding focus to %s after %s died\n", tlFocusPtr->topLevelPtr->pathName, winPtr->pathName); @@ -943,7 +952,7 @@ FocusMapProc(clientData, eventPtr) if (eventPtr->type == VisibilityNotify) { displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr); - if (tclFocusDebug) { + if (winPtr->dispPtr->focusDebug) { printf("auto-focussing on %s, force %d\n", winPtr->pathName, displayFocusPtr->forceFocus); } diff --git a/generic/tkFont.c b/generic/tkFont.c index 4c0ebb9..995fb01 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -6,14 +6,15 @@ * displaying text. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * 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. * - * RCS: @(#) $Id: tkFont.c,v 1.2 1998/09/14 18:23:10 stanton Exp $ + * RCS: @(#) $Id: tkFont.c,v 1.3 1999/04/16 01:51:14 stanton Exp $ */ +#include "tkPort.h" #include "tkInt.h" #include "tkFont.h" @@ -25,26 +26,19 @@ typedef struct TkFontInfo { Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font. - * Keys are CachedFontKey structs, values are - * TkFont structs. */ + * Keys are string font names, values are + * TkFont pointers. */ Tcl_HashTable namedTable; /* Map a name to a set of attributes for a * font, used when constructing a Tk_Font from * a named font description. Keys are - * Tk_Uids, values are NamedFont structs. */ + * strings, values are NamedFont pointers. */ TkMainInfo *mainPtr; /* Application that owns this structure. */ - int updatePending; + int updatePending; /* Non-zero when a World Changed event has + * already been queued to handle a change to + * a named font. */ } TkFontInfo; /* - * The following structure is used as a key in the fontCache. - */ - -typedef struct CachedFontKey { - Display *display; /* Display for which font was constructed. */ - Tk_Uid string; /* String that describes font. */ -} CachedFontKey; - -/* * The following data structure is used to keep track of the font attributes * for each named font that has been defined. The named font is only deleted * when the last reference to it goes away. @@ -77,6 +71,7 @@ typedef struct LayoutChunk { CONST char *start; /* Pointer to simple string to be displayed. * This is a pointer into the TkTextLayout's * string. */ + int numBytes; /* The number of bytes in this chunk. */ int numChars; /* The number of characters in this chunk. */ int numDisplayChars; /* The number of characters to display when * this chunk is displayed. Can be less than @@ -168,13 +163,6 @@ static TkStateMap xlfdSetwidthMap[] = { {TK_SW_UNKNOWN, NULL} }; -static TkStateMap xlfdCharsetMap[] = { - {TK_CS_NORMAL, "iso8859"}, - {TK_CS_SYMBOL, "adobe"}, - {TK_CS_SYMBOL, "sun"}, - {TK_CS_OTHER, NULL} -}; - /* * The following structure and defines specify the valid builtin options * when configuring a set of font attributes. @@ -196,7 +184,135 @@ static char *fontOpt[] = { #define FONT_SLANT 3 #define FONT_UNDERLINE 4 #define FONT_OVERSTRIKE 5 -#define FONT_NUMFIELDS 6 /* Length of fontOpt array. */ +#define FONT_NUMFIELDS 6 + +/* + * Hardcoded font aliases. These are used to describe (mostly) identical + * fonts whose names differ from platform to platform. If the + * user-supplied font name matches any of the names in one of the alias + * lists, the other names in the alias list are also automatically tried. + */ + +static char *timesAliases[] = { + "Times", /* Unix. */ + "Times New Roman", /* Windows. */ + "New York", /* Mac. */ + NULL +}; + +static char *helveticaAliases[] = { + "Helvetica", /* Unix. */ + "Arial", /* Windows. */ + "Geneva", /* Mac. */ + NULL +}; + +static char *courierAliases[] = { + "Courier", /* Unix and Mac. */ + "Courier New", /* Windows. */ + NULL +}; + +static char *minchoAliases[] = { + "mincho", /* Unix. */ + "\357\274\255\357\274\263 \346\230\216\346\234\235", + /* Windows (MS mincho). */ + "\346\234\254\346\230\216\346\234\235\342\210\222\357\274\255", + /* Mac (honmincho-M). */ + NULL +}; + +static char *gothicAliases[] = { + "gothic", /* Unix. */ + "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257", + /* Windows (MS goshikku). */ + "\344\270\270\343\202\264\343\202\267\343\203\203\343\202\257\342\210\222\357\274\255", + /* Mac (goshikku-M). */ + NULL +}; + +static char *dingbatsAliases[] = { + "dingbats", "zapfdingbats", "itc zapfdingbats", + /* Unix. */ + /* Windows. */ + "zapf dingbats", /* Mac. */ + NULL +}; + +static char **fontAliases[] = { + timesAliases, + helveticaAliases, + courierAliases, + minchoAliases, + gothicAliases, + dingbatsAliases, + NULL +}; + +/* + * Hardcoded font classes. If the character cannot be found in the base + * font, the classes are examined in order to see if some other similar + * font should be examined also. + */ + +static char *systemClass[] = { + "fixed", /* Unix. */ + /* Windows. */ + "chicago", "osaka", "sistemny", /* Mac. */ + NULL +}; + +static char *serifClass[] = { + "times", "palatino", "mincho", /* All platforms. */ + "song ti", /* Unix. */ + "ms serif", "simplified arabic", /* Windows. */ + "latinski", /* Mac. */ + NULL +}; + +static char *sansClass[] = { + "helvetica", "gothic", /* All platforms. */ + /* Unix. */ + "ms sans serif", "traditional arabic", + /* Windows. */ + "bastion", /* Mac. */ + NULL +}; + +static char *monoClass[] = { + "courier", "gothic", /* All platforms. */ + "fangsong ti", /* Unix. */ + "simplified arabic fixed", /* Windows. */ + "monaco", "pryamoy", /* Mac. */ + NULL +}; + +static char *symbolClass[] = { + "symbol", "dingbats", "wingdings", NULL +}; + +static char **fontFallbacks[] = { + systemClass, + serifClass, + sansClass, + monoClass, + symbolClass, + NULL +}; + +/* + * Global fallbacks. If the character could not be found in the preferred + * fallback list, this list is examined. If the character still cannot be + * found, all font families in the system are examined. + */ + +static char *globalFontClass[] = { + "symbol", /* All platforms. */ + /* Unix. */ + "lucida sans unicode", /* Windows. */ + "chicago", /* Mac. */ + NULL +}; #define GetFontAttributes(tkfont) \ ((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa) @@ -208,7 +324,13 @@ static char *fontOpt[] = { static int ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[], TkFontAttributes *faPtr)); +static int CreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, CONST char *name, + TkFontAttributes *faPtr)); +static void DupFontObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr, + Tcl_Obj *dupObjPtr)); static int FieldSpecified _ANSI_ARGS_((CONST char *field)); +static void FreeFontObjProc _ANSI_ARGS_((Tcl_Obj *objPtr)); static int GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp, CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr)); static LayoutChunk * NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr, @@ -218,12 +340,27 @@ static int ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, TkFontAttributes *faPtr)); static void RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr)); +static int SetFontFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); static void TheWorldHasChanged _ANSI_ARGS_(( ClientData clientData)); -static void UpdateDependantFonts _ANSI_ARGS_((TkFontInfo *fiPtr, +static void UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr, Tk_Window tkwin, Tcl_HashEntry *namedHashPtr)); - +/* + * The following structure defines the implementation of the "font" Tcl + * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of + * each font object points to the TkFont structure for the font, or + * NULL. + */ + +static Tcl_ObjType fontObjType = { + "font", /* name */ + FreeFontObjProc, /* freeIntRepProc */ + DupFontObjProc, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetFontFromAny /* setFromAnyProc */ +}; /* @@ -236,8 +373,8 @@ static void UpdateDependantFonts _ANSI_ARGS_((TkFontInfo *fiPtr, * package on a per application basis. * * Results: - * Returns a token that must be stored in the TkMainInfo for this - * application. + * Stores a token in the mainPtr to hold information needed by this + * package on a per application basis. * * Side effects: * Memory allocated. @@ -251,11 +388,13 @@ TkFontPkgInit(mainPtr) TkFontInfo *fiPtr; fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo)); - Tcl_InitHashTable(&fiPtr->fontCache, sizeof(CachedFontKey) / sizeof(int)); - Tcl_InitHashTable(&fiPtr->namedTable, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS); + Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS); fiPtr->mainPtr = mainPtr; fiPtr->updatePending = 0; mainPtr->fontInfoPtr = fiPtr; + + TkpFontPkgInit(mainPtr); } /* @@ -281,12 +420,21 @@ TkFontPkgFree(mainPtr) TkMainInfo *mainPtr; /* The application being deleted. */ { TkFontInfo *fiPtr; - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr, *searchPtr; Tcl_HashSearch search; + int fontsLeft; fiPtr = mainPtr->fontInfoPtr; - if (fiPtr->fontCache.numEntries != 0) { + fontsLeft = 0; + for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search); + searchPtr != NULL; + searchPtr = Tcl_NextHashEntry(&search)) { + fontsLeft++; + fprintf(stderr, "Font %s still in cache.\n", + Tcl_GetHashKey(&fiPtr->fontCache, searchPtr)); + } + if (fontsLeft) { panic("TkFontPkgFree: all fonts should have been freed already"); } Tcl_DeleteHashTable(&fiPtr->fontCache); @@ -368,7 +516,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) "font ?-displayof window? ?option?"); return TCL_ERROR; } - tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]); + tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]); if (tkfont == NULL) { return TCL_ERROR; } @@ -394,14 +542,14 @@ Tk_FontObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?"); return TCL_ERROR; } - string = Tk_GetUid(Tcl_GetStringFromObj(objv[2], NULL)); + 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_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string, + Tcl_AppendResult(interp, "named font \"", string, "\" doesn't exist", NULL); return TCL_ERROR; } @@ -412,7 +560,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) } else { result = ConfigAttributesObj(interp, tkwin, objc - 3, objv + 3, &nfPtr->fa); - UpdateDependantFonts(fiPtr, tkwin, namedHashPtr); + UpdateDependentFonts(fiPtr, tkwin, namedHashPtr); return result; } return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr); @@ -420,7 +568,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) case FONT_CREATE: { int skip, i; char *name; - char buf[32]; + char buf[16 + TCL_INTEGER_SPACE]; TkFontAttributes fa; Tcl_HashEntry *namedHashPtr; @@ -428,7 +576,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) if (objc < 3) { name = NULL; } else { - name = Tcl_GetStringFromObj(objv[2], NULL); + name = Tcl_GetString(objv[2]); if (name[0] == '-') { name = NULL; } @@ -440,8 +588,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) for (i = 1; ; i++) { sprintf(buf, "font%d", i); - namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, - Tk_GetUid(buf)); + namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf); if (namedHashPtr == NULL) { break; } @@ -454,10 +601,10 @@ Tk_FontObjCmd(clientData, interp, objc, objv) &fa) != TCL_OK) { return TCL_ERROR; } - if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { + if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { return TCL_ERROR; } - Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1); + Tcl_AppendResult(interp, name, NULL); break; } case FONT_DELETE: { @@ -476,10 +623,10 @@ Tk_FontObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } for (i = 2; i < objc; i++) { - string = Tk_GetUid(Tcl_GetStringFromObj(objv[i], NULL)); + string = Tcl_GetString(objv[i]); namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string); if (namedHashPtr == NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string, + Tcl_AppendResult(interp, "named font \"", string, "\" doesn't exist", (char *) NULL); return TCL_ERROR; } @@ -511,6 +658,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) char *string; Tk_Font tkfont; int length, skip; + Tcl_Obj *resultPtr; skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin); if (skip < 0) { @@ -521,17 +669,17 @@ Tk_FontObjCmd(clientData, interp, objc, objv) "font ?-displayof window? text"); return TCL_ERROR; } - tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]); + tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]); if (tkfont == NULL) { return TCL_ERROR; } string = Tcl_GetStringFromObj(objv[3 + skip], &length); - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_TextWidth(tkfont, string, length)); + resultPtr = Tcl_GetObjResult(interp); + Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length)); Tk_FreeFont(tkfont); break; } case FONT_METRICS: { - char buf[64]; Tk_Font tkfont; int skip, index, i; CONST TkFontMetrics *fmPtr; @@ -548,7 +696,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) "font ?-displayof window? ?option?"); return TCL_ERROR; } - tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]); + tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]); if (tkfont == NULL) { return TCL_ERROR; } @@ -556,11 +704,13 @@ Tk_FontObjCmd(clientData, interp, objc, objv) 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", fmPtr->ascent, fmPtr->descent, fmPtr->ascent + fmPtr->descent, fmPtr->fixed); - Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1); + Tcl_AppendResult(interp, buf, NULL); } else { if (Tcl_GetIndexFromObj(interp, objv[3], switches, "metric", 0, &index) != TCL_OK) { @@ -582,22 +732,23 @@ Tk_FontObjCmd(clientData, interp, objc, objv) } case FONT_NAMES: { char *string; - Tcl_Obj *strPtr; NamedFont *nfPtr; Tcl_HashSearch search; Tcl_HashEntry *namedHashPtr; + Tcl_Obj *strPtr, *resultPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "names"); return TCL_ERROR; } + resultPtr = Tcl_GetObjResult(interp); 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, Tcl_GetObjResult(interp), strPtr); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } namedHashPtr = Tcl_NextHashEntry(&search); } @@ -610,7 +761,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) /* *--------------------------------------------------------------------------- * - * UpdateDependantFonts, TheWorldHasChanged, RecomputeWidgets -- + * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets -- * * Called when the attributes of a named font changes. Updates all * the instantiated fonts that depend on that named font and then @@ -627,7 +778,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv) */ static void -UpdateDependantFonts(fiPtr, tkwin, namedHashPtr) +UpdateDependentFonts(fiPtr, tkwin, namedHashPtr) TkFontInfo *fiPtr; /* Info about application's fonts. */ Tk_Window tkwin; /* A window in the application. */ Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */ @@ -647,15 +798,16 @@ UpdateDependantFonts(fiPtr, tkwin, namedHashPtr) return; } - cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search); while (cacheHashPtr != NULL) { - fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr); - if (fontPtr->namedHashPtr == namedHashPtr) { - TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa); - if (fiPtr->updatePending == 0) { - fiPtr->updatePending = 1; - Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr); + for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr); + fontPtr != NULL; fontPtr = fontPtr->nextPtr) { + if (fontPtr->namedHashPtr == namedHashPtr) { + TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa); + if (fiPtr->updatePending == 0) { + fiPtr->updatePending = 1; + Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr); + } } } cacheHashPtr = Tcl_NextHashEntry(&search); @@ -690,7 +842,7 @@ RecomputeWidgets(winPtr) /* *--------------------------------------------------------------------------- * - * TkCreateNamedFont -- + * CreateNamedFont -- * * Create the specified named font with the given attributes in the * named font table associated with the interp. @@ -698,7 +850,7 @@ RecomputeWidgets(winPtr) * Results: * Returns TCL_OK if the font was successfully created, or TCL_ERROR * if the named font already existed. If TCL_ERROR is returned, an - * error message is left in interp->result. + * error message is left in the interp's result. * * Side effects: * Assume there used to exist a named font by the specified name, and @@ -711,8 +863,8 @@ RecomputeWidgets(winPtr) *--------------------------------------------------------------------------- */ -int -TkCreateNamedFont(interp, tkwin, name, faPtr) +static int +CreateNamedFont(interp, tkwin, name, faPtr) Tcl_Interp *interp; /* Interp for error return. */ Tk_Window tkwin; /* A window associated with interp. */ CONST char *name; /* Name for the new named font. */ @@ -725,14 +877,13 @@ TkCreateNamedFont(interp, tkwin, name, faPtr) fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; - name = Tk_GetUid(name); namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new); if (new == 0) { nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); if (nfPtr->deletePending == 0) { - interp->result[0] = '\0'; - Tcl_AppendResult(interp, "font \"", name, + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "named font \"", name, "\" already exists", (char *) NULL); return TCL_ERROR; } @@ -745,7 +896,7 @@ TkCreateNamedFont(interp, tkwin, name, faPtr) nfPtr->fa = *faPtr; nfPtr->deletePending = 0; - UpdateDependantFonts(fiPtr, tkwin, namedHashPtr); + UpdateDependentFonts(fiPtr, tkwin, namedHashPtr); return TCL_OK; } @@ -769,13 +920,13 @@ TkCreateNamedFont(interp, tkwin, name, faPtr) * Results: * The return value is token for the font, or NULL if an error * prevented the font from being created. If NULL is returned, an - * error message will be left in interp->result. + * error message will be left in the interp's result. * * Side effects: - * Calls Tk_GetFontFromObj(), which modifies interp's result object, - * then copies the string from the result object into interp->result. - * This procedure will go away when Tk_ConfigureWidget() is - * made into an object command. + * The font is added to an internal database with a reference + * count. For each call to this procedure, there should eventually + * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the + * database is cleaned up when fonts aren't in use anymore. * *--------------------------------------------------------------------------- */ @@ -787,26 +938,20 @@ Tk_GetFont(interp, tkwin, string) CONST char *string; /* String describing font, as: named font, * native format, or parseable string. */ { + Tk_Font tkfont; Tcl_Obj *strPtr; - Tk_Font tkfont; - - strPtr = Tcl_NewStringObj((char *) string, -1); - - tkfont = Tk_GetFontFromObj(interp, tkwin, strPtr); - if (tkfont == NULL) { - Tcl_SetResult(interp, - Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL), - TCL_VOLATILE); - } - Tcl_DecrRefCount(strPtr); /* done with object */ + strPtr = Tcl_NewStringObj((char *) string, -1); + Tcl_IncrRefCount(strPtr); + tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr); + Tcl_DecrRefCount(strPtr); return tkfont; } /* *--------------------------------------------------------------------------- * - * Tk_GetFontFromObj -- + * Tk_AllocFontFromObj -- * * Given a string description of a font, map the description to a * corresponding Tk_Font that represents the font. @@ -819,46 +964,77 @@ Tk_GetFont(interp, tkwin, string) * Side effects: * The font is added to an internal database with a reference * count. For each call to this procedure, there should eventually - * be a call to Tk_FreeFont() so that the database is cleaned up when - * fonts aren't in use anymore. + * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the + * database is cleaned up when fonts aren't in use anymore. * *--------------------------------------------------------------------------- */ Tk_Font -Tk_GetFontFromObj(interp, tkwin, objPtr) +Tk_AllocFontFromObj(interp, tkwin, objPtr) Tcl_Interp *interp; /* Interp for database and error return. */ - Tk_Window tkwin; /* For display on which font will be used. */ + Tk_Window tkwin; /* For screen on which font will be used. */ Tcl_Obj *objPtr; /* Object describing font, as: named font, * native format, or parseable string. */ { TkFontInfo *fiPtr; - CachedFontKey key; Tcl_HashEntry *cacheHashPtr, *namedHashPtr; - TkFont *fontPtr; + TkFont *fontPtr, *firstFontPtr, *oldFontPtr; int new, descent; NamedFont *nfPtr; - char *string; - + fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; - string = Tcl_GetStringFromObj(objPtr, NULL); + if (objPtr->typePtr != &fontObjType) { + SetFontFromAny(interp, objPtr); + } - key.display = Tk_Display(tkwin); - key.string = Tk_GetUid(string); - cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, (char *) &key, &new); + oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1; - if (new == 0) { - /* - * We have already constructed a font with this description for - * this display. Bump the reference count of the cached font. - */ + if (oldFontPtr != NULL) { + if (oldFontPtr->resourceRefCount == 0) { + /* + * This is a stale reference: it refers to a TkFont that's + * no longer in use. Clear the reference. + */ - fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr); - fontPtr->refCount++; - return (Tk_Font) fontPtr; + FreeFontObjProc(objPtr); + oldFontPtr = NULL; + } else if (Tk_Screen(tkwin) == oldFontPtr->screen) { + oldFontPtr->resourceRefCount++; + return (Tk_Font) oldFontPtr; + } + } + + /* + * Next, search the list of fonts that have the name we want, to see + * if one of them is for the right screen. + */ + + new = 0; + if (oldFontPtr != NULL) { + cacheHashPtr = oldFontPtr->cacheHashPtr; + FreeFontObjProc(objPtr); + } else { + cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, + Tcl_GetString(objPtr), &new); + } + firstFontPtr = (TkFont *) 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; + return (Tk_Font) fontPtr; + } } - namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, key.string); + /* + * The desired font isn't in the table. Make a new one. + */ + + namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, + Tcl_GetString(objPtr)); if (namedHashPtr != NULL) { /* * Construct a font based on a named font. @@ -873,15 +1049,19 @@ Tk_GetFontFromObj(interp, tkwin, objPtr) * Native font? */ - fontPtr = TkpGetNativeFont(tkwin, string); + fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr)); if (fontPtr == NULL) { TkFontAttributes fa; + Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr); - TkInitFontAttributes(&fa); - if (ParseFontNameObj(interp, tkwin, objPtr, &fa) != TCL_OK) { - Tcl_DeleteHashEntry(cacheHashPtr); + if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) { + if (new) { + Tcl_DeleteHashEntry(cacheHashPtr); + } + Tcl_DecrRefCount(dupObjPtr); return NULL; } + Tcl_DecrRefCount(dupObjPtr); /* * String contained the attributes inline. @@ -890,13 +1070,16 @@ Tk_GetFontFromObj(interp, tkwin, objPtr) fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa); } } - Tcl_SetHashValue(cacheHashPtr, fontPtr); - fontPtr->refCount = 1; - fontPtr->cacheHashPtr = cacheHashPtr; - fontPtr->namedHashPtr = namedHashPtr; + fontPtr->resourceRefCount = 1; + fontPtr->objRefCount = 1; + fontPtr->cacheHashPtr = cacheHashPtr; + fontPtr->namedHashPtr = namedHashPtr; + fontPtr->screen = Tk_Screen(tkwin); + fontPtr->nextPtr = firstFontPtr; + Tcl_SetHashValue(cacheHashPtr, fontPtr); - Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, 0, 0, &fontPtr->tabWidth); + Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth); if (fontPtr->tabWidth == 0) { fontPtr->tabWidth = fontPtr->fm.maxWidth; } @@ -918,7 +1101,7 @@ Tk_GetFontFromObj(interp, tkwin, objPtr) descent = fontPtr->fm.descent; fontPtr->underlinePos = descent / 2; - fontPtr->underlineHeight = fontPtr->fa.pointsize / 10; + fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10; if (fontPtr->underlineHeight == 0) { fontPtr->underlineHeight = 1; } @@ -936,10 +1119,125 @@ Tk_GetFontFromObj(interp, tkwin, objPtr) } } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr; return (Tk_Font) fontPtr; } /* + *---------------------------------------------------------------------- + * + * Tk_GetFontFromObj -- + * + * Find the font that corresponds to a given object. The font must + * have already been created by Tk_GetFont or Tk_AllocFontFromObj. + * + * Results: + * The return value is a token for the font that matches objPtr + * and is suitable for use in tkwin. + * + * Side effects: + * If the object is not already a font ref, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +Tk_Font +Tk_GetFontFromObj(tkwin, objPtr) + 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 != &fontObjType) { + SetFontFromAny((Tcl_Interp *) NULL, objPtr); + } + + fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1; + + if (fontPtr != NULL) { + if (fontPtr->resourceRefCount == 0) { + /* + * This is a stale reference: it refers to a TkFont that's + * no longer in use. Clear the reference. + */ + + FreeFontObjProc(objPtr); + fontPtr = NULL; + } else if (Tk_Screen(tkwin) == fontPtr->screen) { + return (Tk_Font) fontPtr; + } + } + + /* + * Next, search the list of fonts that have the name we want, to see + * if one of them is for the right screen. + */ + + if (fontPtr != NULL) { + hashPtr = fontPtr->cacheHashPtr; + FreeFontObjProc(objPtr); + } else { + hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr)); + } + if (hashPtr != NULL) { + for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL; + fontPtr = fontPtr->nextPtr) { + if (Tk_Screen(tkwin) == fontPtr->screen) { + fontPtr->objRefCount++; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr; + return (Tk_Font) fontPtr; + } + } + } + + panic("Tk_GetFontFromObj called with non-existent font!"); + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * SetFontFromAny -- + * + * Convert the internal representation of a Tcl object to the + * font internal form. + * + * Results: + * Always returns TCL_OK. + * + * Side effects: + * The object is left with its typePtr pointing to fontObjType. + * The TkFont pointer is NULL. + * + *---------------------------------------------------------------------- + */ + +static int +SetFontFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + + /* + * Free the old internalRep before setting the new one. + */ + + Tcl_GetString(objPtr); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &fontObjType; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + + return TCL_OK; +} + +/* *--------------------------------------------------------------------------- * * Tk_NameOfFont -- @@ -963,14 +1261,9 @@ Tk_NameOfFont(tkfont) Tk_Font tkfont; /* Font whose name is desired. */ { TkFont *fontPtr; - Tcl_HashEntry *hPtr; - CachedFontKey *keyPtr; fontPtr = (TkFont *) tkfont; - hPtr = fontPtr->cacheHashPtr; - - keyPtr = (CachedFontKey *) Tcl_GetHashKey(hPtr->tablePtr, hPtr); - return (char *) keyPtr->string; + return fontPtr->cacheHashPtr->key.string; } /* @@ -994,30 +1287,144 @@ void Tk_FreeFont(tkfont) Tk_Font tkfont; /* Font to be released. */ { - TkFont *fontPtr; + TkFont *fontPtr, *prevPtr; NamedFont *nfPtr; if (tkfont == NULL) { return; } fontPtr = (TkFont *) tkfont; - fontPtr->refCount--; - if (fontPtr->refCount == 0) { - if (fontPtr->namedHashPtr != NULL) { - /* - * The font is being deleted. Determine if the associated named - * font definition should and/or can be deleted too. - */ + fontPtr->resourceRefCount--; + if (fontPtr->resourceRefCount > 0) { + return; + } + if (fontPtr->namedHashPtr != NULL) { + /* + * This font derived from a named font. Reduce the reference + * count on the named font and free it if no-one else is + * using it. + */ - nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr); - nfPtr->refCount--; - if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) { - Tcl_DeleteHashEntry(fontPtr->namedHashPtr); - ckfree((char *) nfPtr); - } + nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr); + nfPtr->refCount--; + if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) { + Tcl_DeleteHashEntry(fontPtr->namedHashPtr); + ckfree((char *) nfPtr); } - Tcl_DeleteHashEntry(fontPtr->cacheHashPtr); - TkpDeleteFont(fontPtr); + } + + prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr); + if (prevPtr == fontPtr) { + if (fontPtr->nextPtr == NULL) { + Tcl_DeleteHashEntry(fontPtr->cacheHashPtr); + } else { + Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr); + } + } else { + while (prevPtr->nextPtr != fontPtr) { + prevPtr = prevPtr->nextPtr; + } + prevPtr->nextPtr = fontPtr->nextPtr; + } + + TkpDeleteFont(fontPtr); + if (fontPtr->objRefCount == 0) { + ckfree((char *) fontPtr); + } +} + +/* + *--------------------------------------------------------------------------- + * + * Tk_FreeFontFromObj -- + * + * Called to release a font inside a Tcl_Obj *. Decrements the refCount + * of the font and removes it from the hash tables if necessary. + * + * Results: + * None. + * + * Side effects: + * The reference count associated with font is decremented, and + * only deallocated when no one is using it. + * + *--------------------------------------------------------------------------- + */ + +void +Tk_FreeFontFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window this font lives in. Needed + * for the screen value. */ + Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */ +{ + Tk_FreeFont(Tk_GetFontFromObj(tkwin, objPtr)); +} + +/* + *--------------------------------------------------------------------------- + * + * FreeFontObjProc -- + * + * 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 needs to be changed. + * + * Results: + * None. + * + * Side effects: + * The object reference count is decremented. When both it + * and the hash ref count go to zero, the font's resources + * are released. + * + *--------------------------------------------------------------------------- + */ + +static void +FreeFontObjProc(objPtr) + Tcl_Obj *objPtr; /* The object we are releasing. */ +{ + TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1; + + if (fontPtr != NULL) { + fontPtr->objRefCount--; + if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) { + ckfree((char *) fontPtr); + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + } + } +} + +/* + *--------------------------------------------------------------------------- + * + * DupFontObjProc -- + * + * When a cached font object is duplicated, this is called to + * update the internal reps. + * + * Results: + * None. + * + * Side effects: + * The font's objRefCount is incremented and the internal rep + * of the copy is set to point to it. + * + *--------------------------------------------------------------------------- + */ + +static void +DupFontObjProc(srcObjPtr, dupObjPtr) + 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; + + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr; + + if (fontPtr != NULL) { + fontPtr->objRefCount++; } } @@ -1112,7 +1519,6 @@ Tk_GetFontMetrics(tkfont, fmPtr) *--------------------------------------------------------------------------- */ - int Tk_PostscriptFontName(tkfont, dsPtr) Tk_Font tkfont; /* Font in which text will be printed. */ @@ -1154,6 +1560,8 @@ Tk_PostscriptFontName(tkfont, dsPtr) } else if (strcasecmp(family, "ZapfDingbats") == 0) { family = "ZapfDingbats"; } else { + Tcl_UniChar ch; + /* * Inline, capitalize the first letter of each word, lowercase the * rest of the letters in each word, and then take out the spaces @@ -1165,16 +1573,19 @@ Tk_PostscriptFontName(tkfont, dsPtr) src = dest = Tcl_DStringValue(dsPtr) + len; upper = 1; - for (; *src != '\0'; src++, dest++) { - while (isspace(UCHAR(*src))) { + for (; *src != '\0'; ) { + while (isspace(UCHAR(*src))) { /* INTL: ISO space */ src++; upper = 1; } - *dest = *src; - if ((upper != 0) && (islower(UCHAR(*src)))) { - *dest = toupper(UCHAR(*src)); + src += Tcl_UtfToUniChar(src, &ch); + if (upper) { + ch = Tcl_UniCharToUpper(ch); + upper = 0; + } else { + ch = Tcl_UniCharToLower(ch); } - upper = 0; + dest += Tcl_UniCharToUtf(ch, dest); } *dest = '\0'; Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr)); @@ -1251,7 +1662,7 @@ Tk_PostscriptFontName(tkfont, dsPtr) } } - return fontPtr->fa.pointsize; + return fontPtr->fa.size; } /* @@ -1273,18 +1684,18 @@ Tk_PostscriptFontName(tkfont, dsPtr) */ int -Tk_TextWidth(tkfont, string, numChars) +Tk_TextWidth(tkfont, string, numBytes) Tk_Font tkfont; /* Font in which text will be measured. */ CONST char *string; /* String whose width will be computed. */ - int numChars; /* Number of characters to consider from + int numBytes; /* Number of bytes to consider from * string, or < 0 for strlen(). */ { int width; - if (numChars < 0) { - numChars = strlen(string); + if (numBytes < 0) { + numBytes = strlen(string); } - Tk_MeasureChars(tkfont, string, numChars, 0, 0, &width); + Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width); return width; } @@ -1311,8 +1722,8 @@ Tk_TextWidth(tkfont, string, numChars) */ void -Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstChar, - lastChar) +Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstByte, + lastByte) Display *display; /* Display on which to draw. */ Drawable drawable; /* Window or pixmap in which to draw. */ GC gc; /* Graphics context for actually drawing @@ -1324,16 +1735,17 @@ Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstChar, * underlined or overstruck. */ int x, y; /* Coordinates at which first character of * string is drawn. */ - int firstChar; /* Index of first character. */ - int lastChar; /* Index of one after the last character. */ + int firstByte; /* Index of first byte of first character. */ + int lastByte; /* Index of first byte after the last + * character. */ { TkFont *fontPtr; int startX, endX; fontPtr = (TkFont *) tkfont; - Tk_MeasureChars(tkfont, string, firstChar, 0, 0, &startX); - Tk_MeasureChars(tkfont, string, lastChar, 0, 0, &endX); + Tk_MeasureChars(tkfont, string, firstByte, -1, 0, &startX); + Tk_MeasureChars(tkfont, string, lastByte, -1, 0, &endX); XFillRectangle(display, drawable, gc, x + startX, y + fontPtr->underlinePos, (unsigned int) (endX - startX), @@ -1394,18 +1806,16 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, { TkFont *fontPtr; CONST char *start, *end, *special; - int n, y, charsThisChunk, maxChunks; + int n, y, bytesThisChunk, maxChunks; int baseline, height, curX, newX, maxWidth; TextLayout *layoutPtr; LayoutChunk *chunkPtr; CONST TkFontMetrics *fmPtr; -#define MAX_LINES 50 - int staticLineLengths[MAX_LINES]; + Tcl_DString lineBuffer; int *lineLengths; - int maxLines, curLine, layoutHeight; + int curLine, layoutHeight; - lineLengths = staticLineLengths; - maxLines = MAX_LINES; + Tcl_DStringInit(&lineBuffer); fontPtr = (TkFont *) tkfont; fmPtr = &fontPtr->fm; @@ -1413,7 +1823,10 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, height = fmPtr->ascent + fmPtr->descent; if (numChars < 0) { - numChars = strlen(string); + numChars = Tcl_NumUtfChars(string, -1); + } + if (wrapLength == 0) { + wrapLength = -1; } maxChunks = 1; @@ -1433,16 +1846,20 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, curX = 0; - end = string + numChars; + end = Tcl_UtfAtIndex(string, numChars); special = string; flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES; flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE; - curLine = 0; for (start = string; start < end; ) { if (start >= special) { /* * Find the next special character in the string. + * + * INTL: Note that it is safe to increment by byte, because we are + * looking for 7-bit characters that will appear unchanged in + * UTF-8. At some point we may need to support the full Unicode + * whitespace set. */ for (special = start; special < end; special++) { @@ -1466,15 +1883,15 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, chunkPtr = NULL; if (start < special) { - charsThisChunk = Tk_MeasureChars(tkfont, start, special - start, + bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start, wrapLength - curX, flags, &newX); newX += curX; flags &= ~TK_AT_LEAST_ONE; - if (charsThisChunk > 0) { + if (bytesThisChunk > 0) { chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, - charsThisChunk, curX, newX, baseline); + bytesThisChunk, curX, newX, baseline); - start += charsThisChunk; + start += bytesThisChunk; curX = newX; } } @@ -1482,6 +1899,9 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, if ((start == special) && (special < end)) { /* * Handle the special character. + * + * INTL: Special will be pointing at a 7-bit character so we + * can safely treat it as a single byte. */ chunkPtr = NULL; @@ -1515,7 +1935,7 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, * Consume all extra spaces at end of line. */ - while ((start < end) && isspace(UCHAR(*start))) { + while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */ if (!(flags & TK_IGNORE_NEWLINES)) { if ((*start == '\n') || (*start == '\r')) { break; @@ -1529,15 +1949,21 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, start++; } if (chunkPtr != NULL) { + CONST char *end; + /* * Append all the extra spaces on this line to the end of the - * last text chunk. + * last text chunk. This is a little tricky because we are + * switching back and forth between characters and bytes. */ - charsThisChunk = start - (chunkPtr->start + chunkPtr->numChars); - if (charsThisChunk > 0) { - chunkPtr->numChars += Tk_MeasureChars(tkfont, - chunkPtr->start + chunkPtr->numChars, charsThisChunk, - 0, 0, &chunkPtr->totalWidth); + + end = chunkPtr->start + chunkPtr->numBytes; + bytesThisChunk = start - end; + if (bytesThisChunk > 0) { + bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk, + -1, 0, &chunkPtr->totalWidth); + chunkPtr->numBytes += bytesThisChunk; + chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk); chunkPtr->totalWidth += curX; } } @@ -1559,19 +1985,7 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, * can be centered or right justified, if necessary. */ - if (curLine >= maxLines) { - int *newLengths; - - newLengths = (int *) ckalloc(2 * maxLines * sizeof(int)); - memcpy((void *) newLengths, lineLengths, maxLines * sizeof(int)); - if (lineLengths != staticLineLengths) { - ckfree((char *) lineLengths); - } - lineLengths = newLengths; - maxLines *= 2; - } - lineLengths[curLine] = curX; - curLine++; + Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX)); curX = 0; baseline += height; @@ -1588,34 +2002,11 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX, 1000000000, baseline); chunkPtr->numDisplayChars = -1; + Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX)); baseline += height; } } - /* - * Using maximum line length, shift all the chunks so that the lines are - * all justified correctly. - */ - - curLine = 0; - chunkPtr = layoutPtr->chunks; - y = chunkPtr->y; - for (n = 0; n < layoutPtr->numChunks; n++) { - int extra; - - if (chunkPtr->y != y) { - curLine++; - y = chunkPtr->y; - } - extra = maxWidth - lineLengths[curLine]; - if (justify == TK_JUSTIFY_CENTER) { - chunkPtr->x += extra / 2; - } else if (justify == TK_JUSTIFY_RIGHT) { - chunkPtr->x += extra; - } - chunkPtr++; - } - layoutPtr->width = maxWidth; layoutHeight = baseline - fmPtr->ascent; if (layoutPtr->numChunks == 0) { @@ -1629,12 +2020,38 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, layoutPtr->numChunks = 1; layoutPtr->chunks[0].start = string; + layoutPtr->chunks[0].numBytes = 0; layoutPtr->chunks[0].numChars = 0; layoutPtr->chunks[0].numDisplayChars = -1; layoutPtr->chunks[0].x = 0; layoutPtr->chunks[0].y = fmPtr->ascent; layoutPtr->chunks[0].totalWidth = 0; layoutPtr->chunks[0].displayWidth = 0; + } else { + /* + * Using maximum line length, shift all the chunks so that the lines + * are all justified correctly. + */ + + curLine = 0; + chunkPtr = layoutPtr->chunks; + y = chunkPtr->y; + lineLengths = (int *) Tcl_DStringValue(&lineBuffer); + for (n = 0; n < layoutPtr->numChunks; n++) { + int extra; + + if (chunkPtr->y != y) { + curLine++; + y = chunkPtr->y; + } + extra = maxWidth - lineLengths[curLine]; + if (justify == TK_JUSTIFY_CENTER) { + chunkPtr->x += extra / 2; + } else if (justify == TK_JUSTIFY_RIGHT) { + chunkPtr->x += extra; + } + chunkPtr++; + } } if (widthPtr != NULL) { @@ -1643,9 +2060,7 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags, if (heightPtr != NULL) { *heightPtr = layoutHeight; } - if (lineLengths != staticLineLengths) { - ckfree((char *) lineLengths); - } + Tcl_DStringFree(&lineBuffer); return (Tk_TextLayout) layoutPtr; } @@ -1718,6 +2133,8 @@ Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar) { TextLayout *layoutPtr; int i, numDisplayChars, drawX; + CONST char *firstByte; + CONST char *lastByte; LayoutChunk *chunkPtr; layoutPtr = (TextLayout *) layout; @@ -1735,15 +2152,18 @@ Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar) if (firstChar <= 0) { drawX = 0; firstChar = 0; + firstByte = chunkPtr->start; } else { - Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start, firstChar, - 0, 0, &drawX); + 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); Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont, - chunkPtr->start + firstChar, numDisplayChars - firstChar, + firstByte, lastByte - firstByte, x + chunkPtr->x + drawX, y + chunkPtr->y); } firstChar -= chunkPtr->numChars; @@ -1849,7 +2269,7 @@ Tk_PointToChar(layout, x, y) TextLayout *layoutPtr; LayoutChunk *chunkPtr, *lastPtr; TkFont *fontPtr; - int i, n, dummy, baseline, pos; + int i, n, dummy, baseline, pos, numChars; if (y < 0) { /* @@ -1867,6 +2287,7 @@ Tk_PointToChar(layout, x, y) layoutPtr = (TextLayout *) layout; fontPtr = (TkFont *) layoutPtr->tkfont; lastPtr = chunkPtr = layoutPtr->chunks; + numChars = 0; for (i = 0; i < layoutPtr->numChunks; i++) { baseline = chunkPtr->y; if (y < baseline + fontPtr->fm.descent) { @@ -1876,7 +2297,7 @@ Tk_PointToChar(layout, x, y) * the index of the first character on this line. */ - return chunkPtr->start - layoutPtr->string; + return numChars; } if (x >= layoutPtr->width) { /* @@ -1907,13 +2328,14 @@ Tk_PointToChar(layout, x, y) * tab or newline char. */ - return chunkPtr->start - layoutPtr->string; + return numChars; } n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start, - chunkPtr->numChars, x + 1 - chunkPtr->x, - TK_PARTIAL_OK, &dummy); - return (chunkPtr->start + n - 1) - layoutPtr->string; + chunkPtr->numBytes, x - chunkPtr->x, + 0, &dummy); + return numChars + Tcl_NumUtfChars(chunkPtr->start, n); } + numChars += chunkPtr->numChars; lastPtr = chunkPtr; chunkPtr++; i++; @@ -1925,12 +2347,13 @@ Tk_PointToChar(layout, x, y) * chunk on this line. */ - pos = (lastPtr->start + lastPtr->numChars) - layoutPtr->string; + pos = numChars; if (i < layoutPtr->numChunks) { pos--; } return pos; } + numChars += chunkPtr->numChars; lastPtr = chunkPtr; chunkPtr++; } @@ -1997,6 +2420,7 @@ Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr) int i, x, w; Tk_Font tkfont; TkFont *fontPtr; + CONST char *end; if (index < 0) { return 0; @@ -2015,12 +2439,15 @@ Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr) goto check; } } else if (index < chunkPtr->numChars) { + end = Tcl_UtfAtIndex(chunkPtr->start, index); if (xPtr != NULL) { - Tk_MeasureChars(tkfont, chunkPtr->start, index, 0, 0, &x); + Tk_MeasureChars(tkfont, chunkPtr->start, + end - chunkPtr->start, -1, 0, &x); x += chunkPtr->x; } if (widthPtr != NULL) { - Tk_MeasureChars(tkfont, chunkPtr->start + index, 1, 0, 0, &w); + Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end, + -1, 0, &w); } goto check; } @@ -2276,7 +2703,7 @@ Tk_IntersectTextLayout(layout, x, y, width, height) * location of the baseline for the string. * * Results: - * Interp->result is modified to hold the Postscript code that + * The interp's result is modified to hold the Postscript code that * will render the text layout. * * Side effects: @@ -2294,6 +2721,8 @@ Tk_TextLayoutToPostscript(interp, layout) char buf[MAXUSE+10]; LayoutChunk *chunkPtr; int i, j, used, c, baseline; + Tcl_UniChar ch; + CONST char *p; TextLayout *layoutPtr; layoutPtr = (TextLayout *) layout; @@ -2314,8 +2743,16 @@ Tk_TextLayoutToPostscript(interp, layout) buf[used++] = 't'; } } else { + p = chunkPtr->start; for (j = 0; j < chunkPtr->numDisplayChars; j++) { - c = UCHAR(chunkPtr->start[j]); + /* + * 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. + */ + + p += Tcl_UtfToUniChar(p, &ch); + c = UCHAR(ch & 0xff); if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20) || (c >= UCHAR(0x7f))) { /* @@ -2359,36 +2796,6 @@ Tk_TextLayoutToPostscript(interp, layout) /* *--------------------------------------------------------------------------- * - * TkInitFontAttributes -- - * - * Initialize the font attributes structure to contain sensible - * values. This must be called before using any other font - * attributes functions. - * - * Results: - * None. - * - * Side effects. - * None. - * - *--------------------------------------------------------------------------- - */ - -void -TkInitFontAttributes(faPtr) - TkFontAttributes *faPtr; /* The attributes structure to initialize. */ -{ - faPtr->family = NULL; - faPtr->pointsize = 0; - faPtr->weight = TK_FW_NORMAL; - faPtr->slant = TK_FS_ROMAN; - faPtr->underline = 0; - faPtr->overstrike = 0; -} - -/* - *--------------------------------------------------------------------------- - * * ConfigAttributesObj -- * * Process command line options to fill in fields of a properly @@ -2419,68 +2826,74 @@ ConfigAttributesObj(interp, tkwin, objc, objv, faPtr) * be properly initialized. */ { int i, n, index; - Tcl_Obj *value; - char *option, *string; + Tcl_Obj *optionPtr, *valuePtr; + char *value; - if (objc & 1) { - string = Tcl_GetStringFromObj(objv[objc - 1], NULL); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "missing value for \"", - string, "\" option", (char *) NULL); - return TCL_ERROR; - } - for (i = 0; i < objc; i += 2) { - option = Tcl_GetStringFromObj(objv[i], NULL); - value = objv[i + 1]; + optionPtr = objv[i]; + valuePtr = objv[i + 1]; - if (Tcl_GetIndexFromObj(interp, objv[i], fontOpt, "option", 1, + if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1, &index) != TCL_OK) { return TCL_ERROR; } + if (objc & 1) { + /* + * This test occurs after Tcl_GetIndexFromObj() so that + * "font create xyz -xyz" will return the error message + * that "-xyz" is a bad option, rather than that the value + * for "-xyz" is missing. + */ + + Tcl_AppendResult(interp, "value for \"", + Tcl_GetString(optionPtr), "\" option missing", + (char *) NULL); + return TCL_ERROR; + } + switch (index) { - case FONT_FAMILY: - string = Tcl_GetStringFromObj(value, NULL); - faPtr->family = Tk_GetUid(string); + case FONT_FAMILY: { + value = Tcl_GetString(valuePtr); + faPtr->family = Tk_GetUid(value); break; - - case FONT_SIZE: - if (Tcl_GetIntFromObj(interp, value, &n) != TCL_OK) { + } + case FONT_SIZE: { + if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) { return TCL_ERROR; } - faPtr->pointsize = n; + faPtr->size = n; break; - - case FONT_WEIGHT: - string = Tcl_GetStringFromObj(value, NULL); - n = TkFindStateNum(interp, option, weightMap, string); + } + case FONT_WEIGHT: { + n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr); if (n == TK_FW_UNKNOWN) { return TCL_ERROR; } faPtr->weight = n; break; - - case FONT_SLANT: - string = Tcl_GetStringFromObj(value, NULL); - n = TkFindStateNum(interp, option, slantMap, string); + } + case FONT_SLANT: { + n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr); if (n == TK_FS_UNKNOWN) { return TCL_ERROR; } faPtr->slant = n; break; - - case FONT_UNDERLINE: - if (Tcl_GetBooleanFromObj(interp, value, &n) != TCL_OK) { + } + case FONT_UNDERLINE: { + if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) { return TCL_ERROR; } faPtr->underline = n; break; - - case FONT_OVERSTRIKE: - if (Tcl_GetBooleanFromObj(interp, value, &n) != TCL_OK) { + } + case FONT_OVERSTRIKE: { + if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) { return TCL_ERROR; } faPtr->overstrike = n; break; + } } } return TCL_OK; @@ -2515,18 +2928,19 @@ GetAttributeInfoObj(interp, faPtr, objPtr) CONST TkFontAttributes *faPtr; /* The font attributes to inspect. */ Tcl_Obj *objPtr; /* If non-NULL, indicates the single * option whose value is to be - * returned. Otherwise - * information is returned for - * all options. */ + * returned. Otherwise information is + * returned for all options. */ { - int i, index, start, end, num; + int i, index, start, end; char *str; - Tcl_Obj *newPtr; + Tcl_Obj *optionPtr, *valuePtr, *resultPtr; + + resultPtr = Tcl_GetObjResult(interp); start = 0; end = FONT_NUMFIELDS; if (objPtr != NULL) { - if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", 1, + if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } @@ -2534,55 +2948,43 @@ GetAttributeInfoObj(interp, faPtr, objPtr) end = index + 1; } + valuePtr = NULL; for (i = start; i < end; i++) { - str = NULL; - num = 0; /* Needed only to prevent compiler - * warning. */ switch (i) { case FONT_FAMILY: str = faPtr->family; - if (str == NULL) { - str = ""; - } + valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1)); break; case FONT_SIZE: - num = faPtr->pointsize; + valuePtr = Tcl_NewIntObj(faPtr->size); break; case FONT_WEIGHT: str = TkFindStateString(weightMap, faPtr->weight); + valuePtr = Tcl_NewStringObj(str, -1); break; case FONT_SLANT: str = TkFindStateString(slantMap, faPtr->slant); + valuePtr = Tcl_NewStringObj(str, -1); break; case FONT_UNDERLINE: - num = faPtr->underline; + valuePtr = Tcl_NewBooleanObj(faPtr->underline); break; case FONT_OVERSTRIKE: - num = faPtr->overstrike; + valuePtr = Tcl_NewBooleanObj(faPtr->overstrike); break; } - if (objPtr == NULL) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - Tcl_NewStringObj(fontOpt[i], -1)); - if (str != NULL) { - newPtr = Tcl_NewStringObj(str, -1); - } else { - newPtr = Tcl_NewIntObj(num); - } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - newPtr); - } else { - if (str != NULL) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), str, -1); - } else { - Tcl_SetIntObj(Tcl_GetObjResult(interp), num); - } + if (objPtr != NULL) { + Tcl_SetObjResult(interp, valuePtr); + return TCL_OK; } + optionPtr = Tcl_NewStringObj(fontOpt[i], -1); + Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr); + Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr); } return TCL_OK; } @@ -2597,7 +2999,7 @@ GetAttributeInfoObj(interp, faPtr, objPtr) * * The string rep of the object can be one of the following forms: * XLFD (see X documentation) - * "Family [size [style] [style ...]]" + * "family [size] [style1 [style2 ...]" * "-option value [-option value ...]" * * Results: @@ -2614,20 +3016,25 @@ GetAttributeInfoObj(interp, faPtr, objPtr) static int ParseFontNameObj(interp, tkwin, objPtr, faPtr) - Tcl_Interp *interp; /* Interp for error return. */ + Tcl_Interp *interp; /* Interp for error return. Must not be + * NULL. */ Tk_Window tkwin; /* For display on which font is used. */ Tcl_Obj *objPtr; /* Parseable font description object. */ - TkFontAttributes *faPtr; /* Font attributes structure whose fields - * are to be modified. Structure must already - * be properly initialized. */ + TkFontAttributes *faPtr; /* Filled with attributes parsed from font + * name. Any attributes that were not + * specified in font name are filled with + * default values. */ { char *dash; int objc, result, i, n; Tcl_Obj **objv; - TkXLFDAttributes xa; + Tcl_Obj *resultPtr; char *string; - string = Tcl_GetStringFromObj(objPtr, NULL); + TkInitFontAttributes(faPtr); + resultPtr = Tcl_GetObjResult(interp); + + string = Tcl_GetString(objPtr); if (*string == '-') { /* * This may be an XLFD or an "-option value" string. @@ -2640,7 +3047,8 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr) goto xlfd; } dash = strchr(string + 1, '-'); - if ((dash != NULL) && (!isspace(UCHAR(dash[-1])))) { + if ((dash != NULL) + && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */ goto xlfd; } @@ -2653,15 +3061,16 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr) if (*string == '*') { /* - * This appears to be an XLFD. + * This is appears to be an XLFD. Under Unix, all valid XLFDs were + * already handled by TkpGetNativeFont. If we are here, either we + * have something that initially looks like an XLFD but isn't or we + * have encountered an XLFD on Windows or Mac. */ xlfd: - xa.fa = *faPtr; - result = TkParseXLFD(string, &xa); + result = TkFontParseXLFD(string, faPtr, NULL); if (result == TCL_OK) { - *faPtr = xa.fa; - return result; + return TCL_OK; } } @@ -2670,21 +3079,19 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr) * "font size style" list. */ - if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { - return TCL_ERROR; - } - if (objc < 1) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "font \"", string, - "\" doesn't exist", (char *) NULL); + if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK) + || (objc < 1)) { + Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist", + (char *) NULL); return TCL_ERROR; } - faPtr->family = Tk_GetUid(Tcl_GetStringFromObj(objv[0], NULL)); + faPtr->family = Tk_GetUid(Tcl_GetString(objv[0])); if (objc > 1) { if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) { return TCL_ERROR; } - faPtr->pointsize = n; + faPtr->size = n; } i = 2; @@ -2695,23 +3102,22 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr) i = 0; } for ( ; i < objc; i++) { - string = Tcl_GetStringFromObj(objv[i], NULL); - n = TkFindStateNum(NULL, NULL, weightMap, string); + n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]); if (n != TK_FW_UNKNOWN) { faPtr->weight = n; continue; } - n = TkFindStateNum(NULL, NULL, slantMap, string); + n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]); if (n != TK_FS_UNKNOWN) { faPtr->slant = n; continue; } - n = TkFindStateNum(NULL, NULL, underlineMap, string); + n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]); if (n != 0) { faPtr->underline = n; continue; } - n = TkFindStateNum(NULL, NULL, overstrikeMap, string); + n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]); if (n != 0) { faPtr->overstrike = n; continue; @@ -2721,9 +3127,8 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr) * Unknown style. */ - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "unknown font style \"", string, "\"", - (char *) NULL); + Tcl_AppendResult(interp, "unknown font style \"", + Tcl_GetString(objv[i]), "\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; @@ -2732,7 +3137,69 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr) /* *--------------------------------------------------------------------------- * - * TkParseXLFD -- + * NewChunk -- + * + * Helper function for Tk_ComputeTextLayout(). Encapsulates a + * measured set of characters in a chunk that can be quickly + * drawn. + * + * Results: + * A pointer to the new chunk in the text layout. + * + * Side effects: + * The text layout is reallocated to hold more chunks as necessary. + * + * Currently, Tk_ComputeTextLayout() stores contiguous ranges of + * "normal" characters in a chunk, along with individual tab + * and newline chars in their own chunks. All characters in the + * text layout are accounted for. + * + *--------------------------------------------------------------------------- + */ +static LayoutChunk * +NewChunk(layoutPtrPtr, maxPtr, start, numBytes, curX, newX, y) + TextLayout **layoutPtrPtr; + int *maxPtr; + CONST char *start; + int numBytes; + int curX; + int newX; + int y; +{ + TextLayout *layoutPtr; + LayoutChunk *chunkPtr; + int maxChunks, numChars; + size_t s; + + layoutPtr = *layoutPtrPtr; + maxChunks = *maxPtr; + if (layoutPtr->numChunks == maxChunks) { + maxChunks *= 2; + s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk)); + layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s); + + *layoutPtrPtr = layoutPtr; + *maxPtr = maxChunks; + } + numChars = Tcl_NumUtfChars(start, numBytes); + chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks]; + chunkPtr->start = start; + chunkPtr->numBytes = numBytes; + chunkPtr->numChars = numChars; + chunkPtr->numDisplayChars = numChars; + chunkPtr->x = curX; + chunkPtr->y = y; + chunkPtr->totalWidth = newX - curX; + chunkPtr->displayWidth = newX - curX; + layoutPtr->numChunks++; + + return chunkPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * TkFontParseXLFD -- * * Break up a fully specified XLFD into a set of font attributes. * @@ -2748,18 +3215,31 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr) */ int -TkParseXLFD(string, xaPtr) +TkFontParseXLFD(string, faPtr, xaPtr) CONST char *string; /* Parseable font description string. */ - TkXLFDAttributes *xaPtr; /* XLFD attributes structure whose fields - * are to be modified. Structure must already - * be properly initialized. */ + TkFontAttributes *faPtr; /* Filled with attributes parsed from font + * name. Any attributes that were not + * specified in font name are filled with + * default values. */ + TkXLFDAttributes *xaPtr; /* Filled with X-specific attributes parsed + * from font name. Any attributes that were + * not specified in font name are filled with + * default values. May be NULL if such + * information is not desired. */ { char *src; CONST char *str; int i, j; char *field[XLFD_NUMFIELDS + 2]; Tcl_DString ds; + TkXLFDAttributes xa; + if (xaPtr == NULL) { + xaPtr = &xa; + } + TkInitFontAttributes(faPtr); + TkInitXLFDAttributes(xaPtr); + memset(field, '\0', sizeof(field)); str = string; @@ -2773,27 +3253,32 @@ TkParseXLFD(string, xaPtr) field[0] = src; for (i = 0; *src != '\0'; src++) { - if (isupper(UCHAR(*src))) { - *src = tolower(UCHAR(*src)); + if (!(*src & 0x90) + && isupper(UCHAR(*src))) { /* INTL: 7-bit ISO only. */ + *src = tolower(UCHAR(*src)); /* INTL: 7-bit ISO only. */ } if (*src == '-') { i++; - if (i > XLFD_NUMFIELDS) { - break; + if (i == XLFD_NUMFIELDS) { + continue; } *src = '\0'; field[i] = src + 1; + if (i > XLFD_NUMFIELDS) { + break; + } } } /* - * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common, + * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common, * but it is (strictly) malformed, because the first * is eliding both * the Setwidth and the Addstyle fields. If the Addstyle field is a * number, then assume the above incorrect form was used and shift all - * the rest of the fields up by one, so the number gets interpreted + * the rest of the fields right by one, so the number gets interpreted * as a pixelsize. This fix is so that we don't get a million reports - * that "it works under X, but gives a syntax error under Windows". + * that "it works under X (as a native font name), but gives a syntax + * error under Windows (as a parsed set of attributes)". */ if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) { @@ -2820,19 +3305,19 @@ TkParseXLFD(string, xaPtr) } if (FieldSpecified(field[XLFD_FAMILY])) { - xaPtr->fa.family = Tk_GetUid(field[XLFD_FAMILY]); + faPtr->family = Tk_GetUid(field[XLFD_FAMILY]); } if (FieldSpecified(field[XLFD_WEIGHT])) { - xaPtr->fa.weight = TkFindStateNum(NULL, NULL, xlfdWeightMap, + faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap, field[XLFD_WEIGHT]); } if (FieldSpecified(field[XLFD_SLANT])) { xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap, field[XLFD_SLANT]); if (xaPtr->slant == TK_FS_ROMAN) { - xaPtr->fa.slant = TK_FS_ROMAN; + faPtr->slant = TK_FS_ROMAN; } else { - xaPtr->fa.slant = TK_FS_ITALIC; + faPtr->slant = TK_FS_ITALIC; } } if (FieldSpecified(field[XLFD_SETWIDTH])) { @@ -2843,9 +3328,12 @@ TkParseXLFD(string, xaPtr) /* XLFD_ADD_STYLE ignored. */ /* - * Pointsize in tenths of a point, but treat it as tenths of a pixel. + * Pointsize in tenths of a point, but treat it as tenths of a pixel + * for historical compatibility. */ + faPtr->size = 12; + if (FieldSpecified(field[XLFD_POINT_SIZE])) { if (field[XLFD_POINT_SIZE][0] == '[') { /* @@ -2858,10 +3346,10 @@ TkParseXLFD(string, xaPtr) * the purpose of, so I ignore them. */ - xaPtr->fa.pointsize = atoi(field[XLFD_POINT_SIZE] + 1); + faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1); } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE], - &xaPtr->fa.pointsize) == TCL_OK) { - xaPtr->fa.pointsize /= 10; + &faPtr->size) == TCL_OK) { + faPtr->size /= 10; } else { return TCL_ERROR; } @@ -2883,14 +3371,14 @@ TkParseXLFD(string, xaPtr) * the purpose of, so I ignore them. */ - xaPtr->fa.pointsize = atoi(field[XLFD_PIXEL_SIZE] + 1); + faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1); } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE], - &xaPtr->fa.pointsize) != TCL_OK) { + &faPtr->size) != TCL_OK) { return TCL_ERROR; } } - xaPtr->fa.pointsize = -xaPtr->fa.pointsize; + faPtr->size = -faPtr->size; /* XLFD_RESOLUTION_X ignored. */ @@ -2900,14 +3388,11 @@ TkParseXLFD(string, xaPtr) /* XLFD_AVERAGE_WIDTH ignored. */ - if (FieldSpecified(field[XLFD_REGISTRY])) { - xaPtr->charset = TkFindStateNum(NULL, NULL, xlfdCharsetMap, - field[XLFD_REGISTRY]); - } - if (FieldSpecified(field[XLFD_ENCODING])) { - xaPtr->encoding = atoi(field[XLFD_ENCODING]); + if (FieldSpecified(field[XLFD_CHARSET])) { + xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]); + } else { + xaPtr->charset = Tk_GetUid("iso8859-1"); } - Tcl_DStringFree(&ds); return TCL_OK; } @@ -2949,60 +3434,223 @@ FieldSpecified(field) /* *--------------------------------------------------------------------------- * - * NewChunk -- + * TkFontGetPixels -- * - * Helper function for Tk_ComputeTextLayout(). Encapsulates a - * measured set of characters in a chunk that can be quickly - * drawn. + * Given a font size specification (as described in the TkFontAttributes + * structure) return the number of pixels it represents. * * Results: - * A pointer to the new chunk in the text layout. + * As above. * * Side effects: - * The text layout is reallocated to hold more chunks as necessary. + * None. * - * Currently, Tk_ComputeTextLayout() stores contiguous ranges of - * "normal" characters in a chunk, along with individual tab - * and newline chars in their own chunks. All characters in the - * text layout are accounted for. + *--------------------------------------------------------------------------- + */ + +int +TkFontGetPixels(tkwin, size) + Tk_Window tkwin; /* For point->pixel conversion factor. */ + int size; /* Font size. */ +{ + double d; + + if (size < 0) { + return -size; + } + + d = size * 25.4 / 72.0; + d *= WidthOfScreen(Tk_Screen(tkwin)); + d /= WidthMMOfScreen(Tk_Screen(tkwin)); + return (int) (d + 0.5); +} + +/* + *--------------------------------------------------------------------------- + * + * TkFontGetPoints -- + * + * Given a font size specification (as described in the TkFontAttributes + * structure) return the number of points it represents. + * + * Results: + * As above. + * + * Side effects: + * None. * *--------------------------------------------------------------------------- */ -static LayoutChunk * -NewChunk(layoutPtrPtr, maxPtr, start, numChars, curX, newX, y) - TextLayout **layoutPtrPtr; - int *maxPtr; - CONST char *start; - int numChars; - int curX; - int newX; - int y; + +int +TkFontGetPoints(tkwin, size) + Tk_Window tkwin; /* For pixel->point conversion factor. */ + int size; /* Font size. */ { - TextLayout *layoutPtr; - LayoutChunk *chunkPtr; - int maxChunks; - size_t s; - - layoutPtr = *layoutPtrPtr; - maxChunks = *maxPtr; - if (layoutPtr->numChunks == maxChunks) { - maxChunks *= 2; - s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk)); - layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s); + double d; - *layoutPtrPtr = layoutPtr; - *maxPtr = maxChunks; + if (size >= 0) { + return size; } - chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks]; - chunkPtr->start = start; - chunkPtr->numChars = numChars; - chunkPtr->numDisplayChars = numChars; - chunkPtr->x = curX; - chunkPtr->y = y; - chunkPtr->totalWidth = newX - curX; - chunkPtr->displayWidth = newX - curX; - layoutPtr->numChunks++; - return chunkPtr; + d = -size * 72.0 / 25.4; + d *= WidthMMOfScreen(Tk_Screen(tkwin)); + d /= WidthOfScreen(Tk_Screen(tkwin)); + return (int) (d + 0.5); } + +/* + *------------------------------------------------------------------------- + * + * TkFontGetAliasList -- + * + * Given a font name, find the list of all aliases for that font + * name. One of the names in this list will probably be the name + * that this platform expects when asking for the font. + * + * Results: + * As above. The return value is NULL if the font name has no + * aliases. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +char ** +TkFontGetAliasList(faceName) + CONST char *faceName; /* Font name to test for aliases. */ +{ + int i, j; + for (i = 0; fontAliases[i] != NULL; i++) { + for (j = 0; fontAliases[i][j] != NULL; j++) { + if (strcasecmp(faceName, fontAliases[i][j]) == 0) { + return fontAliases[i]; + } + } + } + return NULL; +} + +/* + *------------------------------------------------------------------------- + * + * TkFontGetFallbacks -- + * + * Get the list of font fallbacks that the platform-specific code + * can use to try to find the closest matching font the name + * requested. + * + * Results: + * As above. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +char *** +TkFontGetFallbacks() +{ + return fontFallbacks; +} + +/* + *------------------------------------------------------------------------- + * + * TkFontGetGlobalClass -- + * + * Get the list of fonts to try if the requested font name does not + * exist and no fallbacks for that font name could be used either. + * The names in this list are considered preferred over all the other + * font names in the system when looking for a last-ditch fallback. + * + * Results: + * As above. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +char ** +TkFontGetGlobalClass() +{ + return globalFontClass; +} + +/* + *------------------------------------------------------------------------- + * + * TkFontGetSymbolClass -- + * + * Get the list of fonts that are symbolic; used if the operating + * system cannot apriori identify symbolic fonts on its own. + * + * Results: + * As above. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +char ** +TkFontGetSymbolClass() +{ + return symbolClass; +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugFont -- + * + * This procedure returns debugging information about a font. + * + * Results: + * The return value is a list with one sublist for each TkFont + * corresponding to "name". Each sublist has two elements that + * contain the resourceRefCount and objRefCount fields from the + * TkFont structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkDebugFont(tkwin, name) + Tk_Window tkwin; /* The window in which the font will be + * used (not currently used). */ + char *name; /* Name of the desired color. */ +{ + TkFont *fontPtr; + Tcl_HashEntry *hashPtr; + Tcl_Obj *resultPtr, *objPtr; + + resultPtr = Tcl_NewObj(); + hashPtr = Tcl_FindHashEntry( + &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name); + if (hashPtr != NULL) { + fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); + if (fontPtr == NULL) { + panic("TkDebugFont found empty hash table entry"); + } + for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) { + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(fontPtr->resourceRefCount)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(fontPtr->objRefCount)); + Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); + } + } + return resultPtr; +} diff --git a/generic/tkFont.h b/generic/tkFont.h index e2a7e04..cc57167 100644 --- a/generic/tkFont.h +++ b/generic/tkFont.h @@ -5,12 +5,12 @@ * specific parts of the font package. This information is not * visible outside of the font package. * - * Copyright (c) 1996 Sun Microsystems, Inc. + * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFont.h,v 1.4 1998/09/14 18:23:10 stanton Exp $ + * RCS: @(#) $Id: tkFont.h,v 1.5 1999/04/16 01:51:14 stanton Exp $ */ #ifndef _TKFONT @@ -28,8 +28,9 @@ */ typedef struct TkFontAttributes { - Tk_Uid family; /* Font family. The most important field. */ - int pointsize; /* Pointsize of font, 0 for default size, or + Tk_Uid family; /* Font family, or NULL to represent + * plaform-specific default system font. */ + int size; /* Pointsize of font, 0 for default size, or * negative number meaning pixel size. */ int weight; /* Weight flag; see below for def'n. */ int slant; /* Slant flag; see below for def'n. */ @@ -91,13 +92,25 @@ typedef struct TkFont { * Fields used and maintained exclusively by generic code. */ - int refCount; /* Number of users of the TkFont. */ + int resourceRefCount; /* Number of active uses of this font (each + * active use corresponds to a call to + * Tk_AllocFontFromTable or Tk_GetFont). + * If this count is 0, then this TkFont + * structure is no longer valid and it isn't + * present in a hash table: it is being + * kept around only because there are objects + * referring to it. The structure is freed + * when resourceRefCount and objRefCount + * are both 0. */ + int objRefCount; /* The number of Tcl objects that reference + * this structure. */ Tcl_HashEntry *cacheHashPtr;/* Entry in font cache for this structure, * used when deleting it. */ Tcl_HashEntry *namedHashPtr;/* Pointer to hash table entry that * corresponds to the named font that the * tkfont was based on, or NULL if the tkfont * was not based on a named font. */ + Screen *screen; /* The screen where this font is valid. */ int tabWidth; /* Width of tabs in this font (pixels). */ int underlinePos; /* Offset from baseline to origin of * underline bar (used for drawing underlines @@ -106,7 +119,7 @@ typedef struct TkFont { * underlines on a non-underlined font). */ /* - * Fields in the generic font structure that are filled in by + * Fields used in the generic code that are filled in by * platform-specific code. */ @@ -121,6 +134,11 @@ typedef struct TkFont { * that was used to create this font. */ TkFontMetrics fm; /* Font metrics determined when font was * created. */ + struct TkFont *nextPtr; /* Points to the next TkFont structure with + * the same name. All fonts with the + * same name (but different displays) are + * chained together off a single entry in + * a hash table. */ } TkFont; /* @@ -130,16 +148,12 @@ typedef struct TkFont { */ typedef struct TkXLFDAttributes { - TkFontAttributes fa; /* Standard set of font attributes. */ Tk_Uid foundry; /* The foundry of the font. */ int slant; /* The tristate value for the slant, which * is significant under X. */ int setwidth; /* The proportionate width, see below for * definition. */ - int charset; /* The character set encoding (the glyph - * family), see below for definition. */ - int encoding; /* Variations within a charset for the - * glyphs above character 127. */ + Tk_Uid charset; /* The actual charset string. */ } TkXLFDAttributes; /* @@ -155,15 +169,6 @@ typedef struct TkXLFDAttributes { * stored in the setwidth field. */ /* - * Possible values for the "charset" field in a TkXLFDAttributes structure. - * The charset is the set of glyphs that are used in the font. - */ - -#define TK_CS_NORMAL 0 -#define TK_CS_SYMBOL 1 -#define TK_CS_OTHER 2 - -/* * The following defines specify the meaning of the fields in a fully * qualified XLFD. */ @@ -180,28 +185,33 @@ typedef struct TkXLFDAttributes { #define XLFD_RESOLUTION_Y 9 #define XLFD_SPACING 10 #define XLFD_AVERAGE_WIDTH 11 -#define XLFD_REGISTRY 12 -#define XLFD_ENCODING 13 -#define XLFD_NUMFIELDS 14 /* Number of fields in XLFD. */ +#define XLFD_CHARSET 12 +#define XLFD_NUMFIELDS 13 /* Number of fields in XLFD. */ /* - * Exported from generic code to platform-specific code. + * Low-level API exported by generic code to platform-specific code. */ -EXTERN int TkCreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window tkwin, CONST char *name, - TkFontAttributes *faPtr)); -EXTERN void TkInitFontAttributes _ANSI_ARGS_(( - TkFontAttributes *faPtr)); -EXTERN int TkParseXLFD _ANSI_ARGS_((CONST char *string, - TkXLFDAttributes *xaPtr)); +#define TkInitFontAttributes(fa) memset((fa), 0, sizeof(TkFontAttributes)); +#define TkInitXLFDAttributes(xa) memset((xa), 0, sizeof(TkXLFDAttributes)); + +EXTERN int TkFontParseXLFD _ANSI_ARGS_((CONST char *string, + TkFontAttributes *faPtr, TkXLFDAttributes *xaPtr)); +EXTERN char ** TkFontGetAliasList _ANSI_ARGS_((CONST char *faceName)); +EXTERN char *** TkFontGetFallbacks _ANSI_ARGS_((void)); +EXTERN int TkFontGetPixels _ANSI_ARGS_((Tk_Window tkwin, + int size)); +EXTERN int TkFontGetPoints _ANSI_ARGS_((Tk_Window tkwin, + int size)); +EXTERN char ** TkFontGetGlobalClass _ANSI_ARGS_((void)); +EXTERN char ** TkFontGetSymbolClass _ANSI_ARGS_((void)); /* - * Common APIs exported to tkFont.c from all platform-specific - * implementations. + * Low-level API exported by platform-specific code to generic code. */ EXTERN void TkpDeleteFont _ANSI_ARGS_((TkFont *tkFontPtr)); +EXTERN void TkpFontPkgInit _ANSI_ARGS_((TkMainInfo *mainPtr)); EXTERN TkFont * TkpGetFontFromAttributes _ANSI_ARGS_(( TkFont *tkFontPtr, Tk_Window tkwin, CONST TkFontAttributes *faPtr)); diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 18ce64f..9bdee9a 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -7,12 +7,12 @@ * attributes. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFrame.c,v 1.2 1998/09/14 18:23:10 stanton Exp $ + * RCS: @(#) $Id: tkFrame.c,v 1.3 1999/04/16 01:51:14 stanton Exp $ */ #include "default.h" @@ -441,7 +441,7 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName) if (toplevel) { Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr); } - interp->result = Tk_PathName(new); + Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC); return TCL_OK; error: @@ -597,7 +597,7 @@ DestroyFrame(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as text string, colors, font, diff --git a/generic/tkGC.c b/generic/tkGC.c index dd53e32..b719137 100644 --- a/generic/tkGC.c +++ b/generic/tkGC.c @@ -10,11 +10,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkGC.c,v 1.2 1998/09/14 18:23:11 stanton Exp $ + * RCS: @(#) $Id: tkGC.c,v 1.3 1999/04/16 01:51:14 stanton Exp $ */ #include "tkPort.h" -#include "tk.h" +#include "tkInt.h" /* * One of the following data structures exists for each GC that is @@ -31,12 +31,6 @@ typedef struct { * this structure). */ } TkGC; -/* - * Hash table to map from a GC's values to a TkGC structure describing - * a GC with those values (used by Tk_GetGC). - */ - -static Tcl_HashTable valueTable; typedef struct { XGCValues values; /* Desired values for GC. */ Display *display; /* Display for which GC is valid. */ @@ -45,24 +39,10 @@ typedef struct { } ValueKey; /* - * Hash table for <display + GC> -> TkGC mapping. This table is used by - * Tk_FreeGC. - */ - -static Tcl_HashTable idTable; -typedef struct { - Display *display; /* Display for which GC was allocated. */ - GC gc; /* X's identifier for GC. */ -} IdKey; - -static int initialized = 0; /* 0 means static structures haven't been - * initialized yet. */ - -/* * Forward declarations for procedures defined in this file: */ -static void GCInit _ANSI_ARGS_((void)); +static void GCInit _ANSI_ARGS_((TkDisplay *dispPtr)); /* *---------------------------------------------------------------------- @@ -98,14 +78,14 @@ Tk_GetGC(tkwin, valueMask, valuePtr) * in valueMask. */ { ValueKey valueKey; - IdKey idKey; Tcl_HashEntry *valueHashPtr, *idHashPtr; register TkGC *gcPtr; int new; Drawable d, freeDrawable; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - GCInit(); + if (!dispPtr->gcInit) { + GCInit(dispPtr); } /* @@ -238,7 +218,8 @@ Tk_GetGC(tkwin, valueMask, valuePtr) valueKey.display = Tk_Display(tkwin); valueKey.screenNum = Tk_ScreenNumber(tkwin); valueKey.depth = Tk_Depth(tkwin); - valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new); + valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable, + (char *) &valueKey, &new); if (!new) { gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr); gcPtr->refCount++; @@ -275,9 +256,8 @@ Tk_GetGC(tkwin, valueMask, valuePtr) gcPtr->display = valueKey.display; gcPtr->refCount = 1; gcPtr->valueHashPtr = valueHashPtr; - idKey.display = valueKey.display; - idKey.gc = gcPtr->gc; - idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new); + idHashPtr = Tcl_CreateHashEntry(&dispPtr->gcIdTable, + (char *) gcPtr->gc, &new); if (!new) { panic("GC already registered in Tk_GetGC"); } @@ -313,17 +293,15 @@ Tk_FreeGC(display, gc) Display *display; /* Display for which gc was allocated. */ GC gc; /* Graphics context to be released. */ { - IdKey idKey; Tcl_HashEntry *idHashPtr; register TkGC *gcPtr; + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { + if (!dispPtr->gcInit) { panic("Tk_FreeGC called before Tk_GetGC"); } - idKey.display = display; - idKey.gc = gc; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->gcIdTable, (char *) gc); if (idHashPtr == NULL) { panic("Tk_FreeGC received unknown gc argument"); } @@ -355,9 +333,10 @@ Tk_FreeGC(display, gc) */ static void -GCInit() +GCInit(dispPtr) + TkDisplay *dispPtr; { - initialized = 1; - Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int)); - Tcl_InitHashTable(&idTable, sizeof(IdKey)/sizeof(int)); + dispPtr->gcInit = 1; + Tcl_InitHashTable(&dispPtr->gcValueTable, sizeof(ValueKey)/sizeof(int)); + Tcl_InitHashTable(&dispPtr->gcIdTable, TCL_ONE_WORD_KEYS); } diff --git a/generic/tkGeometry.c b/generic/tkGeometry.c index 64f0b26..1851965 100644 --- a/generic/tkGeometry.c +++ b/generic/tkGeometry.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkGeometry.c,v 1.2 1998/09/14 18:23:11 stanton Exp $ + * RCS: @(#) $Id: tkGeometry.c,v 1.3 1999/04/16 01:51:14 stanton Exp $ */ #include "tkPort.h" @@ -53,19 +53,6 @@ typedef struct MaintainMaster { } MaintainMaster; /* - * Hash table that maps from a master's Tk_Window token to a list of - * Maintains for that master: - */ - -static Tcl_HashTable maintainHashTable; - -/* - * Has maintainHashTable been initialized yet? - */ - -static int initialized = 0; - -/* * Prototypes for static procedures in this file: */ @@ -261,10 +248,11 @@ Tk_MaintainGeometry(slave, master, x, y, width, height) register MaintainSlave *slavePtr; int new, map; Tk_Window ancestor, parent; + TkDisplay *dispPtr = ((TkWindow *) master)->dispPtr; - if (!initialized) { - initialized = 1; - Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS); + if (!dispPtr->geomInit) { + dispPtr->geomInit = 1; + Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS); } /* @@ -273,7 +261,8 @@ Tk_MaintainGeometry(slave, master, x, y, width, height) */ parent = Tk_Parent(slave); - hPtr = Tcl_CreateHashEntry(&maintainHashTable, (char *) master, &new); + hPtr = Tcl_CreateHashEntry(&dispPtr->maintainHashTable, + (char *) master, &new); if (!new) { masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr); } else { @@ -383,16 +372,17 @@ Tk_UnmaintainGeometry(slave, master) MaintainMaster *masterPtr; register MaintainSlave *slavePtr, *prevPtr; Tk_Window ancestor; + TkDisplay *dispPtr = ((TkWindow *) slave)->dispPtr; - if (!initialized) { - initialized = 1; - Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS); + if (!dispPtr->geomInit) { + dispPtr->geomInit = 1; + Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS); } if (!(((TkWindow *) slave)->flags & TK_ALREADY_DEAD)) { Tk_UnmapWindow(slave); } - hPtr = Tcl_FindHashEntry(&maintainHashTable, (char *) master); + hPtr = Tcl_FindHashEntry(&dispPtr->maintainHashTable, (char *) master); if (hPtr == NULL) { return; } diff --git a/generic/tkGet.c b/generic/tkGet.c index 3507e9b..95833a1 100644 --- a/generic/tkGet.c +++ b/generic/tkGet.c @@ -8,24 +8,76 @@ * files. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkGet.c,v 1.2 1998/09/14 18:23:11 stanton Exp $ + * RCS: @(#) $Id: tkGet.c,v 1.3 1999/04/16 01:51:14 stanton Exp $ */ #include "tkInt.h" #include "tkPort.h" /* - * The hash table below is used to keep track of all the Tk_Uids created - * so far. + * One of these structures is created per thread to store + * thread-specific data. In this case, it is used to house the + * Tk_Uids used by each thread. The "dataKey" below is used to + * locate the ThreadSpecificData for the current thread. */ -static Tcl_HashTable uidTable; -static int initialized = 0; +typedef struct ThreadSpecificData { + int initialized; + Tcl_HashTable uidTable; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * The following tables defines the string values for reliefs, which are + * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj. + */ + +static char *anchorStrings[] = {"n", "ne", "e", "se", "s", "sw", "w", "nw", + "center", (char *) NULL}; +static char *justifyStrings[] = {"left", "right", "center", (char *) NULL}; + + +/* + *---------------------------------------------------------------------- + * + * Tk_GetAnchorFromObj -- + * + * Return a Tk_Anchor value based on the value of the objPtr. + * + * Results: + * The return value is a standard Tcl result. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * The object gets converted by Tcl_GetIndexFromObj. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetAnchorFromObj(interp, objPtr, anchorPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + Tcl_Obj *objPtr; /* The object we are trying to get the + * value from. */ + Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that + * corresponds to the string value of + * objPtr. */ +{ + int index, code; + + code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0, + &index); + if (code == TCL_OK) { + *anchorPtr = (Tk_Anchor) index; + } + return code; +} /* *-------------------------------------------------------------- @@ -39,7 +91,7 @@ static int initialized = 0; * TCL_OK is returned, then everything went well and the * position is stored at *anchorPtr; otherwise TCL_ERROR * is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. @@ -155,7 +207,7 @@ Tk_NameOfAnchor(anchor) * TCL_OK is returned, then everything went well and the * justification is stored at *joinPtr; otherwise * TCL_ERROR is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. @@ -237,7 +289,7 @@ Tk_NameOfJoinStyle(join) * TCL_OK is returned, then everything went well and the * justification is stored at *capPtr; otherwise * TCL_ERROR is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. @@ -308,6 +360,43 @@ Tk_NameOfCapStyle(cap) } /* + *---------------------------------------------------------------------- + * + * Tk_GetJustifyFromObj -- + * + * Return a Tk_Justify value based on the value of the objPtr. + * + * Results: + * The return value is a standard Tcl result. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * The object gets converted by Tcl_GetIndexFromObj. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetJustifyFromObj(interp, objPtr, justifyPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + Tcl_Obj *objPtr; /* The object we are trying to get the + * value from. */ + Tk_Justify *justifyPtr; /* Where to place the Tk_Justify that + * corresponds to the string value of + * objPtr. */ +{ + int index, code; + + code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings, + "justification", 0, &index); + if (code == TCL_OK) { + *justifyPtr = (Tk_Justify) index; + } + return code; +} + +/* *-------------------------------------------------------------- * * Tk_GetJustify -- @@ -319,7 +408,7 @@ Tk_NameOfCapStyle(cap) * TCL_OK is returned, then everything went well and the * justification is stored at *justifyPtr; otherwise * TCL_ERROR is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. @@ -417,13 +506,16 @@ Tk_GetUid(string) CONST char *string; /* String to convert. */ { int dummy; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashTable *tablePtr = &tsdPtr->uidTable; - if (!initialized) { - Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS); - initialized = 1; + if (!tsdPtr->initialized) { + Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS); + tsdPtr->initialized = 1; } - return (Tk_Uid) Tcl_GetHashKey(&uidTable, - Tcl_CreateHashEntry(&uidTable, string, &dummy)); + return (Tk_Uid) Tcl_GetHashKey(tablePtr, + Tcl_CreateHashEntry(tablePtr, string, &dummy)); } /* @@ -439,7 +531,7 @@ Tk_GetUid(string) * TCL_OK is returned, then everything went well and the * screen distance is stored at *doublePtr; otherwise * TCL_ERROR is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. @@ -515,7 +607,7 @@ Tk_GetScreenMM(interp, tkwin, string, doublePtr) * TCL_OK is returned, then everything went well and the * rounded pixel distance is stored at *intPtr; otherwise * TCL_ERROR is returned and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * None. @@ -584,3 +676,5 @@ Tk_GetPixels(interp, tkwin, string, intPtr) } return TCL_OK; } + + diff --git a/generic/tkGrab.c b/generic/tkGrab.c index b013a63..16b8b2a 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -4,12 +4,12 @@ * This file provides procedures that implement grabs for Tk. * * Copyright (c) 1992-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkGrab.c,v 1.3 1999/03/10 07:04:39 stanton Exp $ + * RCS: @(#) $Id: tkGrab.c,v 1.4 1999/04/16 01:51:14 stanton Exp $ */ #include "tkPort.h" @@ -242,10 +242,11 @@ Tk_GrabCmd(clientData, interp, argc, argv) } dispPtr = ((TkWindow *) tkwin)->dispPtr; if (dispPtr->eventualGrabWinPtr != NULL) { - interp->result = dispPtr->eventualGrabWinPtr->pathName; + Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName, + TCL_STATIC); } } else { - for (dispPtr = tkDisplayList; dispPtr != NULL; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { if (dispPtr->eventualGrabWinPtr != NULL) { Tcl_AppendElement(interp, @@ -307,11 +308,11 @@ Tk_GrabCmd(clientData, interp, argc, argv) } dispPtr = winPtr->dispPtr; if (dispPtr->eventualGrabWinPtr != winPtr) { - interp->result = "none"; + Tcl_SetResult(interp, "none", TCL_STATIC); } else if (dispPtr->grabFlags & GRAB_GLOBAL) { - interp->result = "global"; + Tcl_SetResult(interp, "global", TCL_STATIC); } else { - interp->result = "local"; + Tcl_SetResult(interp, "local", TCL_STATIC); } } else { Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1], @@ -333,7 +334,7 @@ Tk_GrabCmd(clientData, interp, argc, argv) * Results: * A standard Tcl result is returned. TCL_OK is the normal return * value; if the grab could not be set then TCL_ERROR is returned - * and interp->result will hold an error message. + * and the interp's result will hold an error message. * * Side effects: * Once this call completes successfully, no window outside the @@ -370,7 +371,8 @@ Tk_Grab(interp, tkwin, grabGlobal) } if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) { alreadyGrabbed: - interp->result = "grab failed: another application has grab"; + Tcl_SetResult(interp, "grab failed: another application has grab", + TCL_STATIC); return TCL_ERROR; } Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr); @@ -436,15 +438,18 @@ Tk_Grab(interp, tkwin, grabGlobal) if (grabResult != 0) { grabError: if (grabResult == GrabNotViewable) { - interp->result = "grab failed: window not viewable"; + Tcl_SetResult(interp, "grab failed: window not viewable", + TCL_STATIC); } else if (grabResult == AlreadyGrabbed) { goto alreadyGrabbed; } else if (grabResult == GrabFrozen) { - interp->result = "grab failed: keyboard or pointer frozen"; + Tcl_SetResult(interp, + "grab failed: keyboard or pointer frozen", TCL_STATIC); } else if (grabResult == GrabInvalidTime) { - interp->result = "grab failed: invalid time"; + Tcl_SetResult(interp, "grab failed: invalid time", + TCL_STATIC); } else { - char msg[100]; + char msg[64 + TCL_INTEGER_SPACE]; sprintf(msg, "grab failed for unknown reason (code %d)", grabResult); diff --git a/generic/tkGrid.c b/generic/tkGrid.c index ea7a54c..11ae69d 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkGrid.c,v 1.3 1999/01/06 21:10:46 stanton Exp $ + * RCS: @(#) $Id: tkGrid.c,v 1.4 1999/04/16 01:51:14 stanton Exp $ */ #include "tkInt.h" @@ -222,14 +222,6 @@ typedef struct Gridder { #define DONT_PROPAGATE 2 /* - * Hash table used to map from Tk_Window tokens to corresponding - * Grid structures: - */ - -static Tcl_HashTable gridHashTable; -static int initialized = 0; - -/* * Prototypes for procedures used only in this file: */ @@ -314,6 +306,7 @@ Tk_GridCmd(clientData, interp, argc, argv) int endX, endY; /* last column/row in the layout */ int x=0, y=0; /* starting pixels for this bounding box */ int width, height; /* size of the bounding box */ + char buf[TCL_INTEGER_SPACE * 4]; if (argc!=3 && argc != 5 && argc != 7) { Tcl_AppendResult(interp, "wrong number of arguments: ", @@ -351,7 +344,7 @@ Tk_GridCmd(clientData, interp, argc, argv) gridPtr = masterPtr->masterDataPtr; if (gridPtr == NULL) { - sprintf(interp->result, "%d %d %d %d",0,0,0,0); + Tcl_SetResult(interp, "0 0 0 0", TCL_STATIC); return(TCL_OK); } @@ -360,7 +353,7 @@ Tk_GridCmd(clientData, interp, argc, argv) endY = MAX(gridPtr->rowEnd, gridPtr->rowMax); if ((endX == 0) || (endY == 0)) { - sprintf(interp->result, "%d %d %d %d",0,0,0,0); + Tcl_SetResult(interp, "0 0 0 0", TCL_STATIC); return(TCL_OK); } if (argc == 3) { @@ -406,8 +399,9 @@ Tk_GridCmd(clientData, interp, argc, argv) height = gridPtr->rowPtr[row2].offset - y; } - sprintf(interp->result, "%d %d %d %d", - x + gridPtr->startX, y + gridPtr->startY, width, height); + sprintf(buf, "%d %d %d %d", x + gridPtr->startX, y + gridPtr->startY, + width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) { if (argv[2][0] != '.') { Tcl_AppendResult(interp, "bad argument \"", argv[2], @@ -459,7 +453,7 @@ Tk_GridCmd(clientData, interp, argc, argv) } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) { register Gridder *slavePtr; Tk_Window slave; - char buffer[70]; + char buffer[64 + TCL_INTEGER_SPACE * 4]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -472,7 +466,7 @@ Tk_GridCmd(clientData, interp, argc, argv) } slavePtr = GetGrid(slave); if (slavePtr->masterPtr == NULL) { - interp->result[0] = '\0'; + Tcl_ResetResult(interp); return TCL_OK; } @@ -494,6 +488,7 @@ Tk_GridCmd(clientData, interp, argc, argv) int x, y; /* Offset in pixels, from edge of parent. */ int i, j; /* Corresponding column and row indeces. */ int endX, endY; /* end of grid */ + char buf[TCL_INTEGER_SPACE * 2]; if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -515,7 +510,7 @@ Tk_GridCmd(clientData, interp, argc, argv) masterPtr = GetGrid(master); if (masterPtr->masterDataPtr == NULL) { - sprintf(interp->result, "%d %d", -1, -1); + Tcl_SetResult(interp, "-1 -1", TCL_STATIC); return TCL_OK; } gridPtr = masterPtr->masterDataPtr; @@ -554,7 +549,8 @@ Tk_GridCmd(clientData, interp, argc, argv) } } - sprintf(interp->result, "%d %d", i, j); + sprintf(buf, "%d %d", i, j); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) { Tk_Window master; int propagate; @@ -571,7 +567,9 @@ Tk_GridCmd(clientData, interp, argc, argv) } masterPtr = GetGrid(master); if (argc == 3) { - interp->result = (masterPtr->flags & DONT_PROPAGATE) ? "0" : "1"; + Tcl_SetResult(interp, + ((masterPtr->flags & DONT_PROPAGATE) ? "0" : "1"), + TCL_STATIC); return TCL_OK; } if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) { @@ -609,13 +607,16 @@ Tk_GridCmd(clientData, interp, argc, argv) masterPtr = GetGrid(master); if (masterPtr->masterDataPtr != NULL) { + char buf[TCL_INTEGER_SPACE * 2]; + SetGridSize(masterPtr); gridPtr = masterPtr->masterDataPtr; - sprintf(interp->result, "%d %d", - MAX(gridPtr->columnEnd, gridPtr->columnMax), - MAX(gridPtr->rowEnd, gridPtr->rowMax)); + sprintf(buf, "%d %d", + MAX(gridPtr->columnEnd, gridPtr->columnMax), + MAX(gridPtr->rowEnd, gridPtr->rowMax)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else { - sprintf(interp->result, "%d %d",0, 0); + Tcl_SetResult(interp, "0 0", TCL_STATIC); } } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0) && (length > 1)) { @@ -757,12 +758,16 @@ Tk_GridCmd(clientData, interp, argc, argv) Tcl_Free((char *)argvPtr); } if ((argc == 4) && (ok == TCL_OK)) { - sprintf(interp->result,"-minsize %d -pad %d -weight %d", + char buf[64 + TCL_INTEGER_SPACE * 3]; + + sprintf(buf, "-minsize %d -pad %d -weight %d", slotPtr[slot].minSize,slotPtr[slot].pad, slotPtr[slot].weight); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return (TCL_OK); } else if (argc == 4) { - sprintf(interp->result,"-minsize %d -pad %d -weight %d", 0,0,0); + Tcl_SetResult(interp, "-minsize 0 -pad 0 -weight 0", + TCL_STATIC); return (TCL_OK); } @@ -783,8 +788,12 @@ Tk_GridCmd(clientData, interp, argc, argv) } if (strncmp(argv[i], "-minsize", length) == 0) { if (argc == 5) { - int value = ok == TCL_OK ? slotPtr[slot].minSize : 0; - sprintf(interp->result,"%d",value); + char buf[TCL_INTEGER_SPACE]; + int value; + + value = (ok == TCL_OK) ? slotPtr[slot].minSize : 0; + sprintf(buf, "%d", value); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (Tk_GetPixels(interp, master, argv[i+1], &size) != TCL_OK) { Tcl_Free((char *)argvPtr); @@ -796,8 +805,12 @@ Tk_GridCmd(clientData, interp, argc, argv) else if (strncmp(argv[i], "-weight", length) == 0) { int wt; if (argc == 5) { - int value = ok == TCL_OK ? slotPtr[slot].weight : 0; - sprintf(interp->result,"%d",value); + char buf[TCL_INTEGER_SPACE]; + int value; + + value = (ok == TCL_OK) ? slotPtr[slot].weight : 0; + sprintf(buf, "%d", value); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (Tcl_GetInt(interp, argv[i+1], &wt) != TCL_OK) { Tcl_Free((char *)argvPtr); return TCL_ERROR; @@ -812,8 +825,12 @@ Tk_GridCmd(clientData, interp, argc, argv) } else if (strncmp(argv[i], "-pad", length) == 0) { if (argc == 5) { - int value = ok == TCL_OK ? slotPtr[slot].pad : 0; - sprintf(interp->result,"%d",value); + char buf[TCL_INTEGER_SPACE]; + int value; + + value = (ok == TCL_OK) ? slotPtr[slot].pad : 0; + sprintf(buf, "%d", value); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (Tk_GetPixels(interp, master, argv[i+1], &size) != TCL_OK) { Tcl_Free((char *)argvPtr); @@ -1717,10 +1734,11 @@ GetGrid(tkwin) register Gridder *gridPtr; Tcl_HashEntry *hPtr; int new; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - initialized = 1; - Tcl_InitHashTable(&gridHashTable, TCL_ONE_WORD_KEYS); + if (!dispPtr->gridInit) { + Tcl_InitHashTable(&dispPtr->gridHashTable, TCL_ONE_WORD_KEYS); + dispPtr->gridInit = 1; } /* @@ -1728,7 +1746,7 @@ GetGrid(tkwin) * then create a new one. */ - hPtr = Tcl_CreateHashEntry(&gridHashTable, (char *) tkwin, &new); + hPtr = Tcl_CreateHashEntry(&dispPtr->gridHashTable, (char *) tkwin, &new); if (!new) { return (Gridder *) Tcl_GetHashValue(hPtr); } @@ -2048,6 +2066,7 @@ GridStructureProc(clientData, eventPtr) XEvent *eventPtr; /* Describes what just happened. */ { register Gridder *gridPtr = (Gridder *) clientData; + TkDisplay *dispPtr = ((TkWindow *) gridPtr->tkwin)->dispPtr; if (eventPtr->type == ConfigureNotify) { if (!(gridPtr->flags & REQUESTED_RELAYOUT)) { @@ -2075,7 +2094,7 @@ GridStructureProc(clientData, eventPtr) nextPtr = gridPtr2->nextPtr; gridPtr2->nextPtr = NULL; } - Tcl_DeleteHashEntry(Tcl_FindHashEntry(&gridHashTable, + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->gridHashTable, (char *) gridPtr->tkwin)); if (gridPtr->flags & REQUESTED_RELAYOUT) { Tk_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr); @@ -2110,7 +2129,7 @@ GridStructureProc(clientData, eventPtr) * * Results: * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is - * returned and interp->result is set to contain an error message. + * returned and the interp's result is set to contain an error message. * * Side effects: * Slave windows get taken over by the grid. @@ -2284,7 +2303,8 @@ ConfigureSlaves(interp, tkwin, argc, argv) return TCL_ERROR; } if (other == slave) { - sprintf(interp->result,"Window can't be managed in itself"); + Tcl_SetResult(interp, "Window can't be managed in itself", + TCL_STATIC); return TCL_ERROR; } masterPtr = GetGrid(other); diff --git a/generic/tkImage.c b/generic/tkImage.c index d2733ba..f9ff2b4 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -6,12 +6,12 @@ * widgets. * * Copyright (c) 1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkImage.c,v 1.2 1998/09/14 18:23:12 stanton Exp $ + * RCS: @(#) $Id: tkImage.c,v 1.3 1999/04/16 01:51:15 stanton Exp $ */ #include "tkInt.h" @@ -71,12 +71,11 @@ typedef struct ImageMaster { * derived from this name. */ } ImageMaster; -/* - * The following variable points to the first in a list of all known - * image types. - */ - -static Tk_ImageType *imageTypeList = NULL; +typedef struct ThreadSpecificData { + Tk_ImageType *imageTypeList;/* First in a list of all known image + * types. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Prototypes for local procedures: @@ -110,8 +109,11 @@ Tk_CreateImageType(typePtr) * in by caller. Must not have been passed * to Tk_CreateImageType previously. */ { - typePtr->nextPtr = imageTypeList; - imageTypeList = typePtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + typePtr->nextPtr = tsdPtr->imageTypeList; + tsdPtr->imageTypeList = typePtr; } /* @@ -146,8 +148,10 @@ Tk_ImageCmd(clientData, interp, argc, argv) Image *imagePtr; Tcl_HashEntry *hPtr; Tcl_HashSearch search; - char idString[30], *name; - static int id = 0; + char idString[16 + TCL_INTEGER_SPACE], *name; + TkDisplay *dispPtr = winPtr->dispPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -168,7 +172,7 @@ Tk_ImageCmd(clientData, interp, argc, argv) * Look up the image type. */ - for (typePtr = imageTypeList; typePtr != NULL; + for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { if ((c == typePtr->name[0]) && (strcmp(argv[2], typePtr->name) == 0)) { @@ -186,8 +190,8 @@ Tk_ImageCmd(clientData, interp, argc, argv) */ if ((argc == 3) || (argv[3][0] == '-')) { - id++; - sprintf(idString, "image%d", id); + dispPtr->imageId++; + sprintf(idString, "image%d", dispPtr->imageId); name = idString; firstOption = 3; } else { @@ -248,7 +252,9 @@ Tk_ImageCmd(clientData, interp, argc, argv) imagePtr->instanceData = (*typePtr->getProc)( imagePtr->tkwin, masterPtr->masterData); } - interp->result = Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr); + Tcl_SetResult(interp, + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), + TCL_STATIC); } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) { for (i = 2; i < argc; i++) { hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[i]); @@ -261,6 +267,8 @@ Tk_ImageCmd(clientData, interp, argc, argv) DeleteImage(masterPtr); } } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) { + char buf[TCL_INTEGER_SPACE]; + if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " height name\"", (char *) NULL); @@ -273,7 +281,8 @@ Tk_ImageCmd(clientData, interp, argc, argv) return TCL_ERROR; } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); - sprintf(interp->result, "%d", masterPtr->height); + sprintf(buf, "%d", masterPtr->height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -299,7 +308,7 @@ Tk_ImageCmd(clientData, interp, argc, argv) } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); if (masterPtr->typePtr != NULL) { - interp->result = masterPtr->typePtr->name; + Tcl_SetResult(interp, masterPtr->typePtr->name, TCL_STATIC); } } else if ((c == 't') && (strcmp(argv[1], "types") == 0)) { if (argc != 2) { @@ -307,11 +316,13 @@ Tk_ImageCmd(clientData, interp, argc, argv) " types\"", (char *) NULL); return TCL_ERROR; } - for (typePtr = imageTypeList; typePtr != NULL; + for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { Tcl_AppendElement(interp, typePtr->name); } } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) { + char buf[TCL_INTEGER_SPACE]; + if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " width name\"", (char *) NULL); @@ -324,7 +335,8 @@ Tk_ImageCmd(clientData, interp, argc, argv) return TCL_ERROR; } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); - sprintf(interp->result, "%d", masterPtr->width); + sprintf(buf, "%d", masterPtr->width); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, height, names, type, types,", @@ -416,7 +428,7 @@ Tk_NameOfImage(imageMaster) * Results: * The return value is a token for the image. If there is no image * by the given name, then NULL is returned and an error message is - * left in interp->result. + * left in the interp's result. * * Side effects: * Tk records the fact that the widget is using the image, and diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index d7be9de..093abac 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkImgBmap.c,v 1.5 1999/02/04 20:56:15 stanton Exp $ + * RCS: @(#) $Id: tkImgBmap.c,v 1.6 1999/04/16 01:51:15 stanton Exp $ */ #include "tkInt.h" @@ -227,7 +227,7 @@ ImgBmapCreate(interp, name, argc, argv, typePtr, master, clientDataPtr) * * Results: * A standard Tcl return value. If TCL_ERROR is returned then - * an error message is left in masterPtr->interp->result. + * an error message is left in the masterPtr->interp's result. * * Side effects: * Existing instances of the image will be redisplayed to match @@ -278,7 +278,8 @@ ImgBmapConfigureMaster(masterPtr, argc, argv, flags) if ((masterPtr->maskFileString != NULL) || (masterPtr->maskDataString != NULL)) { if (masterPtr->data == NULL) { - masterPtr->interp->result = "can't have mask without bitmap"; + Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap", + TCL_STATIC); return TCL_ERROR; } masterPtr->maskData = TkGetBitmapData(masterPtr->interp, @@ -291,7 +292,8 @@ ImgBmapConfigureMaster(masterPtr, argc, argv, flags) || (maskHeight != masterPtr->height)) { ckfree(masterPtr->maskData); masterPtr->maskData = NULL; - masterPtr->interp->result = "bitmap and mask have different sizes"; + Tcl_SetResult(masterPtr->interp, + "bitmap and mask have different sizes", TCL_STATIC); return TCL_ERROR; } } @@ -459,7 +461,7 @@ ImgBmapConfigureInstance(instancePtr) * *heightPtr. *hotXPtr and *hotYPtr are set to the bitmap * hotspot if one is defined, otherwise they are set to -1, -1. * If an error occurred, NULL is returned and an error message is - * left in interp->result. + * left in the interp's result. * * Side effects: * A bitmap is created. @@ -628,9 +630,8 @@ TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr, return data; error: - if (interp != NULL) { - interp->result = "format error in bitmap data"; - } + Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC); + errorCleanup: if (data != NULL) { ckfree(data); @@ -740,9 +741,8 @@ ImgBmapCmd(clientData, interp, argc, argv) size_t length; if (argc < 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s option ?arg arg ...?\"", - argv[0]); + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option ?arg arg ...?\"", (char *) NULL); return TCL_ERROR; } c = argv[1][0]; diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index d9dd900..88edfa8 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -27,7 +27,7 @@ * | provided "as is" without express or implied warranty. | * +-------------------------------------------------------------------+ * - * RCS: @(#) $Id: tkImgGIF.c,v 1.2 1998/09/14 18:23:12 stanton Exp $ + * RCS: @(#) $Id: tkImgGIF.c,v 1.3 1999/04/16 01:51:15 stanton Exp $ */ /* @@ -61,6 +61,17 @@ typedef struct mFile { #include "tkPort.h" /* + * HACK ALERT!! HACK ALERT!! HACK ALERT!! + * This code is hard-wired for reading from files. In order to read + * from a data stream, we'll trick fread so we can reuse the same code + */ + +typedef struct ThreadSpecificData { + int fromData; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* * The format record for the GIF file format: */ @@ -100,14 +111,6 @@ Tk_PhotoImageFormat tkImgFmtGIF = { #define ReadOK(file,buffer,len) (Fread(buffer, len, 1, file) != 0) /* - * HACK ALERT!! HACK ALERT!! HACK ALERT!! - * This code is hard-wired for reading from files. In order to read - * from a data stream, we'll trick fread so we can reuse the same code - */ - -static int fromData=0; - -/* * Prototypes for local procedures defined in this file: */ @@ -184,7 +187,7 @@ FileMatchGIF(chan, fileName, formatString, widthPtr, heightPtr) * * Results: * A standard TCL completion code. If TCL_ERROR is returned - * then an error message is left in interp->result. + * 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 @@ -287,12 +290,14 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY, */ if (Fread(buf, 1, 1, chan) != 1) { - interp->result = - "error reading extension function code in GIF image"; + Tcl_SetResult(interp, + "error reading extension function code in GIF image", + TCL_STATIC); goto error; } if (DoExtension(chan, buf[0], &transparent) < 0) { - interp->result = "error reading extension in GIF image"; + Tcl_SetResult(interp, "error reading extension in GIF image", + TCL_STATIC); goto error; } continue; @@ -306,7 +311,9 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY, } if (Fread(buf, 1, 9, chan) != 9) { - interp->result = "couldn't read left/top/width/height in GIF image"; + Tcl_SetResult(interp, + "couldn't read left/top/width/height in GIF image", + TCL_STATIC); goto error; } @@ -418,7 +425,7 @@ StringMatchGIF(string, formatString, widthPtr, heightPtr) * * Results: * A standard TCL completion code. If TCL_ERROR is returned - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * new data is added to the image given by imageHandle. This @@ -439,15 +446,18 @@ StringReadGIF(interp,string,formatString,imageHandle, int width, height; /* image to copy */ int srcX, srcY; { - int result; - MFile handle; - mInit((unsigned char *)string,&handle); - fromData = 1; - result = FileReadGIF(interp, (Tcl_Channel) &handle, "inline data", - formatString, imageHandle, destX, destY, width, height, - srcX, srcY); - fromData = 0; - return(result); + int result; + MFile handle; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + mInit((unsigned char *)string,&handle); + tsdPtr->fromData = 1; + result = FileReadGIF(interp, (Tcl_Channel) &handle, "inline data", + formatString, imageHandle, destX, destY, width, height, + srcX, srcY); + tsdPtr->fromData = 0; + return(result); } /* @@ -619,7 +629,7 @@ ReadImage(interp, imagePtr, chan, len, rows, cmap, } if (LWZReadByte(chan, 1, c) < 0) { - interp->result = "format error in GIF image"; + Tcl_SetResult(interp, "format error in GIF image", TCL_STATIC); return TCL_ERROR; } @@ -1051,7 +1061,10 @@ Fread(dst, hunk, count, chan) size_t hunk,count; /* how many */ Tcl_Channel chan; { - if (fromData) { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tsdPtr->fromData) { return(Mread(dst, hunk, count, (MFile *) chan)); } else { return Tcl_Read(chan, (char *) dst, (int) (hunk * count)); diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c index 7573955..7482692 100644 --- a/generic/tkImgPPM.c +++ b/generic/tkImgPPM.c @@ -13,7 +13,7 @@ * Department of Computer Science, * Australian National University. * - * RCS: @(#) $Id: tkImgPPM.c,v 1.2 1998/09/14 18:23:13 stanton Exp $ + * RCS: @(#) $Id: tkImgPPM.c,v 1.3 1999/04/16 01:51:15 stanton Exp $ */ #include "tkInt.h" @@ -110,7 +110,7 @@ FileMatchPPM(chan, fileName, formatString, widthPtr, heightPtr) * * Results: * A standard TCL completion code. If TCL_ERROR is returned - * then an error message is left in interp->result. + * 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 @@ -151,7 +151,7 @@ FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY, return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { - char buffer[30]; + char buffer[TCL_INTEGER_SPACE]; sprintf(buffer, "%d", maxIntensity); Tcl_AppendResult(interp, "PPM image file \"", fileName, @@ -243,7 +243,7 @@ FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY, * * Results: * A standard TCL completion code. If TCL_ERROR is returned - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * Data is written to the file given by "fileName". @@ -262,7 +262,7 @@ FileWritePPM(interp, fileName, formatString, blockPtr) int w, h; int greenOffset, blueOffset, nBytes; unsigned char *pixelPtr, *pixLinePtr; - char header[30]; + char header[16 + TCL_INTEGER_SPACE * 2]; chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666); if (chan == NULL) { diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 285f1df..9fb74e6 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -11,7 +11,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkImgPhoto.c,v 1.5 1999/03/10 07:04:39 stanton Exp $ + * Author: Paul Mackerras (paulus@cs.anu.edu.au), + * Department of Computer Science, + * Australian National University. + * + * RCS: @(#) $Id: tkImgPhoto.c,v 1.6 1999/04/16 01:51:15 stanton Exp $ */ #include "tkInt.h" @@ -293,6 +297,12 @@ Tk_ImageType tkPhotoImageType = { (Tk_ImageType *) NULL /* nextPtr */ }; +typedef struct ThreadSpecificData { + Tk_PhotoImageFormat *formatList; /* Pointer to the first in the + * list of known photo image formats.*/ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + /* * Default configuration */ @@ -334,12 +344,6 @@ static int imgPhotoColorHashInitialized; #define N_COLOR_HASH (sizeof(ColorTableId) / sizeof(int)) /* - * Pointer to the first in the list of known photo image formats. - */ - -static Tk_PhotoImageFormat *formatList = NULL; - -/* * Forward declarations */ @@ -419,13 +423,15 @@ Tk_CreatePhotoImageFormat(formatPtr) * to Tk_CreatePhotoImageFormat previously. */ { Tk_PhotoImageFormat *copyPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat)); *copyPtr = *formatPtr; copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1)); strcpy(copyPtr->name, formatPtr->name); - copyPtr->nextPtr = formatList; - formatList = copyPtr; + copyPtr->nextPtr = tsdPtr->formatList; + tsdPtr->formatList = copyPtr; } /* @@ -526,7 +532,6 @@ ImgPhotoCmd(clientData, interp, argc, argv) unsigned char *pixelPtr; Tk_PhotoImageBlock block; Tk_Window tkwin; - char string[16]; XColor color; Tk_PhotoImageFormat *imageFormat; int imageWidth, imageHeight; @@ -534,6 +539,8 @@ ImgPhotoCmd(clientData, interp, argc, argv) Tcl_Channel chan; Tk_PhotoHandle srcHandle; size_t length; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -682,6 +689,8 @@ ImgPhotoCmd(clientData, interp, argc, argv) * photo get command - first parse and check parameters. */ + char string[TCL_INTEGER_SPACE * 3]; + if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " get x y\"", (char *) NULL); @@ -978,7 +987,7 @@ ImgPhotoCmd(clientData, interp, argc, argv) */ matched = 0; - for (imageFormat = formatList; imageFormat != NULL; + for (imageFormat = tsdPtr->formatList; imageFormat != NULL; imageFormat = imageFormat->nextPtr) { if ((options.format == NULL) || (strncasecmp(options.format, imageFormat->name, @@ -1258,7 +1267,7 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv) * * Results: * A standard Tcl return value. If TCL_ERROR is returned then - * an error message is left in masterPtr->interp->result. + * an error message is left in the masterPtr->interp's result. * * Side effects: * Existing instances of the image will be redisplayed to match @@ -1601,7 +1610,7 @@ ImgPhotoGet(tkwin, masterData) int mono, nRed, nGreen, nBlue; XVisualInfo visualInfo, *visInfoPtr; XRectangle validBox; - char buf[16]; + char buf[TCL_INTEGER_SPACE * 3]; int numVisuals; XColor *white, *black; XGCValues gcValues; @@ -3022,6 +3031,8 @@ MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr, { int matched; Tk_PhotoImageFormat *formatPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Scan through the table of file format handlers to find @@ -3029,7 +3040,7 @@ MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr, */ matched = 0; - for (formatPtr = formatList; formatPtr != NULL; + for (formatPtr = tsdPtr->formatList; formatPtr != NULL; formatPtr = formatPtr->nextPtr) { if (formatString != NULL) { if (strncasecmp(formatString, formatPtr->name, @@ -3112,6 +3123,8 @@ MatchStringFormat(interp, string, formatString, imageFormatPtr, { int matched; Tk_PhotoImageFormat *formatPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Scan through the table of file format handlers to find @@ -3119,7 +3132,7 @@ MatchStringFormat(interp, string, formatString, imageFormatPtr, */ matched = 0; - for (formatPtr = formatList; formatPtr != NULL; + for (formatPtr = tsdPtr->formatList; formatPtr != NULL; formatPtr = formatPtr->nextPtr) { if (formatString != NULL) { if (strncasecmp(formatString, formatPtr->name, diff --git a/generic/tkInitScript.h b/generic/tkInitScript.h index a478fd0..2e2b234 100644 --- a/generic/tkInitScript.h +++ b/generic/tkInitScript.h @@ -9,9 +9,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkInitScript.h,v 1.7 1998/09/14 18:23:13 stanton Exp $ + * RCS: @(#) $Id: tkInitScript.h,v 1.8 1999/04/16 01:51:15 stanton Exp $ */ + + /* * In order to find tk.tcl during initialization, the following script * is invoked by Tk_Init(). It looks in several different directories: @@ -48,7 +50,7 @@ static char initScript[] = "if {[info proc tkInit]==\"\"} {\n\ proc tkInit {} {\n\ global tk_library tk_version tk_patchLevel\n\ - rename tkInit {}\n\ + rename tkInit {}\n\ tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\ }\n\ }\n\ diff --git a/generic/tkInt.decls b/generic/tkInt.decls index dd70ef8..edb69f2 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -1,4 +1,4 @@ -# tkInt.decls -- + # tkInt.decls -- # # This file contains the declarations for all unsupported # functions that are exported by the Tk library. This file @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tkInt.decls,v 1.4 1999/03/12 03:17:47 stanton Exp $ +# RCS: @(#) $Id: tkInt.decls,v 1.5 1999/04/16 01:51:15 stanton Exp $ library tk @@ -156,8 +156,9 @@ declare 28 generic { void TkFreeBindingTags (TkWindow *winPtr) } +# Name change only, TkFreeCursor in Tcl 8.0.x now TkpFreeCursor declare 29 generic { - void TkFreeCursor (TkCursor *cursorPtr) + void TkpFreeCursor (TkCursor *cursorPtr) } declare 30 generic { @@ -237,12 +238,12 @@ declare 46 generic { } declare 47 generic { - int TkLineToArea (TkDouble2 end1Ptr, TkDouble2 end2Ptr, TkDouble4 rectPtr) + int TkLineToArea (double end1Ptr[], double end2Ptr[], double rectPtr[]) } declare 48 generic { double TkLineToPoint (double end1Ptr[], \ - TkDouble2 end2Ptr, TkDouble2 pointPtr) + double end2Ptr[], double pointPtr[]) } declare 49 generic { @@ -269,8 +270,8 @@ declare 53 generic { } declare 54 generic { - double TkOvalToPoint (TkDouble4 ovalPtr, \ - double width, int filled, TkDouble2 pointPtr) + double TkOvalToPoint (double ovalPtr[], \ + double width, int filled, double pointPtr[]) } declare 55 generic { @@ -456,6 +457,73 @@ declare 97 generic { void TkWmUnmapWindow (TkWindow *winPtr) } +# new for 8.1 + +declare 98 generic { + Tcl_Obj * TkDebugBitmap ( Tk_Window tkwin, char *name) +} + +declare 99 generic { + Tcl_Obj * TkDebugBorder ( Tk_Window tkwin, char *name) +} + +declare 100 generic { + Tcl_Obj * TkDebugCursor ( Tk_Window tkwin, char *name) +} + +declare 101 generic { + Tcl_Obj * TkDebugColor ( Tk_Window tkwin, char *name) +} + +declare 102 generic { + Tcl_Obj * TkDebugConfig (Tcl_Interp *interp, Tk_OptionTable table) +} + +declare 103 generic { + Tcl_Obj * TkDebugFont ( Tk_Window tkwin, char *name) +} + +declare 104 generic { + int TkFindStateNumObj (Tcl_Interp *interp, \ + Tcl_Obj *optionPtr, CONST TkStateMap *mapPtr, \ + Tcl_Obj *keyPtr) +} + +declare 105 generic { + Tcl_HashTable * TkGetBitmapPredefTable (void) +} + +declare 106 generic { + TkDisplay * TkGetDisplayList (void) +} + +declare 107 generic { + TkMainInfo * TkGetMainInfoList (void) +} + +declare 108 generic { + int TkGetWindowFromObj (Tcl_Interp *interp, \ + Tk_Window tkwin, Tcl_Obj *objPtr, \ + Tk_Window *windowPtr) +} + +declare 109 generic { + char * TkpGetString (TkWindow *winPtr, \ + XEvent *eventPtr, Tcl_DString *dsPtr) +} + +declare 110 generic { + void TkpGetSubFonts (Tcl_Interp *interp, Tk_Font tkfont) +} + +declare 111 generic { + Tcl_Obj * TkpGetSystemDefault (Tk_Window tkwin, \ + char *dbName, char *className) +} + +declare 112 generic { + void TkpMenuThreadInit (void) +} ############################################################################## @@ -655,6 +723,24 @@ declare 35 win { void TkWinXInit (HINSTANCE hInstance) } +# new for 8.1 + +declare 36 win { + void TkWinSetForegroundWindow (TkWindow *winPtr) +} + +declare 37 win { + void TkWinDialogDebug (int debug) +} + +declare 38 win { + Tcl_Obj * TkWinGetMenuSystemDefault (Tk_Window tkwin, \ + char *dbName, char *className) +} + +declare 39 win { + int TkWinGetPlatformId(void) +} ######################## # Mac specific functions @@ -1089,7 +1175,7 @@ declare 25 win { declare 26 win { Pixmap XCreateBitmapFromData(Display* display, Drawable d, \ _Xconst char* data, unsigned int width,unsigned int height) -} +} declare 27 win { void XDefineCursor (Display* d, Window w, Cursor c) @@ -1327,13 +1413,118 @@ declare 80 win { int dest_x, int dest_y, unsigned int width, \ unsigned int height) } +# This slot is reserved for use by the clipping rectangle patch: +# declare 81 win { +# XSetClipRectangles(Display *display, GC gc, int clip_x_origin, \ +# int clip_y_origin, XRectangle rectangles[], int n, int ordering) +# } + +declare 82 win { + Status XParseColor (Display *display, Colormap map, \ + _Xconst char* spec, XColor *colorPtr) +} + +declare 83 win { + GC XCreateGC(Display* display, Drawable d, \ + unsigned long valuemask, XGCValues* values) +} + +declare 84 win { + void XFreeGC(Display* display, GC gc) +} + +declare 85 win { + Atom XInternAtom(Display* display,_Xconst char* atom_name, \ + Bool only_if_exists) +} + +declare 86 win { + void XSetBackground(Display* display, GC gc, \ + unsigned long foreground) +} + +declare 87 win { + void XSetForeground(Display* display, GC gc, \ + unsigned long foreground) +} + +declare 88 win { + void XSetClipMask(Display* display, GC gc, Pixmap pixmap) +} + +declare 89 win { + void XSetClipOrigin(Display* display, GC gc, \ + int clip_x_origin, int clip_y_origin) +} + +declare 90 win { + void XSetTSOrigin(Display* display, GC gc, \ + int ts_x_origin, int ts_y_origin) +} + +declare 91 win { + void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values) +} + +declare 92 win { + void XSetFont(Display *display, GC gc, Font font) +} + +declare 93 win { + void XSetArcMode(Display *display, GC gc, int arc_mode) +} + +declare 94 win { + void XSetStipple(Display *display, GC gc, Pixmap stipple) +} + +declare 95 win { + void XSetFillRule(Display *display, GC gc, int fill_rule) +} + +declare 96 win { + void XSetFillStyle(Display *display, GC gc, int fill_style) +} + +declare 97 win { + void XSetFunction(Display *display, GC gc, int function) +} + +declare 98 win { + void XSetLineAttributes(Display *display, GC gc, \ + unsigned int line_width, int line_style, \ + int cap_style, int join_style) +} + +declare 99 win { + int _XInitImageFuncPtrs(XImage *image) +} + +declare 100 win { + XIC XCreateIC(void) +} + +declare 101 win { + XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \ + XVisualInfo* vinfo_template, int* nitems_return) +} + +declare 102 win { + void XSetWMClientMachine(Display* display, Window w, XTextProperty* text_prop) +} + +declare 103 win { + Status XStringListToTextProperty(char** list, int count, \ + XTextProperty* text_prop_return) +} # X functions for Mac # This slot is reserved for use by the dash patch: -# declare 0 mac { +# declare 0 win { # XSetDashes # } + declare 1 mac { XModifierKeymap* XGetModifierMapping (Display* d) } @@ -1422,7 +1613,7 @@ declare 18 mac { declare 19 mac { Pixmap XCreateBitmapFromData(Display* display, Drawable d, \ _Xconst char* data, unsigned int width,unsigned int height) -} +} declare 20 mac { void XDefineCursor (Display* d, Window w, Cursor c) @@ -1591,5 +1782,102 @@ declare 57 mac { GC gc, XImage* image, int src_x, int src_y, \ int dest_x, int dest_y, unsigned int width, \ unsigned int height) +} +declare 58 mac { + Status XParseColor (Display *display, Colormap map, \ + _Xconst char* spec, XColor *colorPtr) +} + +declare 59 mac { + GC XCreateGC(Display* display, Drawable d, \ + unsigned long valuemask, XGCValues* values) +} + +declare 60 mac { + void XFreeGC(Display* display, GC gc) +} + +declare 61 mac { + Atom XInternAtom(Display* display,_Xconst char* atom_name, \ + Bool only_if_exists) +} + +declare 62 mac { + void XSetBackground(Display* display, GC gc, \ + unsigned long foreground) +} + +declare 63 mac { + void XSetForeground(Display* display, GC gc, \ + unsigned long foreground) +} + +declare 64 mac { + void XSetClipMask(Display* display, GC gc, Pixmap pixmap) } +declare 65 mac { + void XSetClipOrigin(Display* display, GC gc, \ + int clip_x_origin, int clip_y_origin) +} + +declare 66 mac { + void XSetTSOrigin(Display* display, GC gc, \ + int ts_x_origin, int ts_y_origin) +} + +declare 67 mac { + void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values) +} + +declare 68 mac { + void XSetFont(Display *display, GC gc, Font font) +} + +declare 69 mac { + void XSetArcMode(Display *display, GC gc, int arc_mode) +} + +declare 70 mac { + void XSetStipple(Display *display, GC gc, Pixmap stipple) +} + +declare 71 mac { + void XSetFillRule(Display *display, GC gc, int fill_rule) +} + +declare 72 mac { + void XSetFillStyle(Display *display, GC gc, int fill_style) +} + +declare 73 mac { + void XSetFunction(Display *display, GC gc, int function) +} + +declare 74 mac { + void XSetLineAttributes(Display *display, GC gc, \ + unsigned int line_width, int line_style, \ + int cap_style, int join_style) +} + +declare 75 mac { + int _XInitImageFuncPtrs(XImage *image) +} + +declare 76 mac { + XIC XCreateIC(void) +} + +declare 77 mac { + XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \ + XVisualInfo* vinfo_template, int* nitems_return) +} + +declare 78 mac { + void XSetWMClientMachine(Display* display, Window w, XTextProperty* text_prop) +} + +declare 79 mac { + Status XStringListToTextProperty(char** list, int count, \ + XTextProperty* text_prop_return) +} diff --git a/generic/tkInt.h b/generic/tkInt.h index c9706e9..68091bc 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.9 1999/03/10 07:04:40 stanton Exp $ + * RCS: $Id: tkInt.h,v 1.10 1999/04/16 01:51:15 stanton Exp $ */ #ifndef _TKINT @@ -40,13 +40,6 @@ typedef struct TkStressedCmap TkStressedCmap; typedef struct TkBindInfo_ *TkBindInfo; /* - * Array type definitions - */ - -typedef double TkDouble2[2]; -typedef double TkDouble4[4]; - -/* * Procedure types. */ @@ -89,16 +82,37 @@ typedef struct TkClassProcs { typedef struct TkCursor { Tk_Cursor cursor; /* System specific identifier for cursor. */ - int refCount; /* Number of active uses of cursor. */ + Display *display; /* Display containing cursor. Needed for + * disposal and retrieval of cursors. */ + int resourceRefCount; /* Number of active uses of this cursor (each + * active use corresponds to a call to + * Tk_AllocPreserveFromObj or Tk_GetPreserve). + * If this count is 0, then this structure + * is no longer valid and it isn't present + * in a hash table: it is being kept around + * only because there are objects referring + * to it. The structure is freed when + * resourceRefCount and objRefCount are + * both 0. */ + int objRefCount; /* Number of Tcl objects that reference + * this structure.. */ Tcl_HashTable *otherTable; /* Second table (other than idTable) used * to index this entry. */ Tcl_HashEntry *hashPtr; /* Entry in otherTable for this structure * (needed when deleting). */ + Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure + * (needed when deleting). */ + struct TkCursor *nextPtr; /* Points to the next TkCursor structure with + * the same name. Cursors with the same + * name but different displays are chained + * together off a single hash table entry. */ } TkCursor; /* * One of the following structures is maintained for each display - * containing a window managed by Tk: + * containing a window managed by Tk. In part, the structure is + * used to store thread-specific data, since each thread will have + * its own TkDisplay structure. */ typedef struct TkDisplay { @@ -110,6 +124,23 @@ typedef struct TkDisplay { * display. */ /* + * Information used primarily by tk3d.c: + */ + + int borderInit; /* 0 means borderTable needs initializing. */ + Tcl_HashTable borderTable; /* Maps from color name to TkBorder + * structure. */ + + /* + * Information used by tkAtom.c only: + */ + + int atomInit; /* 0 means stuff below hasn't been + * initialized yet. */ + Tcl_HashTable nameTable; /* Maps from names to Atom's. */ + Tcl_HashTable atomTable; /* Maps from Atom's back to names. */ + + /* * Information used primarily by tkBind.c: */ @@ -135,6 +166,63 @@ typedef struct TkDisplay { * may be NULL. */ /* + * Information used by tkBitmap.c only: + */ + + int bitmapInit; /* 0 means tables above need initializing. */ + int bitmapAutoNumber; /* Used to number bitmaps. */ + Tcl_HashTable bitmapNameTable; + /* Maps from name of bitmap to the first + * TkBitmap record for that name. */ + Tcl_HashTable bitmapIdTable;/* Maps from bitmap id to the TkBitmap + * structure for the bitmap. */ + Tcl_HashTable bitmapDataTable; + /* Used by Tk_GetBitmapFromData to map from + * a collection of in-core data about a + * bitmap to a reference giving an auto- + * matically-generated name for the bitmap. */ + + /* + * Information used by tkCanvas.c only: + */ + + int numIdSearches; + int numSlowSearches; + + /* + * Used by tkColor.c only: + */ + + int colorInit; /* 0 means color module needs initializing. */ + TkStressedCmap *stressPtr; /* First in list of colormaps that have + * filled up, so we have to pick an + * approximate color. */ + Tcl_HashTable colorNameTable; + /* Maps from color name to TkColor structure + * for that color. */ + Tcl_HashTable colorValueTable; + /* Maps from integer RGB values to TkColor + * structures. */ + + /* + * Used by tkCursor.c only: + */ + + int cursorInit; /* 0 means cursor module need initializing. */ + Tcl_HashTable cursorNameTable; + /* Maps from a string name to a cursor to the + * TkCursor record for the cursor. */ + Tcl_HashTable cursorDataTable; + /* Maps from a collection of in-core data + * about a cursor to a TkCursor structure. */ + Tcl_HashTable cursorIdTable; + /* Maps from a cursor id to the TkCursor + * structure for the cursor. */ + char cursorString[20]; /* Used to store a cursor id string. */ + Font cursorFont; /* Font to use for standard cursors. + * None means font not loaded yet. */ + + /* * Information used by tkError.c only: */ @@ -148,68 +236,65 @@ typedef struct TkDisplay { * gets big, handlers get cleaned up. */ /* - * Information used by tkSend.c only: + * Used by tkEvent.c only: */ - Tk_Window commTkwin; /* Window used for communication - * between interpreters during "send" - * commands. NULL means send info hasn't - * been initialized yet. */ - Atom commProperty; /* X's name for comm property. */ - Atom registryProperty; /* X's name for property containing - * registry of interpreter names. */ - Atom appNameProperty; /* X's name for property used to hold the - * application name on each comm window. */ + struct TkWindowEvent *delayedMotionPtr; + /* Points to a malloc-ed motion event + * whose processing has been delayed in + * the hopes that another motion event + * will come along right away and we can + * merge the two of them together. NULL + * means that there is no delayed motion + * event. */ /* - * Information used by tkSelect.c and tkClipboard.c only: + * Information used by tkFocus.c only: */ - struct TkSelectionInfo *selectionInfoPtr; - /* First in list of selection information - * records. Each entry contains information - * about the current owner of a particular - * selection on this display. */ - Atom multipleAtom; /* Atom for MULTIPLE. None means - * selection stuff isn't initialized. */ - Atom incrAtom; /* Atom for INCR. */ - Atom targetsAtom; /* Atom for TARGETS. */ - Atom timestampAtom; /* Atom for TIMESTAMP. */ - Atom textAtom; /* Atom for TEXT. */ - Atom compoundTextAtom; /* Atom for COMPOUND_TEXT. */ - Atom applicationAtom; /* Atom for TK_APPLICATION. */ - Atom windowAtom; /* Atom for TK_WINDOW. */ - Atom clipboardAtom; /* Atom for CLIPBOARD. */ + int focusDebug; /* 1 means collect focus debugging + * statistics. */ + struct TkWindow *implicitWinPtr; + /* If the focus arrived at a toplevel window + * implicitly via an Enter event (rather + * than via a FocusIn event), this points + * to the toplevel window. Otherwise it is + * NULL. */ + struct TkWindow *focusPtr; /* Points to the window on this display that + * should be receiving keyboard events. When + * multiple applications on the display have + * the focus, this will refer to the + * innermost window in the innermost + * application. This information isn't used + * under Unix or Windows, but it's needed on + * the Macintosh. */ - Tk_Window clipWindow; /* Window used for clipboard ownership and to - * retrieve selections between processes. NULL - * means clipboard info hasn't been - * initialized. */ - int clipboardActive; /* 1 means we currently own the clipboard - * selection, 0 means we don't. */ - struct TkMainInfo *clipboardAppPtr; - /* Last application that owned clipboard. */ - struct TkClipboardTarget *clipTargetPtr; - /* First in list of clipboard type information - * records. Each entry contains information - * about the buffers for a given selection - * target. */ + /* + * Information used by tkGC.c only: + */ + + Tcl_HashTable gcValueTable; /* Maps from a GC's values to a TkGC structure + * describing a GC with those values. */ + Tcl_HashTable gcIdTable; /* Maps from a GC to a TkGC. */ + int gcInit; /* 0 means the tables below need + * initializing. */ /* - * Information used by tkAtom.c only: + * Information used by tkGeometry.c only: */ - int atomInit; /* 0 means stuff below hasn't been - * initialized yet. */ - Tcl_HashTable nameTable; /* Maps from names to Atom's. */ - Tcl_HashTable atomTable; /* Maps from Atom's back to names. */ + Tcl_HashTable maintainHashTable; + /* Hash table that maps from a master's + * Tk_Window token to a list of slaves + * managed by that master. */ + int geomInit; /* - * Information used by tkCursor.c only: + * Information used by tkGet.c only: */ - - Font cursorFont; /* Font to use for standard cursors. - * None means font not loaded yet. */ + + Tcl_HashTable uidTable; /* Stores all Tk_Uids used in a thread. */ + int uidInit; /* 0 means uidTable needs initializing. */ /* * Information used by tkGrab.c only: @@ -247,6 +332,100 @@ typedef struct TkDisplay { * in tkGrab.c. */ /* + * Information used by tkGrid.c only: + */ + + int gridInit; /* 0 means table below needs initializing. */ + Tcl_HashTable gridHashTable;/* Maps from Tk_Window tokens to + * corresponding Grid structures. */ + + /* + * Information used by tkImage.c only: + */ + + int imageId; /* Value used to number image ids. */ + + /* + * Information used by tkMacWinMenu.c only: + */ + + int postCommandGeneration; + + /* + * Information used by tkOption.c only. + */ + + + + /* + * Information used by tkPack.c only. + */ + + int packInit; /* 0 means table below needs initializing. */ + Tcl_HashTable packerHashTable; + /* Maps from Tk_Window tokens to + * corresponding Packer structures. */ + + + /* + * Information used by tkPlace.c only. + */ + + int placeInit; /* 0 means tables below need initializing. */ + Tcl_HashTable masterTable; /* Maps from Tk_Window toke to the Master + * structure for the window, if it exists. */ + Tcl_HashTable slaveTable; /* Maps from Tk_Window toke to the Slave + * structure for the window, if it exists. */ + + /* + * Information used by tkSelect.c and tkClipboard.c only: + */ + + struct TkSelectionInfo *selectionInfoPtr; + /* First in list of selection information + * records. Each entry contains information + * about the current owner of a particular + * selection on this display. */ + Atom multipleAtom; /* Atom for MULTIPLE. None means + * selection stuff isn't initialized. */ + Atom incrAtom; /* Atom for INCR. */ + Atom targetsAtom; /* Atom for TARGETS. */ + Atom timestampAtom; /* Atom for TIMESTAMP. */ + Atom textAtom; /* Atom for TEXT. */ + Atom compoundTextAtom; /* Atom for COMPOUND_TEXT. */ + Atom applicationAtom; /* Atom for TK_APPLICATION. */ + Atom windowAtom; /* Atom for TK_WINDOW. */ + Atom clipboardAtom; /* Atom for CLIPBOARD. */ + + Tk_Window clipWindow; /* Window used for clipboard ownership and to + * retrieve selections between processes. NULL + * means clipboard info hasn't been + * initialized. */ + int clipboardActive; /* 1 means we currently own the clipboard + * selection, 0 means we don't. */ + struct TkMainInfo *clipboardAppPtr; + /* Last application that owned clipboard. */ + struct TkClipboardTarget *clipTargetPtr; + /* First in list of clipboard type information + * records. Each entry contains information + * about the buffers for a given selection + * target. */ + + /* + * Information used by tkSend.c only: + */ + + Tk_Window commTkwin; /* Window used for communication + * between interpreters during "send" + * commands. NULL means send info hasn't + * been initialized yet. */ + Atom commProperty; /* X's name for comm property. */ + Atom registryProperty; /* X's name for property containing + * registry of interpreter names. */ + Atom appNameProperty; /* X's name for property used to hold the + * application name on each comm window. */ + + /* * Information used by tkXId.c only: */ @@ -265,6 +444,19 @@ typedef struct TkDisplay { * hasn't. */ /* + * Information used by tkUnixWm.c and tkWinWm.c only: + */ + + int wmTracing; /* Used to enable or disable tracing in + * this module. If tracing is enabled, + * then information is printed on + * standard output about interesting + * interactions with the window manager. */ + struct TkWmInfo *firstWmPtr; /* Points to first top-level window. */ + struct TkWmInfo *foregroundWmPtr; + /* Points to the foreground window. */ + + /* * Information maintained by tkWindow.c for use later on by tkXId.c: */ @@ -285,46 +477,6 @@ typedef struct TkDisplay { * allocated for this display. */ /* - * Information used by tkFocus.c only: - */ - - struct TkWindow *implicitWinPtr; - /* If the focus arrived at a toplevel window - * implicitly via an Enter event (rather - * than via a FocusIn event), this points - * to the toplevel window. Otherwise it is - * NULL. */ - struct TkWindow *focusPtr; /* Points to the window on this display that - * should be receiving keyboard events. When - * multiple applications on the display have - * the focus, this will refer to the - * innermost window in the innermost - * application. This information isn't used - * under Unix or Windows, but it's needed on - * the Macintosh. */ - - /* - * Used by tkColor.c only: - */ - - TkStressedCmap *stressPtr; /* First in list of colormaps that have - * filled up, so we have to pick an - * approximate color. */ - - /* - * Used by tkEvent.c only: - */ - - struct TkWindowEvent *delayedMotionPtr; - /* Points to a malloc-ed motion event - * whose processing has been delayed in - * the hopes that another motion event - * will come along right away and we can - * merge the two of them together. NULL - * means that there is no delayed motion - * event. */ - - /* * Miscellaneous information: */ @@ -375,6 +527,9 @@ typedef struct TkErrorHandler { * list. */ } TkErrorHandler; + + + /* * One of the following structures exists for each event handler * created by calling Tk_CreateEventHandler. This information @@ -417,10 +572,10 @@ typedef struct TkMainInfo { /* Used in conjunction with "bind" command * to bind events to Tcl commands. */ TkBindInfo bindInfo; /* Information used by tkBind.c on a per - * interpreter basis. */ + * application basis. */ struct TkFontInfo *fontInfoPtr; - /* Hold named font tables. Used only by - * tkFont.c. */ + /* Information used by tkFont.c on a per + * application basis. */ /* * Information used only by tkFocus.c and tk*Embed.c: @@ -711,67 +866,82 @@ extern int tkSendSerial; # define TCL_STORAGE_CLASS DLLEXPORT #endif -int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp)); -void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp, - int devId, char *buffer, long size)); - /* - * For backwards compatibility, need the tkIntPlatDecls.h here for - * windows & mac X wrappers. + * Internal procedures shared among Tk modules but not exported + * to the outside world: */ +EXTERN int Tk_AfterCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tk_BindCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_ButtonCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ButtonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_CanvasCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_CheckbuttonCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_CheckbuttonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_ClipboardCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_ChooseColorCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ChooseColorObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tk_ChooseDirectoryObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tk_ChooseFontObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_DestroyCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_EntryCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_EventCmd _ANSI_ARGS_((ClientData clientData, +EXTERN int Tk_EntryObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_EventObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_FileeventCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_FrameCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_FocusCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_FocusObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_GetOpenFileObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_GetSaveFileObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_GetOpenFileCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_GetSaveFileCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_GrabCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_GridCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_ImageCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_LabelCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_LabelObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_LowerCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_MenuCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_MenubuttonCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_MessageBoxCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_MenubuttonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_MessageBoxObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_MessageCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_OptionCmd _ANSI_ARGS_((ClientData clientData, @@ -780,18 +950,23 @@ EXTERN int Tk_PackCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_RadiobuttonCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_RadiobuttonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_RaiseCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_ScaleCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ScaleObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_SendCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData, @@ -801,17 +976,26 @@ EXTERN int Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_ToplevelCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_UpdateCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_UpdateObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tk_WmCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int TkDeadAppCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); -EXTERN int TkpTestembedCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp)); +void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp, + int devId, char *buffer, long size)); + +EXTERN void TkEventInit _ANSI_ARGS_((void)); + +EXTERN int TkCreateMenuCmd _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int TkDeadAppCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + +EXTERN int TkpTestembedCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); /* * Unsupported commands. diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index fb929eb..2ca0147 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkIntDecls.h,v 1.2 1999/03/10 07:04:40 stanton Exp $ + * RCS: @(#) $Id: tkIntDecls.h,v 1.3 1999/04/16 01:51:16 stanton Exp $ */ #ifndef _TKINTDECLS @@ -127,7 +127,7 @@ EXTERN void TkFontPkgFree _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 28 */ EXTERN void TkFreeBindingTags _ANSI_ARGS_((TkWindow * winPtr)); /* 29 */ -EXTERN void TkFreeCursor _ANSI_ARGS_((TkCursor * cursorPtr)); +EXTERN void TkpFreeCursor _ANSI_ARGS_((TkCursor * cursorPtr)); /* 30 */ EXTERN char * TkGetBitmapData _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * fileName, @@ -181,11 +181,11 @@ EXTERN void TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin)); /* 46 */ EXTERN char * TkKeysymToString _ANSI_ARGS_((KeySym keysym)); /* 47 */ -EXTERN int TkLineToArea _ANSI_ARGS_((TkDouble2 end1Ptr, - TkDouble2 end2Ptr, TkDouble4 rectPtr)); +EXTERN int TkLineToArea _ANSI_ARGS_((double end1Ptr[], + double end2Ptr[], double rectPtr[])); /* 48 */ EXTERN double TkLineToPoint _ANSI_ARGS_((double end1Ptr[], - TkDouble2 end2Ptr, TkDouble2 pointPtr)); + double end2Ptr[], double pointPtr[])); /* 49 */ EXTERN int TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas, double * pointPtr, int numPoints, @@ -203,8 +203,8 @@ EXTERN void TkOptionDeadWindow _ANSI_ARGS_((TkWindow * winPtr)); EXTERN int TkOvalToArea _ANSI_ARGS_((double * ovalPtr, double * rectPtr)); /* 54 */ -EXTERN double TkOvalToPoint _ANSI_ARGS_((TkDouble4 ovalPtr, - double width, int filled, TkDouble2 pointPtr)); +EXTERN double TkOvalToPoint _ANSI_ARGS_((double ovalPtr[], + double width, int filled, double pointPtr[])); /* 55 */ EXTERN int TkpChangeFocus _ANSI_ARGS_((TkWindow * winPtr, int force)); @@ -327,6 +327,49 @@ EXTERN void TkWmRestackToplevel _ANSI_ARGS_((TkWindow * winPtr, EXTERN void TkWmSetClass _ANSI_ARGS_((TkWindow * winPtr)); /* 97 */ EXTERN void TkWmUnmapWindow _ANSI_ARGS_((TkWindow * winPtr)); +/* 98 */ +EXTERN Tcl_Obj * TkDebugBitmap _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 99 */ +EXTERN Tcl_Obj * TkDebugBorder _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 100 */ +EXTERN Tcl_Obj * TkDebugCursor _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 101 */ +EXTERN Tcl_Obj * TkDebugColor _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 102 */ +EXTERN Tcl_Obj * TkDebugConfig _ANSI_ARGS_((Tcl_Interp * interp, + Tk_OptionTable table)); +/* 103 */ +EXTERN Tcl_Obj * TkDebugFont _ANSI_ARGS_((Tk_Window tkwin, + char * name)); +/* 104 */ +EXTERN int TkFindStateNumObj _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Obj * optionPtr, + CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr)); +/* 105 */ +EXTERN Tcl_HashTable * TkGetBitmapPredefTable _ANSI_ARGS_((void)); +/* 106 */ +EXTERN TkDisplay * TkGetDisplayList _ANSI_ARGS_((void)); +/* 107 */ +EXTERN TkMainInfo * TkGetMainInfoList _ANSI_ARGS_((void)); +/* 108 */ +EXTERN int TkGetWindowFromObj _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window tkwin, Tcl_Obj * objPtr, + Tk_Window * windowPtr)); +/* 109 */ +EXTERN char * TkpGetString _ANSI_ARGS_((TkWindow * winPtr, + XEvent * eventPtr, Tcl_DString * dsPtr)); +/* 110 */ +EXTERN void TkpGetSubFonts _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Font tkfont)); +/* 111 */ +EXTERN Tcl_Obj * TkpGetSystemDefault _ANSI_ARGS_((Tk_Window tkwin, + char * dbName, char * className)); +/* 112 */ +EXTERN void TkpMenuThreadInit _ANSI_ARGS_((void)); typedef struct TkIntStubs { int magic; @@ -361,7 +404,7 @@ typedef struct TkIntStubs { void (*tkFontPkgInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 26 */ void (*tkFontPkgFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 27 */ void (*tkFreeBindingTags) _ANSI_ARGS_((TkWindow * winPtr)); /* 28 */ - void (*tkFreeCursor) _ANSI_ARGS_((TkCursor * cursorPtr)); /* 29 */ + void (*tkpFreeCursor) _ANSI_ARGS_((TkCursor * cursorPtr)); /* 29 */ char * (*tkGetBitmapData) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * fileName, int * widthPtr, int * heightPtr, int * hotXPtr, int * hotYPtr)); /* 30 */ void (*tkGetButtPoints) _ANSI_ARGS_((double p1[], double p2[], double width, int project, double m1[], double m2[])); /* 31 */ TkCursor * (*tkGetCursorByName) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid string)); /* 32 */ @@ -379,14 +422,14 @@ typedef struct TkIntStubs { void (*tkInOutEvents) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * sourcePtr, TkWindow * destPtr, int leaveType, int enterType, Tcl_QueuePosition position)); /* 44 */ void (*tkInstallFrameMenu) _ANSI_ARGS_((Tk_Window tkwin)); /* 45 */ char * (*tkKeysymToString) _ANSI_ARGS_((KeySym keysym)); /* 46 */ - int (*tkLineToArea) _ANSI_ARGS_((TkDouble2 end1Ptr, TkDouble2 end2Ptr, TkDouble4 rectPtr)); /* 47 */ - double (*tkLineToPoint) _ANSI_ARGS_((double end1Ptr[], TkDouble2 end2Ptr, TkDouble2 pointPtr)); /* 48 */ + int (*tkLineToArea) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double rectPtr[])); /* 47 */ + double (*tkLineToPoint) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double pointPtr[])); /* 48 */ int (*tkMakeBezierCurve) _ANSI_ARGS_((Tk_Canvas canvas, double * pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[])); /* 49 */ void (*tkMakeBezierPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * pointPtr, int numPoints)); /* 50 */ void (*tkOptionClassChanged) _ANSI_ARGS_((TkWindow * winPtr)); /* 51 */ void (*tkOptionDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 52 */ int (*tkOvalToArea) _ANSI_ARGS_((double * ovalPtr, double * rectPtr)); /* 53 */ - double (*tkOvalToPoint) _ANSI_ARGS_((TkDouble4 ovalPtr, double width, int filled, TkDouble2 pointPtr)); /* 54 */ + double (*tkOvalToPoint) _ANSI_ARGS_((double ovalPtr[], double width, int filled, double pointPtr[])); /* 54 */ int (*tkpChangeFocus) _ANSI_ARGS_((TkWindow * winPtr, int force)); /* 55 */ void (*tkpCloseDisplay) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 56 */ void (*tkpClaimFocus) _ANSI_ARGS_((TkWindow * topLevelPtr, int force)); /* 57 */ @@ -430,6 +473,21 @@ typedef struct TkIntStubs { void (*tkWmRestackToplevel) _ANSI_ARGS_((TkWindow * winPtr, int aboveBelow, TkWindow * otherPtr)); /* 95 */ void (*tkWmSetClass) _ANSI_ARGS_((TkWindow * winPtr)); /* 96 */ void (*tkWmUnmapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 97 */ + Tcl_Obj * (*tkDebugBitmap) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 98 */ + Tcl_Obj * (*tkDebugBorder) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 99 */ + Tcl_Obj * (*tkDebugCursor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 100 */ + Tcl_Obj * (*tkDebugColor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 101 */ + Tcl_Obj * (*tkDebugConfig) _ANSI_ARGS_((Tcl_Interp * interp, Tk_OptionTable table)); /* 102 */ + Tcl_Obj * (*tkDebugFont) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 103 */ + int (*tkFindStateNumObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * optionPtr, CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr)); /* 104 */ + Tcl_HashTable * (*tkGetBitmapPredefTable) _ANSI_ARGS_((void)); /* 105 */ + TkDisplay * (*tkGetDisplayList) _ANSI_ARGS_((void)); /* 106 */ + TkMainInfo * (*tkGetMainInfoList) _ANSI_ARGS_((void)); /* 107 */ + int (*tkGetWindowFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, Tk_Window * windowPtr)); /* 108 */ + char * (*tkpGetString) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr, Tcl_DString * dsPtr)); /* 109 */ + void (*tkpGetSubFonts) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Font tkfont)); /* 110 */ + Tcl_Obj * (*tkpGetSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, char * dbName, char * className)); /* 111 */ + void (*tkpMenuThreadInit) _ANSI_ARGS_((void)); /* 112 */ } TkIntStubs; extern TkIntStubs *tkIntStubsPtr; @@ -441,396 +499,456 @@ extern TkIntStubs *tkIntStubsPtr; */ #ifndef TkAllocWindow -#define TkAllocWindow(dispPtr, screenNum, parentPtr) \ - (tkIntStubsPtr->tkAllocWindow)(dispPtr, screenNum, parentPtr) /* 0 */ +#define TkAllocWindow \ + (tkIntStubsPtr->tkAllocWindow) /* 0 */ #endif #ifndef TkBezierPoints -#define TkBezierPoints(control, numSteps, coordPtr) \ - (tkIntStubsPtr->tkBezierPoints)(control, numSteps, coordPtr) /* 1 */ +#define TkBezierPoints \ + (tkIntStubsPtr->tkBezierPoints) /* 1 */ #endif #ifndef TkBezierScreenPoints -#define TkBezierScreenPoints(canvas, control, numSteps, xPointPtr) \ - (tkIntStubsPtr->tkBezierScreenPoints)(canvas, control, numSteps, xPointPtr) /* 2 */ +#define TkBezierScreenPoints \ + (tkIntStubsPtr->tkBezierScreenPoints) /* 2 */ #endif #ifndef TkBindDeadWindow -#define TkBindDeadWindow(winPtr) \ - (tkIntStubsPtr->tkBindDeadWindow)(winPtr) /* 3 */ +#define TkBindDeadWindow \ + (tkIntStubsPtr->tkBindDeadWindow) /* 3 */ #endif #ifndef TkBindEventProc -#define TkBindEventProc(winPtr, eventPtr) \ - (tkIntStubsPtr->tkBindEventProc)(winPtr, eventPtr) /* 4 */ +#define TkBindEventProc \ + (tkIntStubsPtr->tkBindEventProc) /* 4 */ #endif #ifndef TkBindFree -#define TkBindFree(mainPtr) \ - (tkIntStubsPtr->tkBindFree)(mainPtr) /* 5 */ +#define TkBindFree \ + (tkIntStubsPtr->tkBindFree) /* 5 */ #endif #ifndef TkBindInit -#define TkBindInit(mainPtr) \ - (tkIntStubsPtr->tkBindInit)(mainPtr) /* 6 */ +#define TkBindInit \ + (tkIntStubsPtr->tkBindInit) /* 6 */ #endif #ifndef TkChangeEventWindow -#define TkChangeEventWindow(eventPtr, winPtr) \ - (tkIntStubsPtr->tkChangeEventWindow)(eventPtr, winPtr) /* 7 */ +#define TkChangeEventWindow \ + (tkIntStubsPtr->tkChangeEventWindow) /* 7 */ #endif #ifndef TkClipInit -#define TkClipInit(interp, dispPtr) \ - (tkIntStubsPtr->tkClipInit)(interp, dispPtr) /* 8 */ +#define TkClipInit \ + (tkIntStubsPtr->tkClipInit) /* 8 */ #endif #ifndef TkComputeAnchor -#define TkComputeAnchor(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr) \ - (tkIntStubsPtr->tkComputeAnchor)(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr) /* 9 */ +#define TkComputeAnchor \ + (tkIntStubsPtr->tkComputeAnchor) /* 9 */ #endif #ifndef TkCopyAndGlobalEval -#define TkCopyAndGlobalEval(interp, script) \ - (tkIntStubsPtr->tkCopyAndGlobalEval)(interp, script) /* 10 */ +#define TkCopyAndGlobalEval \ + (tkIntStubsPtr->tkCopyAndGlobalEval) /* 10 */ #endif #ifndef TkCreateBindingProcedure -#define TkCreateBindingProcedure(interp, bindingTable, object, eventString, evalProc, freeProc, clientData) \ - (tkIntStubsPtr->tkCreateBindingProcedure)(interp, bindingTable, object, eventString, evalProc, freeProc, clientData) /* 11 */ +#define TkCreateBindingProcedure \ + (tkIntStubsPtr->tkCreateBindingProcedure) /* 11 */ #endif #ifndef TkCreateCursorFromData -#define TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot, fg, bg) \ - (tkIntStubsPtr->tkCreateCursorFromData)(tkwin, source, mask, width, height, xHot, yHot, fg, bg) /* 12 */ +#define TkCreateCursorFromData \ + (tkIntStubsPtr->tkCreateCursorFromData) /* 12 */ #endif #ifndef TkCreateFrame -#define TkCreateFrame(clientData, interp, argc, argv, toplevel, appName) \ - (tkIntStubsPtr->tkCreateFrame)(clientData, interp, argc, argv, toplevel, appName) /* 13 */ +#define TkCreateFrame \ + (tkIntStubsPtr->tkCreateFrame) /* 13 */ #endif #ifndef TkCreateMainWindow -#define TkCreateMainWindow(interp, screenName, baseName) \ - (tkIntStubsPtr->tkCreateMainWindow)(interp, screenName, baseName) /* 14 */ +#define TkCreateMainWindow \ + (tkIntStubsPtr->tkCreateMainWindow) /* 14 */ #endif #ifndef TkCurrentTime -#define TkCurrentTime(dispPtr) \ - (tkIntStubsPtr->tkCurrentTime)(dispPtr) /* 15 */ +#define TkCurrentTime \ + (tkIntStubsPtr->tkCurrentTime) /* 15 */ #endif #ifndef TkDeleteAllImages -#define TkDeleteAllImages(mainPtr) \ - (tkIntStubsPtr->tkDeleteAllImages)(mainPtr) /* 16 */ +#define TkDeleteAllImages \ + (tkIntStubsPtr->tkDeleteAllImages) /* 16 */ #endif #ifndef TkDoConfigureNotify -#define TkDoConfigureNotify(winPtr) \ - (tkIntStubsPtr->tkDoConfigureNotify)(winPtr) /* 17 */ +#define TkDoConfigureNotify \ + (tkIntStubsPtr->tkDoConfigureNotify) /* 17 */ #endif #ifndef TkDrawInsetFocusHighlight -#define TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding) \ - (tkIntStubsPtr->tkDrawInsetFocusHighlight)(tkwin, gc, width, drawable, padding) /* 18 */ +#define TkDrawInsetFocusHighlight \ + (tkIntStubsPtr->tkDrawInsetFocusHighlight) /* 18 */ #endif #ifndef TkEventDeadWindow -#define TkEventDeadWindow(winPtr) \ - (tkIntStubsPtr->tkEventDeadWindow)(winPtr) /* 19 */ +#define TkEventDeadWindow \ + (tkIntStubsPtr->tkEventDeadWindow) /* 19 */ #endif #ifndef TkFillPolygon -#define TkFillPolygon(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC) \ - (tkIntStubsPtr->tkFillPolygon)(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC) /* 20 */ +#define TkFillPolygon \ + (tkIntStubsPtr->tkFillPolygon) /* 20 */ #endif #ifndef TkFindStateNum -#define TkFindStateNum(interp, option, mapPtr, strKey) \ - (tkIntStubsPtr->tkFindStateNum)(interp, option, mapPtr, strKey) /* 21 */ +#define TkFindStateNum \ + (tkIntStubsPtr->tkFindStateNum) /* 21 */ #endif #ifndef TkFindStateString -#define TkFindStateString(mapPtr, numKey) \ - (tkIntStubsPtr->tkFindStateString)(mapPtr, numKey) /* 22 */ +#define TkFindStateString \ + (tkIntStubsPtr->tkFindStateString) /* 22 */ #endif #ifndef TkFocusDeadWindow -#define TkFocusDeadWindow(winPtr) \ - (tkIntStubsPtr->tkFocusDeadWindow)(winPtr) /* 23 */ +#define TkFocusDeadWindow \ + (tkIntStubsPtr->tkFocusDeadWindow) /* 23 */ #endif #ifndef TkFocusFilterEvent -#define TkFocusFilterEvent(winPtr, eventPtr) \ - (tkIntStubsPtr->tkFocusFilterEvent)(winPtr, eventPtr) /* 24 */ +#define TkFocusFilterEvent \ + (tkIntStubsPtr->tkFocusFilterEvent) /* 24 */ #endif #ifndef TkFocusKeyEvent -#define TkFocusKeyEvent(winPtr, eventPtr) \ - (tkIntStubsPtr->tkFocusKeyEvent)(winPtr, eventPtr) /* 25 */ +#define TkFocusKeyEvent \ + (tkIntStubsPtr->tkFocusKeyEvent) /* 25 */ #endif #ifndef TkFontPkgInit -#define TkFontPkgInit(mainPtr) \ - (tkIntStubsPtr->tkFontPkgInit)(mainPtr) /* 26 */ +#define TkFontPkgInit \ + (tkIntStubsPtr->tkFontPkgInit) /* 26 */ #endif #ifndef TkFontPkgFree -#define TkFontPkgFree(mainPtr) \ - (tkIntStubsPtr->tkFontPkgFree)(mainPtr) /* 27 */ +#define TkFontPkgFree \ + (tkIntStubsPtr->tkFontPkgFree) /* 27 */ #endif #ifndef TkFreeBindingTags -#define TkFreeBindingTags(winPtr) \ - (tkIntStubsPtr->tkFreeBindingTags)(winPtr) /* 28 */ +#define TkFreeBindingTags \ + (tkIntStubsPtr->tkFreeBindingTags) /* 28 */ #endif -#ifndef TkFreeCursor -#define TkFreeCursor(cursorPtr) \ - (tkIntStubsPtr->tkFreeCursor)(cursorPtr) /* 29 */ +#ifndef TkpFreeCursor +#define TkpFreeCursor \ + (tkIntStubsPtr->tkpFreeCursor) /* 29 */ #endif #ifndef TkGetBitmapData -#define TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr, hotXPtr, hotYPtr) \ - (tkIntStubsPtr->tkGetBitmapData)(interp, string, fileName, widthPtr, heightPtr, hotXPtr, hotYPtr) /* 30 */ +#define TkGetBitmapData \ + (tkIntStubsPtr->tkGetBitmapData) /* 30 */ #endif #ifndef TkGetButtPoints -#define TkGetButtPoints(p1, p2, width, project, m1, m2) \ - (tkIntStubsPtr->tkGetButtPoints)(p1, p2, width, project, m1, m2) /* 31 */ +#define TkGetButtPoints \ + (tkIntStubsPtr->tkGetButtPoints) /* 31 */ #endif #ifndef TkGetCursorByName -#define TkGetCursorByName(interp, tkwin, string) \ - (tkIntStubsPtr->tkGetCursorByName)(interp, tkwin, string) /* 32 */ +#define TkGetCursorByName \ + (tkIntStubsPtr->tkGetCursorByName) /* 32 */ #endif #ifndef TkGetDefaultScreenName -#define TkGetDefaultScreenName(interp, screenName) \ - (tkIntStubsPtr->tkGetDefaultScreenName)(interp, screenName) /* 33 */ +#define TkGetDefaultScreenName \ + (tkIntStubsPtr->tkGetDefaultScreenName) /* 33 */ #endif #ifndef TkGetDisplay -#define TkGetDisplay(display) \ - (tkIntStubsPtr->tkGetDisplay)(display) /* 34 */ +#define TkGetDisplay \ + (tkIntStubsPtr->tkGetDisplay) /* 34 */ #endif #ifndef TkGetDisplayOf -#define TkGetDisplayOf(interp, objc, objv, tkwinPtr) \ - (tkIntStubsPtr->tkGetDisplayOf)(interp, objc, objv, tkwinPtr) /* 35 */ +#define TkGetDisplayOf \ + (tkIntStubsPtr->tkGetDisplayOf) /* 35 */ #endif #ifndef TkGetFocusWin -#define TkGetFocusWin(winPtr) \ - (tkIntStubsPtr->tkGetFocusWin)(winPtr) /* 36 */ +#define TkGetFocusWin \ + (tkIntStubsPtr->tkGetFocusWin) /* 36 */ #endif #ifndef TkGetInterpNames -#define TkGetInterpNames(interp, tkwin) \ - (tkIntStubsPtr->tkGetInterpNames)(interp, tkwin) /* 37 */ +#define TkGetInterpNames \ + (tkIntStubsPtr->tkGetInterpNames) /* 37 */ #endif #ifndef TkGetMiterPoints -#define TkGetMiterPoints(p1, p2, p3, width, m1, m2) \ - (tkIntStubsPtr->tkGetMiterPoints)(p1, p2, p3, width, m1, m2) /* 38 */ +#define TkGetMiterPoints \ + (tkIntStubsPtr->tkGetMiterPoints) /* 38 */ #endif #ifndef TkGetPointerCoords -#define TkGetPointerCoords(tkwin, xPtr, yPtr) \ - (tkIntStubsPtr->tkGetPointerCoords)(tkwin, xPtr, yPtr) /* 39 */ +#define TkGetPointerCoords \ + (tkIntStubsPtr->tkGetPointerCoords) /* 39 */ #endif #ifndef TkGetServerInfo -#define TkGetServerInfo(interp, tkwin) \ - (tkIntStubsPtr->tkGetServerInfo)(interp, tkwin) /* 40 */ +#define TkGetServerInfo \ + (tkIntStubsPtr->tkGetServerInfo) /* 40 */ #endif #ifndef TkGrabDeadWindow -#define TkGrabDeadWindow(winPtr) \ - (tkIntStubsPtr->tkGrabDeadWindow)(winPtr) /* 41 */ +#define TkGrabDeadWindow \ + (tkIntStubsPtr->tkGrabDeadWindow) /* 41 */ #endif #ifndef TkGrabState -#define TkGrabState(winPtr) \ - (tkIntStubsPtr->tkGrabState)(winPtr) /* 42 */ +#define TkGrabState \ + (tkIntStubsPtr->tkGrabState) /* 42 */ #endif #ifndef TkIncludePoint -#define TkIncludePoint(itemPtr, pointPtr) \ - (tkIntStubsPtr->tkIncludePoint)(itemPtr, pointPtr) /* 43 */ +#define TkIncludePoint \ + (tkIntStubsPtr->tkIncludePoint) /* 43 */ #endif #ifndef TkInOutEvents -#define TkInOutEvents(eventPtr, sourcePtr, destPtr, leaveType, enterType, position) \ - (tkIntStubsPtr->tkInOutEvents)(eventPtr, sourcePtr, destPtr, leaveType, enterType, position) /* 44 */ +#define TkInOutEvents \ + (tkIntStubsPtr->tkInOutEvents) /* 44 */ #endif #ifndef TkInstallFrameMenu -#define TkInstallFrameMenu(tkwin) \ - (tkIntStubsPtr->tkInstallFrameMenu)(tkwin) /* 45 */ +#define TkInstallFrameMenu \ + (tkIntStubsPtr->tkInstallFrameMenu) /* 45 */ #endif #ifndef TkKeysymToString -#define TkKeysymToString(keysym) \ - (tkIntStubsPtr->tkKeysymToString)(keysym) /* 46 */ +#define TkKeysymToString \ + (tkIntStubsPtr->tkKeysymToString) /* 46 */ #endif #ifndef TkLineToArea -#define TkLineToArea(end1Ptr, end2Ptr, rectPtr) \ - (tkIntStubsPtr->tkLineToArea)(end1Ptr, end2Ptr, rectPtr) /* 47 */ +#define TkLineToArea \ + (tkIntStubsPtr->tkLineToArea) /* 47 */ #endif #ifndef TkLineToPoint -#define TkLineToPoint(end1Ptr, end2Ptr, pointPtr) \ - (tkIntStubsPtr->tkLineToPoint)(end1Ptr, end2Ptr, pointPtr) /* 48 */ +#define TkLineToPoint \ + (tkIntStubsPtr->tkLineToPoint) /* 48 */ #endif #ifndef TkMakeBezierCurve -#define TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints) \ - (tkIntStubsPtr->tkMakeBezierCurve)(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints) /* 49 */ +#define TkMakeBezierCurve \ + (tkIntStubsPtr->tkMakeBezierCurve) /* 49 */ #endif #ifndef TkMakeBezierPostscript -#define TkMakeBezierPostscript(interp, canvas, pointPtr, numPoints) \ - (tkIntStubsPtr->tkMakeBezierPostscript)(interp, canvas, pointPtr, numPoints) /* 50 */ +#define TkMakeBezierPostscript \ + (tkIntStubsPtr->tkMakeBezierPostscript) /* 50 */ #endif #ifndef TkOptionClassChanged -#define TkOptionClassChanged(winPtr) \ - (tkIntStubsPtr->tkOptionClassChanged)(winPtr) /* 51 */ +#define TkOptionClassChanged \ + (tkIntStubsPtr->tkOptionClassChanged) /* 51 */ #endif #ifndef TkOptionDeadWindow -#define TkOptionDeadWindow(winPtr) \ - (tkIntStubsPtr->tkOptionDeadWindow)(winPtr) /* 52 */ +#define TkOptionDeadWindow \ + (tkIntStubsPtr->tkOptionDeadWindow) /* 52 */ #endif #ifndef TkOvalToArea -#define TkOvalToArea(ovalPtr, rectPtr) \ - (tkIntStubsPtr->tkOvalToArea)(ovalPtr, rectPtr) /* 53 */ +#define TkOvalToArea \ + (tkIntStubsPtr->tkOvalToArea) /* 53 */ #endif #ifndef TkOvalToPoint -#define TkOvalToPoint(ovalPtr, width, filled, pointPtr) \ - (tkIntStubsPtr->tkOvalToPoint)(ovalPtr, width, filled, pointPtr) /* 54 */ +#define TkOvalToPoint \ + (tkIntStubsPtr->tkOvalToPoint) /* 54 */ #endif #ifndef TkpChangeFocus -#define TkpChangeFocus(winPtr, force) \ - (tkIntStubsPtr->tkpChangeFocus)(winPtr, force) /* 55 */ +#define TkpChangeFocus \ + (tkIntStubsPtr->tkpChangeFocus) /* 55 */ #endif #ifndef TkpCloseDisplay -#define TkpCloseDisplay(dispPtr) \ - (tkIntStubsPtr->tkpCloseDisplay)(dispPtr) /* 56 */ +#define TkpCloseDisplay \ + (tkIntStubsPtr->tkpCloseDisplay) /* 56 */ #endif #ifndef TkpClaimFocus -#define TkpClaimFocus(topLevelPtr, force) \ - (tkIntStubsPtr->tkpClaimFocus)(topLevelPtr, force) /* 57 */ +#define TkpClaimFocus \ + (tkIntStubsPtr->tkpClaimFocus) /* 57 */ #endif #ifndef TkpDisplayWarning -#define TkpDisplayWarning(msg, title) \ - (tkIntStubsPtr->tkpDisplayWarning)(msg, title) /* 58 */ +#define TkpDisplayWarning \ + (tkIntStubsPtr->tkpDisplayWarning) /* 58 */ #endif #ifndef TkpGetAppName -#define TkpGetAppName(interp, name) \ - (tkIntStubsPtr->tkpGetAppName)(interp, name) /* 59 */ +#define TkpGetAppName \ + (tkIntStubsPtr->tkpGetAppName) /* 59 */ #endif #ifndef TkpGetOtherWindow -#define TkpGetOtherWindow(winPtr) \ - (tkIntStubsPtr->tkpGetOtherWindow)(winPtr) /* 60 */ +#define TkpGetOtherWindow \ + (tkIntStubsPtr->tkpGetOtherWindow) /* 60 */ #endif #ifndef TkpGetWrapperWindow -#define TkpGetWrapperWindow(winPtr) \ - (tkIntStubsPtr->tkpGetWrapperWindow)(winPtr) /* 61 */ +#define TkpGetWrapperWindow \ + (tkIntStubsPtr->tkpGetWrapperWindow) /* 61 */ #endif #ifndef TkpInit -#define TkpInit(interp) \ - (tkIntStubsPtr->tkpInit)(interp) /* 62 */ +#define TkpInit \ + (tkIntStubsPtr->tkpInit) /* 62 */ #endif #ifndef TkpInitializeMenuBindings -#define TkpInitializeMenuBindings(interp, bindingTable) \ - (tkIntStubsPtr->tkpInitializeMenuBindings)(interp, bindingTable) /* 63 */ +#define TkpInitializeMenuBindings \ + (tkIntStubsPtr->tkpInitializeMenuBindings) /* 63 */ #endif #ifndef TkpMakeContainer -#define TkpMakeContainer(tkwin) \ - (tkIntStubsPtr->tkpMakeContainer)(tkwin) /* 64 */ +#define TkpMakeContainer \ + (tkIntStubsPtr->tkpMakeContainer) /* 64 */ #endif #ifndef TkpMakeMenuWindow -#define TkpMakeMenuWindow(tkwin, transient) \ - (tkIntStubsPtr->tkpMakeMenuWindow)(tkwin, transient) /* 65 */ +#define TkpMakeMenuWindow \ + (tkIntStubsPtr->tkpMakeMenuWindow) /* 65 */ #endif #ifndef TkpMakeWindow -#define TkpMakeWindow(winPtr, parent) \ - (tkIntStubsPtr->tkpMakeWindow)(winPtr, parent) /* 66 */ +#define TkpMakeWindow \ + (tkIntStubsPtr->tkpMakeWindow) /* 66 */ #endif #ifndef TkpMenuNotifyToplevelCreate -#define TkpMenuNotifyToplevelCreate(interp1, menuName) \ - (tkIntStubsPtr->tkpMenuNotifyToplevelCreate)(interp1, menuName) /* 67 */ +#define TkpMenuNotifyToplevelCreate \ + (tkIntStubsPtr->tkpMenuNotifyToplevelCreate) /* 67 */ #endif #ifndef TkpOpenDisplay -#define TkpOpenDisplay(display_name) \ - (tkIntStubsPtr->tkpOpenDisplay)(display_name) /* 68 */ +#define TkpOpenDisplay \ + (tkIntStubsPtr->tkpOpenDisplay) /* 68 */ #endif #ifndef TkPointerEvent -#define TkPointerEvent(eventPtr, winPtr) \ - (tkIntStubsPtr->tkPointerEvent)(eventPtr, winPtr) /* 69 */ +#define TkPointerEvent \ + (tkIntStubsPtr->tkPointerEvent) /* 69 */ #endif #ifndef TkPolygonToArea -#define TkPolygonToArea(polyPtr, numPoints, rectPtr) \ - (tkIntStubsPtr->tkPolygonToArea)(polyPtr, numPoints, rectPtr) /* 70 */ +#define TkPolygonToArea \ + (tkIntStubsPtr->tkPolygonToArea) /* 70 */ #endif #ifndef TkPolygonToPoint -#define TkPolygonToPoint(polyPtr, numPoints, pointPtr) \ - (tkIntStubsPtr->tkPolygonToPoint)(polyPtr, numPoints, pointPtr) /* 71 */ +#define TkPolygonToPoint \ + (tkIntStubsPtr->tkPolygonToPoint) /* 71 */ #endif #ifndef TkPositionInTree -#define TkPositionInTree(winPtr, treePtr) \ - (tkIntStubsPtr->tkPositionInTree)(winPtr, treePtr) /* 72 */ +#define TkPositionInTree \ + (tkIntStubsPtr->tkPositionInTree) /* 72 */ #endif #ifndef TkpRedirectKeyEvent -#define TkpRedirectKeyEvent(winPtr, eventPtr) \ - (tkIntStubsPtr->tkpRedirectKeyEvent)(winPtr, eventPtr) /* 73 */ +#define TkpRedirectKeyEvent \ + (tkIntStubsPtr->tkpRedirectKeyEvent) /* 73 */ #endif #ifndef TkpSetMainMenubar -#define TkpSetMainMenubar(interp, tkwin, menuName) \ - (tkIntStubsPtr->tkpSetMainMenubar)(interp, tkwin, menuName) /* 74 */ +#define TkpSetMainMenubar \ + (tkIntStubsPtr->tkpSetMainMenubar) /* 74 */ #endif #ifndef TkpUseWindow -#define TkpUseWindow(interp, tkwin, string) \ - (tkIntStubsPtr->tkpUseWindow)(interp, tkwin, string) /* 75 */ +#define TkpUseWindow \ + (tkIntStubsPtr->tkpUseWindow) /* 75 */ #endif #ifndef TkpWindowWasRecentlyDeleted -#define TkpWindowWasRecentlyDeleted(win, dispPtr) \ - (tkIntStubsPtr->tkpWindowWasRecentlyDeleted)(win, dispPtr) /* 76 */ +#define TkpWindowWasRecentlyDeleted \ + (tkIntStubsPtr->tkpWindowWasRecentlyDeleted) /* 76 */ #endif #ifndef TkQueueEventForAllChildren -#define TkQueueEventForAllChildren(winPtr, eventPtr) \ - (tkIntStubsPtr->tkQueueEventForAllChildren)(winPtr, eventPtr) /* 77 */ +#define TkQueueEventForAllChildren \ + (tkIntStubsPtr->tkQueueEventForAllChildren) /* 77 */ #endif #ifndef TkReadBitmapFile -#define TkReadBitmapFile(display, d, filename, width_return, height_return, bitmap_return, x_hot_return, y_hot_return) \ - (tkIntStubsPtr->tkReadBitmapFile)(display, d, filename, width_return, height_return, bitmap_return, x_hot_return, y_hot_return) /* 78 */ +#define TkReadBitmapFile \ + (tkIntStubsPtr->tkReadBitmapFile) /* 78 */ #endif #ifndef TkScrollWindow -#define TkScrollWindow(tkwin, gc, x, y, width, height, dx, dy, damageRgn) \ - (tkIntStubsPtr->tkScrollWindow)(tkwin, gc, x, y, width, height, dx, dy, damageRgn) /* 79 */ +#define TkScrollWindow \ + (tkIntStubsPtr->tkScrollWindow) /* 79 */ #endif #ifndef TkSelDeadWindow -#define TkSelDeadWindow(winPtr) \ - (tkIntStubsPtr->tkSelDeadWindow)(winPtr) /* 80 */ +#define TkSelDeadWindow \ + (tkIntStubsPtr->tkSelDeadWindow) /* 80 */ #endif #ifndef TkSelEventProc -#define TkSelEventProc(tkwin, eventPtr) \ - (tkIntStubsPtr->tkSelEventProc)(tkwin, eventPtr) /* 81 */ +#define TkSelEventProc \ + (tkIntStubsPtr->tkSelEventProc) /* 81 */ #endif #ifndef TkSelInit -#define TkSelInit(tkwin) \ - (tkIntStubsPtr->tkSelInit)(tkwin) /* 82 */ +#define TkSelInit \ + (tkIntStubsPtr->tkSelInit) /* 82 */ #endif #ifndef TkSelPropProc -#define TkSelPropProc(eventPtr) \ - (tkIntStubsPtr->tkSelPropProc)(eventPtr) /* 83 */ +#define TkSelPropProc \ + (tkIntStubsPtr->tkSelPropProc) /* 83 */ #endif #ifndef TkSetClassProcs -#define TkSetClassProcs(tkwin, procs, instanceData) \ - (tkIntStubsPtr->tkSetClassProcs)(tkwin, procs, instanceData) /* 84 */ +#define TkSetClassProcs \ + (tkIntStubsPtr->tkSetClassProcs) /* 84 */ #endif #ifndef TkSetWindowMenuBar -#define TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName) \ - (tkIntStubsPtr->tkSetWindowMenuBar)(interp, tkwin, oldMenuName, menuName) /* 85 */ +#define TkSetWindowMenuBar \ + (tkIntStubsPtr->tkSetWindowMenuBar) /* 85 */ #endif #ifndef TkStringToKeysym -#define TkStringToKeysym(name) \ - (tkIntStubsPtr->tkStringToKeysym)(name) /* 86 */ +#define TkStringToKeysym \ + (tkIntStubsPtr->tkStringToKeysym) /* 86 */ #endif #ifndef TkThickPolyLineToArea -#define TkThickPolyLineToArea(coordPtr, numPoints, width, capStyle, joinStyle, rectPtr) \ - (tkIntStubsPtr->tkThickPolyLineToArea)(coordPtr, numPoints, width, capStyle, joinStyle, rectPtr) /* 87 */ +#define TkThickPolyLineToArea \ + (tkIntStubsPtr->tkThickPolyLineToArea) /* 87 */ #endif #ifndef TkWmAddToColormapWindows -#define TkWmAddToColormapWindows(winPtr) \ - (tkIntStubsPtr->tkWmAddToColormapWindows)(winPtr) /* 88 */ +#define TkWmAddToColormapWindows \ + (tkIntStubsPtr->tkWmAddToColormapWindows) /* 88 */ #endif #ifndef TkWmDeadWindow -#define TkWmDeadWindow(winPtr) \ - (tkIntStubsPtr->tkWmDeadWindow)(winPtr) /* 89 */ +#define TkWmDeadWindow \ + (tkIntStubsPtr->tkWmDeadWindow) /* 89 */ #endif #ifndef TkWmFocusToplevel -#define TkWmFocusToplevel(winPtr) \ - (tkIntStubsPtr->tkWmFocusToplevel)(winPtr) /* 90 */ +#define TkWmFocusToplevel \ + (tkIntStubsPtr->tkWmFocusToplevel) /* 90 */ #endif #ifndef TkWmMapWindow -#define TkWmMapWindow(winPtr) \ - (tkIntStubsPtr->tkWmMapWindow)(winPtr) /* 91 */ +#define TkWmMapWindow \ + (tkIntStubsPtr->tkWmMapWindow) /* 91 */ #endif #ifndef TkWmNewWindow -#define TkWmNewWindow(winPtr) \ - (tkIntStubsPtr->tkWmNewWindow)(winPtr) /* 92 */ +#define TkWmNewWindow \ + (tkIntStubsPtr->tkWmNewWindow) /* 92 */ #endif #ifndef TkWmProtocolEventProc -#define TkWmProtocolEventProc(winPtr, evenvPtr) \ - (tkIntStubsPtr->tkWmProtocolEventProc)(winPtr, evenvPtr) /* 93 */ +#define TkWmProtocolEventProc \ + (tkIntStubsPtr->tkWmProtocolEventProc) /* 93 */ #endif #ifndef TkWmRemoveFromColormapWindows -#define TkWmRemoveFromColormapWindows(winPtr) \ - (tkIntStubsPtr->tkWmRemoveFromColormapWindows)(winPtr) /* 94 */ +#define TkWmRemoveFromColormapWindows \ + (tkIntStubsPtr->tkWmRemoveFromColormapWindows) /* 94 */ #endif #ifndef TkWmRestackToplevel -#define TkWmRestackToplevel(winPtr, aboveBelow, otherPtr) \ - (tkIntStubsPtr->tkWmRestackToplevel)(winPtr, aboveBelow, otherPtr) /* 95 */ +#define TkWmRestackToplevel \ + (tkIntStubsPtr->tkWmRestackToplevel) /* 95 */ #endif #ifndef TkWmSetClass -#define TkWmSetClass(winPtr) \ - (tkIntStubsPtr->tkWmSetClass)(winPtr) /* 96 */ +#define TkWmSetClass \ + (tkIntStubsPtr->tkWmSetClass) /* 96 */ #endif #ifndef TkWmUnmapWindow -#define TkWmUnmapWindow(winPtr) \ - (tkIntStubsPtr->tkWmUnmapWindow)(winPtr) /* 97 */ +#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 #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ diff --git a/generic/tkIntPlatDecls.h b/generic/tkIntPlatDecls.h index a36f7d3..a767f68 100644 --- a/generic/tkIntPlatDecls.h +++ b/generic/tkIntPlatDecls.h @@ -9,7 +9,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tkIntPlatDecls.h,v 1.2 1999/03/10 07:04:40 stanton Exp $ + * RCS: @(#) $Id: tkIntPlatDecls.h,v 1.3 1999/04/16 01:51:16 stanton Exp $ */ #ifndef _TKINTPLATDECLS @@ -150,6 +150,17 @@ EXTERN void TkWinWmCleanup _ANSI_ARGS_((HINSTANCE hInstance)); EXTERN void TkWinXCleanup _ANSI_ARGS_((HINSTANCE hInstance)); /* 35 */ EXTERN void TkWinXInit _ANSI_ARGS_((HINSTANCE hInstance)); +/* 36 */ +EXTERN void TkWinSetForegroundWindow _ANSI_ARGS_(( + TkWindow * winPtr)); +/* 37 */ +EXTERN void TkWinDialogDebug _ANSI_ARGS_((int debug)); +/* 38 */ +EXTERN Tcl_Obj * TkWinGetMenuSystemDefault _ANSI_ARGS_(( + Tk_Window tkwin, char * dbName, + char * className)); +/* 39 */ +EXTERN int TkWinGetPlatformId _ANSI_ARGS_((void)); #endif /* __WIN32__ */ #ifdef MAC_TCL /* 0 */ @@ -389,6 +400,10 @@ typedef struct TkIntPlatStubs { void (*tkWinWmCleanup) _ANSI_ARGS_((HINSTANCE hInstance)); /* 33 */ void (*tkWinXCleanup) _ANSI_ARGS_((HINSTANCE hInstance)); /* 34 */ void (*tkWinXInit) _ANSI_ARGS_((HINSTANCE hInstance)); /* 35 */ + void (*tkWinSetForegroundWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 36 */ + void (*tkWinDialogDebug) _ANSI_ARGS_((int debug)); /* 37 */ + Tcl_Obj * (*tkWinGetMenuSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, char * dbName, char * className)); /* 38 */ + int (*tkWinGetPlatformId) _ANSI_ARGS_((void)); /* 39 */ #endif /* __WIN32__ */ #ifdef MAC_TCL void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 0 */ @@ -476,472 +491,488 @@ extern TkIntPlatStubs *tkIntPlatStubsPtr; #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ #ifndef TkCreateXEventSource -#define TkCreateXEventSource() \ - (tkIntPlatStubsPtr->tkCreateXEventSource)() /* 0 */ +#define TkCreateXEventSource \ + (tkIntPlatStubsPtr->tkCreateXEventSource) /* 0 */ #endif #ifndef TkFreeWindowId -#define TkFreeWindowId(dispPtr, w) \ - (tkIntPlatStubsPtr->tkFreeWindowId)(dispPtr, w) /* 1 */ +#define TkFreeWindowId \ + (tkIntPlatStubsPtr->tkFreeWindowId) /* 1 */ #endif #ifndef TkInitXId -#define TkInitXId(dispPtr) \ - (tkIntPlatStubsPtr->tkInitXId)(dispPtr) /* 2 */ +#define TkInitXId \ + (tkIntPlatStubsPtr->tkInitXId) /* 2 */ #endif #ifndef TkpCmapStressed -#define TkpCmapStressed(tkwin, colormap) \ - (tkIntPlatStubsPtr->tkpCmapStressed)(tkwin, colormap) /* 3 */ +#define TkpCmapStressed \ + (tkIntPlatStubsPtr->tkpCmapStressed) /* 3 */ #endif #ifndef TkpSync -#define TkpSync(display) \ - (tkIntPlatStubsPtr->tkpSync)(display) /* 4 */ +#define TkpSync \ + (tkIntPlatStubsPtr->tkpSync) /* 4 */ #endif #ifndef TkUnixContainerId -#define TkUnixContainerId(winPtr) \ - (tkIntPlatStubsPtr->tkUnixContainerId)(winPtr) /* 5 */ +#define TkUnixContainerId \ + (tkIntPlatStubsPtr->tkUnixContainerId) /* 5 */ #endif #ifndef TkUnixDoOneXEvent -#define TkUnixDoOneXEvent(timePtr) \ - (tkIntPlatStubsPtr->tkUnixDoOneXEvent)(timePtr) /* 6 */ +#define TkUnixDoOneXEvent \ + (tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 6 */ #endif #ifndef TkUnixSetMenubar -#define TkUnixSetMenubar(tkwin, menubar) \ - (tkIntPlatStubsPtr->tkUnixSetMenubar)(tkwin, menubar) /* 7 */ +#define TkUnixSetMenubar \ + (tkIntPlatStubsPtr->tkUnixSetMenubar) /* 7 */ #endif #endif /* UNIX */ #ifdef __WIN32__ #ifndef TkAlignImageData -#define TkAlignImageData(image, alignment, bitOrder) \ - (tkIntPlatStubsPtr->tkAlignImageData)(image, alignment, bitOrder) /* 0 */ +#define TkAlignImageData \ + (tkIntPlatStubsPtr->tkAlignImageData) /* 0 */ #endif #ifndef TkClipBox -#define TkClipBox(rgn, rect_return) \ - (tkIntPlatStubsPtr->tkClipBox)(rgn, rect_return) /* 1 */ +#define TkClipBox \ + (tkIntPlatStubsPtr->tkClipBox) /* 1 */ #endif #ifndef TkCreateRegion -#define TkCreateRegion() \ - (tkIntPlatStubsPtr->tkCreateRegion)() /* 2 */ +#define TkCreateRegion \ + (tkIntPlatStubsPtr->tkCreateRegion) /* 2 */ #endif #ifndef TkDestroyRegion -#define TkDestroyRegion(rgn) \ - (tkIntPlatStubsPtr->tkDestroyRegion)(rgn) /* 3 */ +#define TkDestroyRegion \ + (tkIntPlatStubsPtr->tkDestroyRegion) /* 3 */ #endif #ifndef TkGenerateActivateEvents -#define TkGenerateActivateEvents(winPtr, active) \ - (tkIntPlatStubsPtr->tkGenerateActivateEvents)(winPtr, active) /* 4 */ +#define TkGenerateActivateEvents \ + (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 4 */ #endif #ifndef TkIntersectRegion -#define TkIntersectRegion(sra, srcb, dr_return) \ - (tkIntPlatStubsPtr->tkIntersectRegion)(sra, srcb, dr_return) /* 5 */ +#define TkIntersectRegion \ + (tkIntPlatStubsPtr->tkIntersectRegion) /* 5 */ #endif #ifndef TkpGetMS -#define TkpGetMS() \ - (tkIntPlatStubsPtr->tkpGetMS)() /* 6 */ +#define TkpGetMS \ + (tkIntPlatStubsPtr->tkpGetMS) /* 6 */ #endif #ifndef TkPointerDeadWindow -#define TkPointerDeadWindow(winPtr) \ - (tkIntPlatStubsPtr->tkPointerDeadWindow)(winPtr) /* 7 */ +#define TkPointerDeadWindow \ + (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 7 */ #endif #ifndef TkpPrintWindowId -#define TkpPrintWindowId(buf, window) \ - (tkIntPlatStubsPtr->tkpPrintWindowId)(buf, window) /* 8 */ +#define TkpPrintWindowId \ + (tkIntPlatStubsPtr->tkpPrintWindowId) /* 8 */ #endif #ifndef TkpScanWindowId -#define TkpScanWindowId(interp, string, idPtr) \ - (tkIntPlatStubsPtr->tkpScanWindowId)(interp, string, idPtr) /* 9 */ +#define TkpScanWindowId \ + (tkIntPlatStubsPtr->tkpScanWindowId) /* 9 */ #endif #ifndef TkpSetCapture -#define TkpSetCapture(winPtr) \ - (tkIntPlatStubsPtr->tkpSetCapture)(winPtr) /* 10 */ +#define TkpSetCapture \ + (tkIntPlatStubsPtr->tkpSetCapture) /* 10 */ #endif #ifndef TkpSetCursor -#define TkpSetCursor(cursor) \ - (tkIntPlatStubsPtr->tkpSetCursor)(cursor) /* 11 */ +#define TkpSetCursor \ + (tkIntPlatStubsPtr->tkpSetCursor) /* 11 */ #endif #ifndef TkpWmSetState -#define TkpWmSetState(winPtr, state) \ - (tkIntPlatStubsPtr->tkpWmSetState)(winPtr, state) /* 12 */ +#define TkpWmSetState \ + (tkIntPlatStubsPtr->tkpWmSetState) /* 12 */ #endif #ifndef TkRectInRegion -#define TkRectInRegion(rgn, x, y, width, height) \ - (tkIntPlatStubsPtr->tkRectInRegion)(rgn, x, y, width, height) /* 13 */ +#define TkRectInRegion \ + (tkIntPlatStubsPtr->tkRectInRegion) /* 13 */ #endif #ifndef TkSetPixmapColormap -#define TkSetPixmapColormap(pixmap, colormap) \ - (tkIntPlatStubsPtr->tkSetPixmapColormap)(pixmap, colormap) /* 14 */ +#define TkSetPixmapColormap \ + (tkIntPlatStubsPtr->tkSetPixmapColormap) /* 14 */ #endif #ifndef TkSetRegion -#define TkSetRegion(display, gc, rgn) \ - (tkIntPlatStubsPtr->tkSetRegion)(display, gc, rgn) /* 15 */ +#define TkSetRegion \ + (tkIntPlatStubsPtr->tkSetRegion) /* 15 */ #endif #ifndef TkUnionRectWithRegion -#define TkUnionRectWithRegion(rect, src, dr_return) \ - (tkIntPlatStubsPtr->tkUnionRectWithRegion)(rect, src, dr_return) /* 16 */ +#define TkUnionRectWithRegion \ + (tkIntPlatStubsPtr->tkUnionRectWithRegion) /* 16 */ #endif #ifndef TkWinCancelMouseTimer -#define TkWinCancelMouseTimer() \ - (tkIntPlatStubsPtr->tkWinCancelMouseTimer)() /* 17 */ +#define TkWinCancelMouseTimer \ + (tkIntPlatStubsPtr->tkWinCancelMouseTimer) /* 17 */ #endif #ifndef TkWinClipboardRender -#define TkWinClipboardRender(dispPtr, format) \ - (tkIntPlatStubsPtr->tkWinClipboardRender)(dispPtr, format) /* 18 */ +#define TkWinClipboardRender \ + (tkIntPlatStubsPtr->tkWinClipboardRender) /* 18 */ #endif #ifndef TkWinEmbeddedEventProc -#define TkWinEmbeddedEventProc(hwnd, message, wParam, lParam) \ - (tkIntPlatStubsPtr->tkWinEmbeddedEventProc)(hwnd, message, wParam, lParam) /* 19 */ +#define TkWinEmbeddedEventProc \ + (tkIntPlatStubsPtr->tkWinEmbeddedEventProc) /* 19 */ #endif #ifndef TkWinFillRect -#define TkWinFillRect(dc, x, y, width, height, pixel) \ - (tkIntPlatStubsPtr->tkWinFillRect)(dc, x, y, width, height, pixel) /* 20 */ +#define TkWinFillRect \ + (tkIntPlatStubsPtr->tkWinFillRect) /* 20 */ #endif #ifndef TkWinGetBorderPixels -#define TkWinGetBorderPixels(tkwin, border, which) \ - (tkIntPlatStubsPtr->tkWinGetBorderPixels)(tkwin, border, which) /* 21 */ +#define TkWinGetBorderPixels \ + (tkIntPlatStubsPtr->tkWinGetBorderPixels) /* 21 */ #endif #ifndef TkWinGetDrawableDC -#define TkWinGetDrawableDC(display, d, state) \ - (tkIntPlatStubsPtr->tkWinGetDrawableDC)(display, d, state) /* 22 */ +#define TkWinGetDrawableDC \ + (tkIntPlatStubsPtr->tkWinGetDrawableDC) /* 22 */ #endif #ifndef TkWinGetModifierState -#define TkWinGetModifierState() \ - (tkIntPlatStubsPtr->tkWinGetModifierState)() /* 23 */ +#define TkWinGetModifierState \ + (tkIntPlatStubsPtr->tkWinGetModifierState) /* 23 */ #endif #ifndef TkWinGetSystemPalette -#define TkWinGetSystemPalette() \ - (tkIntPlatStubsPtr->tkWinGetSystemPalette)() /* 24 */ +#define TkWinGetSystemPalette \ + (tkIntPlatStubsPtr->tkWinGetSystemPalette) /* 24 */ #endif #ifndef TkWinGetWrapperWindow -#define TkWinGetWrapperWindow(tkwin) \ - (tkIntPlatStubsPtr->tkWinGetWrapperWindow)(tkwin) /* 25 */ +#define TkWinGetWrapperWindow \ + (tkIntPlatStubsPtr->tkWinGetWrapperWindow) /* 25 */ #endif #ifndef TkWinHandleMenuEvent -#define TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) \ - (tkIntPlatStubsPtr->tkWinHandleMenuEvent)(phwnd, pMessage, pwParam, plParam, plResult) /* 26 */ +#define TkWinHandleMenuEvent \ + (tkIntPlatStubsPtr->tkWinHandleMenuEvent) /* 26 */ #endif #ifndef TkWinIndexOfColor -#define TkWinIndexOfColor(colorPtr) \ - (tkIntPlatStubsPtr->tkWinIndexOfColor)(colorPtr) /* 27 */ +#define TkWinIndexOfColor \ + (tkIntPlatStubsPtr->tkWinIndexOfColor) /* 27 */ #endif #ifndef TkWinReleaseDrawableDC -#define TkWinReleaseDrawableDC(d, hdc, state) \ - (tkIntPlatStubsPtr->tkWinReleaseDrawableDC)(d, hdc, state) /* 28 */ +#define TkWinReleaseDrawableDC \ + (tkIntPlatStubsPtr->tkWinReleaseDrawableDC) /* 28 */ #endif #ifndef TkWinResendEvent -#define TkWinResendEvent(wndproc, hwnd, eventPtr) \ - (tkIntPlatStubsPtr->tkWinResendEvent)(wndproc, hwnd, eventPtr) /* 29 */ +#define TkWinResendEvent \ + (tkIntPlatStubsPtr->tkWinResendEvent) /* 29 */ #endif #ifndef TkWinSelectPalette -#define TkWinSelectPalette(dc, colormap) \ - (tkIntPlatStubsPtr->tkWinSelectPalette)(dc, colormap) /* 30 */ +#define TkWinSelectPalette \ + (tkIntPlatStubsPtr->tkWinSelectPalette) /* 30 */ #endif #ifndef TkWinSetMenu -#define TkWinSetMenu(tkwin, hMenu) \ - (tkIntPlatStubsPtr->tkWinSetMenu)(tkwin, hMenu) /* 31 */ +#define TkWinSetMenu \ + (tkIntPlatStubsPtr->tkWinSetMenu) /* 31 */ #endif #ifndef TkWinSetWindowPos -#define TkWinSetWindowPos(hwnd, siblingHwnd, pos) \ - (tkIntPlatStubsPtr->tkWinSetWindowPos)(hwnd, siblingHwnd, pos) /* 32 */ +#define TkWinSetWindowPos \ + (tkIntPlatStubsPtr->tkWinSetWindowPos) /* 32 */ #endif #ifndef TkWinWmCleanup -#define TkWinWmCleanup(hInstance) \ - (tkIntPlatStubsPtr->tkWinWmCleanup)(hInstance) /* 33 */ +#define TkWinWmCleanup \ + (tkIntPlatStubsPtr->tkWinWmCleanup) /* 33 */ #endif #ifndef TkWinXCleanup -#define TkWinXCleanup(hInstance) \ - (tkIntPlatStubsPtr->tkWinXCleanup)(hInstance) /* 34 */ +#define TkWinXCleanup \ + (tkIntPlatStubsPtr->tkWinXCleanup) /* 34 */ #endif #ifndef TkWinXInit -#define TkWinXInit(hInstance) \ - (tkIntPlatStubsPtr->tkWinXInit)(hInstance) /* 35 */ +#define TkWinXInit \ + (tkIntPlatStubsPtr->tkWinXInit) /* 35 */ +#endif +#ifndef TkWinSetForegroundWindow +#define TkWinSetForegroundWindow \ + (tkIntPlatStubsPtr->tkWinSetForegroundWindow) /* 36 */ +#endif +#ifndef TkWinDialogDebug +#define TkWinDialogDebug \ + (tkIntPlatStubsPtr->tkWinDialogDebug) /* 37 */ +#endif +#ifndef TkWinGetMenuSystemDefault +#define TkWinGetMenuSystemDefault \ + (tkIntPlatStubsPtr->tkWinGetMenuSystemDefault) /* 38 */ +#endif +#ifndef TkWinGetPlatformId +#define TkWinGetPlatformId \ + (tkIntPlatStubsPtr->tkWinGetPlatformId) /* 39 */ #endif #endif /* __WIN32__ */ #ifdef MAC_TCL #ifndef TkClipBox -#define TkClipBox(rgn, rect_return) \ - (tkIntPlatStubsPtr->tkClipBox)(rgn, rect_return) /* 0 */ +#define TkClipBox \ + (tkIntPlatStubsPtr->tkClipBox) /* 0 */ #endif #ifndef TkCreateRegion -#define TkCreateRegion() \ - (tkIntPlatStubsPtr->tkCreateRegion)() /* 1 */ +#define TkCreateRegion \ + (tkIntPlatStubsPtr->tkCreateRegion) /* 1 */ #endif #ifndef TkDestroyRegion -#define TkDestroyRegion(rgn) \ - (tkIntPlatStubsPtr->tkDestroyRegion)(rgn) /* 2 */ +#define TkDestroyRegion \ + (tkIntPlatStubsPtr->tkDestroyRegion) /* 2 */ #endif #ifndef TkGenerateActivateEvents -#define TkGenerateActivateEvents(winPtr, active) \ - (tkIntPlatStubsPtr->tkGenerateActivateEvents)(winPtr, active) /* 3 */ +#define TkGenerateActivateEvents \ + (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 3 */ #endif #ifndef TkIntersectRegion -#define TkIntersectRegion(sra, srcb, dr_return) \ - (tkIntPlatStubsPtr->tkIntersectRegion)(sra, srcb, dr_return) /* 4 */ +#define TkIntersectRegion \ + (tkIntPlatStubsPtr->tkIntersectRegion) /* 4 */ #endif #ifndef TkpCreateNativeBitmap -#define TkpCreateNativeBitmap(display, source) \ - (tkIntPlatStubsPtr->tkpCreateNativeBitmap)(display, source) /* 5 */ +#define TkpCreateNativeBitmap \ + (tkIntPlatStubsPtr->tkpCreateNativeBitmap) /* 5 */ #endif #ifndef TkpDefineNativeBitmaps -#define TkpDefineNativeBitmaps() \ - (tkIntPlatStubsPtr->tkpDefineNativeBitmaps)() /* 6 */ +#define TkpDefineNativeBitmaps \ + (tkIntPlatStubsPtr->tkpDefineNativeBitmaps) /* 6 */ #endif #ifndef TkpGetMS -#define TkpGetMS() \ - (tkIntPlatStubsPtr->tkpGetMS)() /* 7 */ +#define TkpGetMS \ + (tkIntPlatStubsPtr->tkpGetMS) /* 7 */ #endif #ifndef TkpGetNativeAppBitmap -#define TkpGetNativeAppBitmap(display, name, width, height) \ - (tkIntPlatStubsPtr->tkpGetNativeAppBitmap)(display, name, width, height) /* 8 */ +#define TkpGetNativeAppBitmap \ + (tkIntPlatStubsPtr->tkpGetNativeAppBitmap) /* 8 */ #endif #ifndef TkPointerDeadWindow -#define TkPointerDeadWindow(winPtr) \ - (tkIntPlatStubsPtr->tkPointerDeadWindow)(winPtr) /* 9 */ +#define TkPointerDeadWindow \ + (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 9 */ #endif #ifndef TkpSetCapture -#define TkpSetCapture(winPtr) \ - (tkIntPlatStubsPtr->tkpSetCapture)(winPtr) /* 10 */ +#define TkpSetCapture \ + (tkIntPlatStubsPtr->tkpSetCapture) /* 10 */ #endif #ifndef TkpSetCursor -#define TkpSetCursor(cursor) \ - (tkIntPlatStubsPtr->tkpSetCursor)(cursor) /* 11 */ +#define TkpSetCursor \ + (tkIntPlatStubsPtr->tkpSetCursor) /* 11 */ #endif #ifndef TkpWmSetState -#define TkpWmSetState(winPtr, state) \ - (tkIntPlatStubsPtr->tkpWmSetState)(winPtr, state) /* 12 */ +#define TkpWmSetState \ + (tkIntPlatStubsPtr->tkpWmSetState) /* 12 */ #endif #ifndef TkRectInRegion -#define TkRectInRegion(rgn, x, y, width, height) \ - (tkIntPlatStubsPtr->tkRectInRegion)(rgn, x, y, width, height) /* 13 */ +#define TkRectInRegion \ + (tkIntPlatStubsPtr->tkRectInRegion) /* 13 */ #endif #ifndef TkSetRegion -#define TkSetRegion(display, gc, rgn) \ - (tkIntPlatStubsPtr->tkSetRegion)(display, gc, rgn) /* 14 */ +#define TkSetRegion \ + (tkIntPlatStubsPtr->tkSetRegion) /* 14 */ #endif #ifndef TkUnionRectWithRegion -#define TkUnionRectWithRegion(rect, src, dr_return) \ - (tkIntPlatStubsPtr->tkUnionRectWithRegion)(rect, src, dr_return) /* 15 */ +#define TkUnionRectWithRegion \ + (tkIntPlatStubsPtr->tkUnionRectWithRegion) /* 15 */ #endif #ifndef HandleWMEvent -#define HandleWMEvent(theEvent) \ - (tkIntPlatStubsPtr->handleWMEvent)(theEvent) /* 16 */ +#define HandleWMEvent \ + (tkIntPlatStubsPtr->handleWMEvent) /* 16 */ #endif #ifndef TkAboutDlg -#define TkAboutDlg() \ - (tkIntPlatStubsPtr->tkAboutDlg)() /* 17 */ +#define TkAboutDlg \ + (tkIntPlatStubsPtr->tkAboutDlg) /* 17 */ #endif #ifndef TkCreateMacEventSource -#define TkCreateMacEventSource() \ - (tkIntPlatStubsPtr->tkCreateMacEventSource)() /* 18 */ +#define TkCreateMacEventSource \ + (tkIntPlatStubsPtr->tkCreateMacEventSource) /* 18 */ #endif #ifndef TkFontList -#define TkFontList(interp, display) \ - (tkIntPlatStubsPtr->tkFontList)(interp, display) /* 19 */ +#define TkFontList \ + (tkIntPlatStubsPtr->tkFontList) /* 19 */ #endif #ifndef TkGetTransientMaster -#define TkGetTransientMaster(winPtr) \ - (tkIntPlatStubsPtr->tkGetTransientMaster)(winPtr) /* 20 */ +#define TkGetTransientMaster \ + (tkIntPlatStubsPtr->tkGetTransientMaster) /* 20 */ #endif #ifndef TkGenerateButtonEvent -#define TkGenerateButtonEvent(x, y, window, state) \ - (tkIntPlatStubsPtr->tkGenerateButtonEvent)(x, y, window, state) /* 21 */ +#define TkGenerateButtonEvent \ + (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 21 */ #endif #ifndef TkGetCharPositions -#define TkGetCharPositions(font_struct, string, count, buffer) \ - (tkIntPlatStubsPtr->tkGetCharPositions)(font_struct, string, count, buffer) /* 22 */ +#define TkGetCharPositions \ + (tkIntPlatStubsPtr->tkGetCharPositions) /* 22 */ #endif #ifndef TkGenWMDestroyEvent -#define TkGenWMDestroyEvent(tkwin) \ - (tkIntPlatStubsPtr->tkGenWMDestroyEvent)(tkwin) /* 23 */ +#define TkGenWMDestroyEvent \ + (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 23 */ #endif #ifndef TkGenWMConfigureEvent -#define TkGenWMConfigureEvent(tkwin, x, y, width, height, flags) \ - (tkIntPlatStubsPtr->tkGenWMConfigureEvent)(tkwin, x, y, width, height, flags) /* 24 */ +#define TkGenWMConfigureEvent \ + (tkIntPlatStubsPtr->tkGenWMConfigureEvent) /* 24 */ #endif #ifndef TkMacButtonKeyState -#define TkMacButtonKeyState() \ - (tkIntPlatStubsPtr->tkMacButtonKeyState)() /* 25 */ +#define TkMacButtonKeyState \ + (tkIntPlatStubsPtr->tkMacButtonKeyState) /* 25 */ #endif #ifndef TkMacClearMenubarActive -#define TkMacClearMenubarActive() \ - (tkIntPlatStubsPtr->tkMacClearMenubarActive)() /* 26 */ +#define TkMacClearMenubarActive \ + (tkIntPlatStubsPtr->tkMacClearMenubarActive) /* 26 */ #endif #ifndef TkMacConvertEvent -#define TkMacConvertEvent(eventPtr) \ - (tkIntPlatStubsPtr->tkMacConvertEvent)(eventPtr) /* 27 */ +#define TkMacConvertEvent \ + (tkIntPlatStubsPtr->tkMacConvertEvent) /* 27 */ #endif #ifndef TkMacDispatchMenuEvent -#define TkMacDispatchMenuEvent(menuID, index) \ - (tkIntPlatStubsPtr->tkMacDispatchMenuEvent)(menuID, index) /* 28 */ +#define TkMacDispatchMenuEvent \ + (tkIntPlatStubsPtr->tkMacDispatchMenuEvent) /* 28 */ #endif #ifndef TkMacInstallCursor -#define TkMacInstallCursor(resizeOverride) \ - (tkIntPlatStubsPtr->tkMacInstallCursor)(resizeOverride) /* 29 */ +#define TkMacInstallCursor \ + (tkIntPlatStubsPtr->tkMacInstallCursor) /* 29 */ #endif #ifndef TkMacConvertTkEvent -#define TkMacConvertTkEvent(eventPtr, window) \ - (tkIntPlatStubsPtr->tkMacConvertTkEvent)(eventPtr, window) /* 30 */ +#define TkMacConvertTkEvent \ + (tkIntPlatStubsPtr->tkMacConvertTkEvent) /* 30 */ #endif #ifndef TkMacHandleTearoffMenu -#define TkMacHandleTearoffMenu() \ - (tkIntPlatStubsPtr->tkMacHandleTearoffMenu)() /* 31 */ +#define TkMacHandleTearoffMenu \ + (tkIntPlatStubsPtr->tkMacHandleTearoffMenu) /* 31 */ #endif #ifndef tkMacInstallMWConsole -#define tkMacInstallMWConsole(interp) \ - (tkIntPlatStubsPtr->tkMacInstallMWConsole)(interp) /* 32 */ +#define tkMacInstallMWConsole \ + (tkIntPlatStubsPtr->tkMacInstallMWConsole) /* 32 */ #endif #ifndef TkMacInvalClipRgns -#define TkMacInvalClipRgns(winPtr) \ - (tkIntPlatStubsPtr->tkMacInvalClipRgns)(winPtr) /* 33 */ +#define TkMacInvalClipRgns \ + (tkIntPlatStubsPtr->tkMacInvalClipRgns) /* 33 */ #endif #ifndef TkMacDoHLEvent -#define TkMacDoHLEvent(theEvent) \ - (tkIntPlatStubsPtr->tkMacDoHLEvent)(theEvent) /* 34 */ +#define TkMacDoHLEvent \ + (tkIntPlatStubsPtr->tkMacDoHLEvent) /* 34 */ #endif #ifndef TkMacFontInfo -#define TkMacFontInfo(fontId, family, style, size) \ - (tkIntPlatStubsPtr->tkMacFontInfo)(fontId, family, style, size) /* 35 */ +#define TkMacFontInfo \ + (tkIntPlatStubsPtr->tkMacFontInfo) /* 35 */ #endif #ifndef TkMacGenerateTime -#define TkMacGenerateTime() \ - (tkIntPlatStubsPtr->tkMacGenerateTime)() /* 36 */ +#define TkMacGenerateTime \ + (tkIntPlatStubsPtr->tkMacGenerateTime) /* 36 */ #endif #ifndef TkMacGetDrawablePort -#define TkMacGetDrawablePort(drawable) \ - (tkIntPlatStubsPtr->tkMacGetDrawablePort)(drawable) /* 37 */ +#define TkMacGetDrawablePort \ + (tkIntPlatStubsPtr->tkMacGetDrawablePort) /* 37 */ #endif #ifndef TkMacGetScrollbarGrowWindow -#define TkMacGetScrollbarGrowWindow(winPtr) \ - (tkIntPlatStubsPtr->tkMacGetScrollbarGrowWindow)(winPtr) /* 38 */ +#define TkMacGetScrollbarGrowWindow \ + (tkIntPlatStubsPtr->tkMacGetScrollbarGrowWindow) /* 38 */ #endif #ifndef TkMacGetXWindow -#define TkMacGetXWindow(macWinPtr) \ - (tkIntPlatStubsPtr->tkMacGetXWindow)(macWinPtr) /* 39 */ +#define TkMacGetXWindow \ + (tkIntPlatStubsPtr->tkMacGetXWindow) /* 39 */ #endif #ifndef TkMacGrowToplevel -#define TkMacGrowToplevel(whichWindow, start) \ - (tkIntPlatStubsPtr->tkMacGrowToplevel)(whichWindow, start) /* 40 */ +#define TkMacGrowToplevel \ + (tkIntPlatStubsPtr->tkMacGrowToplevel) /* 40 */ #endif #ifndef TkMacHandleMenuSelect -#define TkMacHandleMenuSelect(mResult, optionKeyPressed) \ - (tkIntPlatStubsPtr->tkMacHandleMenuSelect)(mResult, optionKeyPressed) /* 41 */ +#define TkMacHandleMenuSelect \ + (tkIntPlatStubsPtr->tkMacHandleMenuSelect) /* 41 */ #endif #ifndef TkMacHaveAppearance -#define TkMacHaveAppearance() \ - (tkIntPlatStubsPtr->tkMacHaveAppearance)() /* 42 */ +#define TkMacHaveAppearance \ + (tkIntPlatStubsPtr->tkMacHaveAppearance) /* 42 */ #endif #ifndef TkMacInitAppleEvents -#define TkMacInitAppleEvents(interp) \ - (tkIntPlatStubsPtr->tkMacInitAppleEvents)(interp) /* 43 */ +#define TkMacInitAppleEvents \ + (tkIntPlatStubsPtr->tkMacInitAppleEvents) /* 43 */ #endif #ifndef TkMacInitMenus -#define TkMacInitMenus(interp) \ - (tkIntPlatStubsPtr->tkMacInitMenus)(interp) /* 44 */ +#define TkMacInitMenus \ + (tkIntPlatStubsPtr->tkMacInitMenus) /* 44 */ #endif #ifndef TkMacInvalidateWindow -#define TkMacInvalidateWindow(macWin, flag) \ - (tkIntPlatStubsPtr->tkMacInvalidateWindow)(macWin, flag) /* 45 */ +#define TkMacInvalidateWindow \ + (tkIntPlatStubsPtr->tkMacInvalidateWindow) /* 45 */ #endif #ifndef TkMacIsCharacterMissing -#define TkMacIsCharacterMissing(tkfont, searchChar) \ - (tkIntPlatStubsPtr->tkMacIsCharacterMissing)(tkfont, searchChar) /* 46 */ +#define TkMacIsCharacterMissing \ + (tkIntPlatStubsPtr->tkMacIsCharacterMissing) /* 46 */ #endif #ifndef TkMacMakeRealWindowExist -#define TkMacMakeRealWindowExist(winPtr) \ - (tkIntPlatStubsPtr->tkMacMakeRealWindowExist)(winPtr) /* 47 */ +#define TkMacMakeRealWindowExist \ + (tkIntPlatStubsPtr->tkMacMakeRealWindowExist) /* 47 */ #endif #ifndef TkMacMakeStippleMap -#define TkMacMakeStippleMap(d1, d2) \ - (tkIntPlatStubsPtr->tkMacMakeStippleMap)(d1, d2) /* 48 */ +#define TkMacMakeStippleMap \ + (tkIntPlatStubsPtr->tkMacMakeStippleMap) /* 48 */ #endif #ifndef TkMacMenuClick -#define TkMacMenuClick() \ - (tkIntPlatStubsPtr->tkMacMenuClick)() /* 49 */ +#define TkMacMenuClick \ + (tkIntPlatStubsPtr->tkMacMenuClick) /* 49 */ #endif #ifndef TkMacRegisterOffScreenWindow -#define TkMacRegisterOffScreenWindow(window, portPtr) \ - (tkIntPlatStubsPtr->tkMacRegisterOffScreenWindow)(window, portPtr) /* 50 */ +#define TkMacRegisterOffScreenWindow \ + (tkIntPlatStubsPtr->tkMacRegisterOffScreenWindow) /* 50 */ #endif #ifndef TkMacResizable -#define TkMacResizable(winPtr) \ - (tkIntPlatStubsPtr->tkMacResizable)(winPtr) /* 51 */ +#define TkMacResizable \ + (tkIntPlatStubsPtr->tkMacResizable) /* 51 */ #endif #ifndef TkMacSetEmbedRgn -#define TkMacSetEmbedRgn(winPtr, rgn) \ - (tkIntPlatStubsPtr->tkMacSetEmbedRgn)(winPtr, rgn) /* 52 */ +#define TkMacSetEmbedRgn \ + (tkIntPlatStubsPtr->tkMacSetEmbedRgn) /* 52 */ #endif #ifndef TkMacSetHelpMenuItemCount -#define TkMacSetHelpMenuItemCount() \ - (tkIntPlatStubsPtr->tkMacSetHelpMenuItemCount)() /* 53 */ +#define TkMacSetHelpMenuItemCount \ + (tkIntPlatStubsPtr->tkMacSetHelpMenuItemCount) /* 53 */ #endif #ifndef TkMacSetScrollbarGrow -#define TkMacSetScrollbarGrow(winPtr, flag) \ - (tkIntPlatStubsPtr->tkMacSetScrollbarGrow)(winPtr, flag) /* 54 */ +#define TkMacSetScrollbarGrow \ + (tkIntPlatStubsPtr->tkMacSetScrollbarGrow) /* 54 */ #endif #ifndef TkMacSetUpClippingRgn -#define TkMacSetUpClippingRgn(drawable) \ - (tkIntPlatStubsPtr->tkMacSetUpClippingRgn)(drawable) /* 55 */ +#define TkMacSetUpClippingRgn \ + (tkIntPlatStubsPtr->tkMacSetUpClippingRgn) /* 55 */ #endif #ifndef TkMacSetUpGraphicsPort -#define TkMacSetUpGraphicsPort(gc) \ - (tkIntPlatStubsPtr->tkMacSetUpGraphicsPort)(gc) /* 56 */ +#define TkMacSetUpGraphicsPort \ + (tkIntPlatStubsPtr->tkMacSetUpGraphicsPort) /* 56 */ #endif #ifndef TkMacUpdateClipRgn -#define TkMacUpdateClipRgn(winPtr) \ - (tkIntPlatStubsPtr->tkMacUpdateClipRgn)(winPtr) /* 57 */ +#define TkMacUpdateClipRgn \ + (tkIntPlatStubsPtr->tkMacUpdateClipRgn) /* 57 */ #endif #ifndef TkMacUnregisterMacWindow -#define TkMacUnregisterMacWindow(portPtr) \ - (tkIntPlatStubsPtr->tkMacUnregisterMacWindow)(portPtr) /* 58 */ +#define TkMacUnregisterMacWindow \ + (tkIntPlatStubsPtr->tkMacUnregisterMacWindow) /* 58 */ #endif #ifndef TkMacUseMenuID -#define TkMacUseMenuID(macID) \ - (tkIntPlatStubsPtr->tkMacUseMenuID)(macID) /* 59 */ +#define TkMacUseMenuID \ + (tkIntPlatStubsPtr->tkMacUseMenuID) /* 59 */ #endif #ifndef TkMacVisableClipRgn -#define TkMacVisableClipRgn(winPtr) \ - (tkIntPlatStubsPtr->tkMacVisableClipRgn)(winPtr) /* 60 */ +#define TkMacVisableClipRgn \ + (tkIntPlatStubsPtr->tkMacVisableClipRgn) /* 60 */ #endif #ifndef TkMacWinBounds -#define TkMacWinBounds(winPtr, geometry) \ - (tkIntPlatStubsPtr->tkMacWinBounds)(winPtr, geometry) /* 61 */ +#define TkMacWinBounds \ + (tkIntPlatStubsPtr->tkMacWinBounds) /* 61 */ #endif #ifndef TkMacWindowOffset -#define TkMacWindowOffset(wRef, xOffset, yOffset) \ - (tkIntPlatStubsPtr->tkMacWindowOffset)(wRef, xOffset, yOffset) /* 62 */ +#define TkMacWindowOffset \ + (tkIntPlatStubsPtr->tkMacWindowOffset) /* 62 */ #endif #ifndef TkResumeClipboard -#define TkResumeClipboard() \ - (tkIntPlatStubsPtr->tkResumeClipboard)() /* 63 */ +#define TkResumeClipboard \ + (tkIntPlatStubsPtr->tkResumeClipboard) /* 63 */ #endif #ifndef TkSetMacColor -#define TkSetMacColor(pixel, macColor) \ - (tkIntPlatStubsPtr->tkSetMacColor)(pixel, macColor) /* 64 */ +#define TkSetMacColor \ + (tkIntPlatStubsPtr->tkSetMacColor) /* 64 */ #endif #ifndef TkSetWMName -#define TkSetWMName(winPtr, titleUid) \ - (tkIntPlatStubsPtr->tkSetWMName)(winPtr, titleUid) /* 65 */ +#define TkSetWMName \ + (tkIntPlatStubsPtr->tkSetWMName) /* 65 */ #endif #ifndef TkSuspendClipboard -#define TkSuspendClipboard() \ - (tkIntPlatStubsPtr->tkSuspendClipboard)() /* 66 */ +#define TkSuspendClipboard \ + (tkIntPlatStubsPtr->tkSuspendClipboard) /* 66 */ #endif #ifndef TkWMGrowToplevel -#define TkWMGrowToplevel(whichWindow, start) \ - (tkIntPlatStubsPtr->tkWMGrowToplevel)(whichWindow, start) /* 67 */ +#define TkWMGrowToplevel \ + (tkIntPlatStubsPtr->tkWMGrowToplevel) /* 67 */ #endif #ifndef TkMacZoomToplevel -#define TkMacZoomToplevel(whichWindow, where, zoomPart) \ - (tkIntPlatStubsPtr->tkMacZoomToplevel)(whichWindow, where, zoomPart) /* 68 */ +#define TkMacZoomToplevel \ + (tkIntPlatStubsPtr->tkMacZoomToplevel) /* 68 */ #endif #ifndef Tk_TopCoordsToWindow -#define Tk_TopCoordsToWindow(tkwin, rootX, rootY, newX, newY) \ - (tkIntPlatStubsPtr->tk_TopCoordsToWindow)(tkwin, rootX, rootY, newX, newY) /* 69 */ +#define Tk_TopCoordsToWindow \ + (tkIntPlatStubsPtr->tk_TopCoordsToWindow) /* 69 */ #endif #ifndef TkMacContainerId -#define TkMacContainerId(winPtr) \ - (tkIntPlatStubsPtr->tkMacContainerId)(winPtr) /* 70 */ +#define TkMacContainerId \ + (tkIntPlatStubsPtr->tkMacContainerId) /* 70 */ #endif #ifndef TkMacGetHostToplevel -#define TkMacGetHostToplevel(winPtr) \ - (tkIntPlatStubsPtr->tkMacGetHostToplevel)(winPtr) /* 71 */ +#define TkMacGetHostToplevel \ + (tkIntPlatStubsPtr->tkMacGetHostToplevel) /* 71 */ #endif #endif /* MAC_TCL */ diff --git a/generic/tkIntPlatStubs.c b/generic/tkIntPlatStubs.c deleted file mode 100644 index 6650915..0000000 --- a/generic/tkIntPlatStubs.c +++ /dev/null @@ -1,1050 +0,0 @@ -/* - * tkIntPlatStubs.c -- - * - * This file contains the wrapper functions for the platform dependent - * unsupported Tk API. - * - * Copyright (c) 1998-1999 by Scriptics Corporation. - * All rights reserved. - * - * RCS: @(#) $Id: tkIntPlatStubs.c,v 1.2 1999/03/10 07:04:41 stanton Exp $ - */ - -#include "tkInt.h" -#include "tkPort.h" - -#ifdef __WIN32__ -#include "tkWinInt.h" -#endif - -#include "tkIntPlatDecls.h" - -/* - * WARNING: This file is automatically generated by the tools/genStubs.tcl - * script. Any modifications to the function declarations below should be made - * in the generic/tkInt.decls script. - */ - -/* !BEGIN!: Do not edit below this line. */ - -/* - * Exported stub functions: - */ - -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ -/* Slot 0 */ -void -TkCreateXEventSource() -{ - (tkIntPlatStubsPtr->tkCreateXEventSource)(); -} - -/* Slot 1 */ -void -TkFreeWindowId(dispPtr, w) - TkDisplay * dispPtr; - Window w; -{ - (tkIntPlatStubsPtr->tkFreeWindowId)(dispPtr, w); -} - -/* Slot 2 */ -void -TkInitXId(dispPtr) - TkDisplay * dispPtr; -{ - (tkIntPlatStubsPtr->tkInitXId)(dispPtr); -} - -/* Slot 3 */ -int -TkpCmapStressed(tkwin, colormap) - Tk_Window tkwin; - Colormap colormap; -{ - return (tkIntPlatStubsPtr->tkpCmapStressed)(tkwin, colormap); -} - -/* Slot 4 */ -void -TkpSync(display) - Display * display; -{ - (tkIntPlatStubsPtr->tkpSync)(display); -} - -/* Slot 5 */ -Window -TkUnixContainerId(winPtr) - TkWindow * winPtr; -{ - return (tkIntPlatStubsPtr->tkUnixContainerId)(winPtr); -} - -/* Slot 6 */ -int -TkUnixDoOneXEvent(timePtr) - Tcl_Time * timePtr; -{ - return (tkIntPlatStubsPtr->tkUnixDoOneXEvent)(timePtr); -} - -/* Slot 7 */ -void -TkUnixSetMenubar(tkwin, menubar) - Tk_Window tkwin; - Tk_Window menubar; -{ - (tkIntPlatStubsPtr->tkUnixSetMenubar)(tkwin, menubar); -} - -#endif /* UNIX */ -#ifdef __WIN32__ -/* Slot 0 */ -char * -TkAlignImageData(image, alignment, bitOrder) - XImage * image; - int alignment; - int bitOrder; -{ - return (tkIntPlatStubsPtr->tkAlignImageData)(image, alignment, bitOrder); -} - -/* Slot 1 */ -void -TkClipBox(rgn, rect_return) - TkRegion rgn; - XRectangle* rect_return; -{ - (tkIntPlatStubsPtr->tkClipBox)(rgn, rect_return); -} - -/* Slot 2 */ -TkRegion -TkCreateRegion() -{ - return (tkIntPlatStubsPtr->tkCreateRegion)(); -} - -/* Slot 3 */ -void -TkDestroyRegion(rgn) - TkRegion rgn; -{ - (tkIntPlatStubsPtr->tkDestroyRegion)(rgn); -} - -/* Slot 4 */ -void -TkGenerateActivateEvents(winPtr, active) - TkWindow * winPtr; - int active; -{ - (tkIntPlatStubsPtr->tkGenerateActivateEvents)(winPtr, active); -} - -/* Slot 5 */ -void -TkIntersectRegion(sra, srcb, dr_return) - TkRegion sra; - TkRegion srcb; - TkRegion dr_return; -{ - (tkIntPlatStubsPtr->tkIntersectRegion)(sra, srcb, dr_return); -} - -/* Slot 6 */ -unsigned long -TkpGetMS() -{ - return (tkIntPlatStubsPtr->tkpGetMS)(); -} - -/* Slot 7 */ -void -TkPointerDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntPlatStubsPtr->tkPointerDeadWindow)(winPtr); -} - -/* Slot 8 */ -void -TkpPrintWindowId(buf, window) - char * buf; - Window window; -{ - (tkIntPlatStubsPtr->tkpPrintWindowId)(buf, window); -} - -/* Slot 9 */ -int -TkpScanWindowId(interp, string, idPtr) - Tcl_Interp * interp; - char * string; - int * idPtr; -{ - return (tkIntPlatStubsPtr->tkpScanWindowId)(interp, string, idPtr); -} - -/* Slot 10 */ -void -TkpSetCapture(winPtr) - TkWindow * winPtr; -{ - (tkIntPlatStubsPtr->tkpSetCapture)(winPtr); -} - -/* Slot 11 */ -void -TkpSetCursor(cursor) - TkpCursor cursor; -{ - (tkIntPlatStubsPtr->tkpSetCursor)(cursor); -} - -/* Slot 12 */ -void -TkpWmSetState(winPtr, state) - TkWindow * winPtr; - int state; -{ - (tkIntPlatStubsPtr->tkpWmSetState)(winPtr, state); -} - -/* Slot 13 */ -int -TkRectInRegion(rgn, x, y, width, height) - TkRegion rgn; - int x; - int y; - unsigned int width; - unsigned int height; -{ - return (tkIntPlatStubsPtr->tkRectInRegion)(rgn, x, y, width, height); -} - -/* Slot 14 */ -void -TkSetPixmapColormap(pixmap, colormap) - Pixmap pixmap; - Colormap colormap; -{ - (tkIntPlatStubsPtr->tkSetPixmapColormap)(pixmap, colormap); -} - -/* Slot 15 */ -void -TkSetRegion(display, gc, rgn) - Display* display; - GC gc; - TkRegion rgn; -{ - (tkIntPlatStubsPtr->tkSetRegion)(display, gc, rgn); -} - -/* Slot 16 */ -void -TkUnionRectWithRegion(rect, src, dr_return) - XRectangle* rect; - TkRegion src; - TkRegion dr_return; -{ - (tkIntPlatStubsPtr->tkUnionRectWithRegion)(rect, src, dr_return); -} - -/* Slot 17 */ -void -TkWinCancelMouseTimer() -{ - (tkIntPlatStubsPtr->tkWinCancelMouseTimer)(); -} - -/* Slot 18 */ -void -TkWinClipboardRender(dispPtr, format) - TkDisplay * dispPtr; - UINT format; -{ - (tkIntPlatStubsPtr->tkWinClipboardRender)(dispPtr, format); -} - -/* Slot 19 */ -LRESULT -TkWinEmbeddedEventProc(hwnd, message, wParam, lParam) - HWND hwnd; - UINT message; - WPARAM wParam; - LPARAM lParam; -{ - return (tkIntPlatStubsPtr->tkWinEmbeddedEventProc)(hwnd, message, wParam, lParam); -} - -/* Slot 20 */ -void -TkWinFillRect(dc, x, y, width, height, pixel) - HDC dc; - int x; - int y; - int width; - int height; - int pixel; -{ - (tkIntPlatStubsPtr->tkWinFillRect)(dc, x, y, width, height, pixel); -} - -/* Slot 21 */ -COLORREF -TkWinGetBorderPixels(tkwin, border, which) - Tk_Window tkwin; - Tk_3DBorder border; - int which; -{ - return (tkIntPlatStubsPtr->tkWinGetBorderPixels)(tkwin, border, which); -} - -/* Slot 22 */ -HDC -TkWinGetDrawableDC(display, d, state) - Display * display; - Drawable d; - TkWinDCState* state; -{ - return (tkIntPlatStubsPtr->tkWinGetDrawableDC)(display, d, state); -} - -/* Slot 23 */ -int -TkWinGetModifierState() -{ - return (tkIntPlatStubsPtr->tkWinGetModifierState)(); -} - -/* Slot 24 */ -HPALETTE -TkWinGetSystemPalette() -{ - return (tkIntPlatStubsPtr->tkWinGetSystemPalette)(); -} - -/* Slot 25 */ -HWND -TkWinGetWrapperWindow(tkwin) - Tk_Window tkwin; -{ - return (tkIntPlatStubsPtr->tkWinGetWrapperWindow)(tkwin); -} - -/* Slot 26 */ -int -TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) - HWND * phwnd; - UINT * pMessage; - WPARAM * pwParam; - LPARAM * plParam; - LRESULT * plResult; -{ - return (tkIntPlatStubsPtr->tkWinHandleMenuEvent)(phwnd, pMessage, pwParam, plParam, plResult); -} - -/* Slot 27 */ -int -TkWinIndexOfColor(colorPtr) - XColor * colorPtr; -{ - return (tkIntPlatStubsPtr->tkWinIndexOfColor)(colorPtr); -} - -/* Slot 28 */ -void -TkWinReleaseDrawableDC(d, hdc, state) - Drawable d; - HDC hdc; - TkWinDCState* state; -{ - (tkIntPlatStubsPtr->tkWinReleaseDrawableDC)(d, hdc, state); -} - -/* Slot 29 */ -LRESULT -TkWinResendEvent(wndproc, hwnd, eventPtr) - WNDPROC wndproc; - HWND hwnd; - XEvent * eventPtr; -{ - return (tkIntPlatStubsPtr->tkWinResendEvent)(wndproc, hwnd, eventPtr); -} - -/* Slot 30 */ -HPALETTE -TkWinSelectPalette(dc, colormap) - HDC dc; - Colormap colormap; -{ - return (tkIntPlatStubsPtr->tkWinSelectPalette)(dc, colormap); -} - -/* Slot 31 */ -void -TkWinSetMenu(tkwin, hMenu) - Tk_Window tkwin; - HMENU hMenu; -{ - (tkIntPlatStubsPtr->tkWinSetMenu)(tkwin, hMenu); -} - -/* Slot 32 */ -void -TkWinSetWindowPos(hwnd, siblingHwnd, pos) - HWND hwnd; - HWND siblingHwnd; - int pos; -{ - (tkIntPlatStubsPtr->tkWinSetWindowPos)(hwnd, siblingHwnd, pos); -} - -/* Slot 33 */ -void -TkWinWmCleanup(hInstance) - HINSTANCE hInstance; -{ - (tkIntPlatStubsPtr->tkWinWmCleanup)(hInstance); -} - -/* Slot 34 */ -void -TkWinXCleanup(hInstance) - HINSTANCE hInstance; -{ - (tkIntPlatStubsPtr->tkWinXCleanup)(hInstance); -} - -/* Slot 35 */ -void -TkWinXInit(hInstance) - HINSTANCE hInstance; -{ - (tkIntPlatStubsPtr->tkWinXInit)(hInstance); -} - -#endif /* __WIN32__ */ -#ifdef MAC_TCL -/* Slot 0 */ -void -TkClipBox(rgn, rect_return) - TkRegion rgn; - XRectangle* rect_return; -{ - (tkIntPlatStubsPtr->tkClipBox)(rgn, rect_return); -} - -/* Slot 1 */ -TkRegion -TkCreateRegion() -{ - return (tkIntPlatStubsPtr->tkCreateRegion)(); -} - -/* Slot 2 */ -void -TkDestroyRegion(rgn) - TkRegion rgn; -{ - (tkIntPlatStubsPtr->tkDestroyRegion)(rgn); -} - -/* Slot 3 */ -void -TkGenerateActivateEvents(winPtr, active) - TkWindow * winPtr; - int active; -{ - (tkIntPlatStubsPtr->tkGenerateActivateEvents)(winPtr, active); -} - -/* Slot 4 */ -void -TkIntersectRegion(sra, srcb, dr_return) - TkRegion sra; - TkRegion srcb; - TkRegion dr_return; -{ - (tkIntPlatStubsPtr->tkIntersectRegion)(sra, srcb, dr_return); -} - -/* Slot 5 */ -Pixmap -TkpCreateNativeBitmap(display, source) - Display * display; - char * source; -{ - return (tkIntPlatStubsPtr->tkpCreateNativeBitmap)(display, source); -} - -/* Slot 6 */ -void -TkpDefineNativeBitmaps() -{ - (tkIntPlatStubsPtr->tkpDefineNativeBitmaps)(); -} - -/* Slot 7 */ -unsigned long -TkpGetMS() -{ - return (tkIntPlatStubsPtr->tkpGetMS)(); -} - -/* Slot 8 */ -Pixmap -TkpGetNativeAppBitmap(display, name, width, height) - Display * display; - char * name; - int * width; - int * height; -{ - return (tkIntPlatStubsPtr->tkpGetNativeAppBitmap)(display, name, width, height); -} - -/* Slot 9 */ -void -TkPointerDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntPlatStubsPtr->tkPointerDeadWindow)(winPtr); -} - -/* Slot 10 */ -void -TkpSetCapture(winPtr) - TkWindow * winPtr; -{ - (tkIntPlatStubsPtr->tkpSetCapture)(winPtr); -} - -/* Slot 11 */ -void -TkpSetCursor(cursor) - TkpCursor cursor; -{ - (tkIntPlatStubsPtr->tkpSetCursor)(cursor); -} - -/* Slot 12 */ -void -TkpWmSetState(winPtr, state) - TkWindow * winPtr; - int state; -{ - (tkIntPlatStubsPtr->tkpWmSetState)(winPtr, state); -} - -/* Slot 13 */ -int -TkRectInRegion(rgn, x, y, width, height) - TkRegion rgn; - int x; - int y; - unsigned int width; - unsigned int height; -{ - return (tkIntPlatStubsPtr->tkRectInRegion)(rgn, x, y, width, height); -} - -/* Slot 14 */ -void -TkSetRegion(display, gc, rgn) - Display* display; - GC gc; - TkRegion rgn; -{ - (tkIntPlatStubsPtr->tkSetRegion)(display, gc, rgn); -} - -/* Slot 15 */ -void -TkUnionRectWithRegion(rect, src, dr_return) - XRectangle* rect; - TkRegion src; - TkRegion dr_return; -{ - (tkIntPlatStubsPtr->tkUnionRectWithRegion)(rect, src, dr_return); -} - -/* Slot 16 */ -int -HandleWMEvent(theEvent) - EventRecord * theEvent; -{ - return (tkIntPlatStubsPtr->handleWMEvent)(theEvent); -} - -/* Slot 17 */ -void -TkAboutDlg() -{ - (tkIntPlatStubsPtr->tkAboutDlg)(); -} - -/* Slot 18 */ -void -TkCreateMacEventSource() -{ - (tkIntPlatStubsPtr->tkCreateMacEventSource)(); -} - -/* Slot 19 */ -void -TkFontList(interp, display) - Tcl_Interp * interp; - Display * display; -{ - (tkIntPlatStubsPtr->tkFontList)(interp, display); -} - -/* Slot 20 */ -Window -TkGetTransientMaster(winPtr) - TkWindow * winPtr; -{ - return (tkIntPlatStubsPtr->tkGetTransientMaster)(winPtr); -} - -/* Slot 21 */ -int -TkGenerateButtonEvent(x, y, window, state) - int x; - int y; - Window window; - unsigned int state; -{ - return (tkIntPlatStubsPtr->tkGenerateButtonEvent)(x, y, window, state); -} - -/* Slot 22 */ -int -TkGetCharPositions(font_struct, string, count, buffer) - XFontStruct * font_struct; - char * string; - int count; - short * buffer; -{ - return (tkIntPlatStubsPtr->tkGetCharPositions)(font_struct, string, count, buffer); -} - -/* Slot 23 */ -void -TkGenWMDestroyEvent(tkwin) - Tk_Window tkwin; -{ - (tkIntPlatStubsPtr->tkGenWMDestroyEvent)(tkwin); -} - -/* Slot 24 */ -void -TkGenWMConfigureEvent(tkwin, x, y, width, height, flags) - Tk_Window tkwin; - int x; - int y; - int width; - int height; - int flags; -{ - (tkIntPlatStubsPtr->tkGenWMConfigureEvent)(tkwin, x, y, width, height, flags); -} - -/* Slot 25 */ -unsigned int -TkMacButtonKeyState() -{ - return (tkIntPlatStubsPtr->tkMacButtonKeyState)(); -} - -/* Slot 26 */ -void -TkMacClearMenubarActive() -{ - (tkIntPlatStubsPtr->tkMacClearMenubarActive)(); -} - -/* Slot 27 */ -int -TkMacConvertEvent(eventPtr) - EventRecord * eventPtr; -{ - return (tkIntPlatStubsPtr->tkMacConvertEvent)(eventPtr); -} - -/* Slot 28 */ -int -TkMacDispatchMenuEvent(menuID, index) - int menuID; - int index; -{ - return (tkIntPlatStubsPtr->tkMacDispatchMenuEvent)(menuID, index); -} - -/* Slot 29 */ -void -TkMacInstallCursor(resizeOverride) - int resizeOverride; -{ - (tkIntPlatStubsPtr->tkMacInstallCursor)(resizeOverride); -} - -/* Slot 30 */ -int -TkMacConvertTkEvent(eventPtr, window) - EventRecord * eventPtr; - Window window; -{ - return (tkIntPlatStubsPtr->tkMacConvertTkEvent)(eventPtr, window); -} - -/* Slot 31 */ -void -TkMacHandleTearoffMenu() -{ - (tkIntPlatStubsPtr->tkMacHandleTearoffMenu)(); -} - -/* Slot 32 */ -void -tkMacInstallMWConsole(interp) - Tcl_Interp * interp; -{ - (tkIntPlatStubsPtr->tkMacInstallMWConsole)(interp); -} - -/* Slot 33 */ -void -TkMacInvalClipRgns(winPtr) - TkWindow * winPtr; -{ - (tkIntPlatStubsPtr->tkMacInvalClipRgns)(winPtr); -} - -/* Slot 34 */ -void -TkMacDoHLEvent(theEvent) - EventRecord * theEvent; -{ - (tkIntPlatStubsPtr->tkMacDoHLEvent)(theEvent); -} - -/* Slot 35 */ -void -TkMacFontInfo(fontId, family, style, size) - Font fontId; - short * family; - short * style; - short * size; -{ - (tkIntPlatStubsPtr->tkMacFontInfo)(fontId, family, style, size); -} - -/* Slot 36 */ -Time -TkMacGenerateTime() -{ - return (tkIntPlatStubsPtr->tkMacGenerateTime)(); -} - -/* Slot 37 */ -GWorldPtr -TkMacGetDrawablePort(drawable) - Drawable drawable; -{ - return (tkIntPlatStubsPtr->tkMacGetDrawablePort)(drawable); -} - -/* Slot 38 */ -TkWindow * -TkMacGetScrollbarGrowWindow(winPtr) - TkWindow * winPtr; -{ - return (tkIntPlatStubsPtr->tkMacGetScrollbarGrowWindow)(winPtr); -} - -/* Slot 39 */ -Window -TkMacGetXWindow(macWinPtr) - WindowRef macWinPtr; -{ - return (tkIntPlatStubsPtr->tkMacGetXWindow)(macWinPtr); -} - -/* Slot 40 */ -int -TkMacGrowToplevel(whichWindow, start) - WindowRef whichWindow; - Point start; -{ - return (tkIntPlatStubsPtr->tkMacGrowToplevel)(whichWindow, start); -} - -/* Slot 41 */ -void -TkMacHandleMenuSelect(mResult, optionKeyPressed) - long mResult; - int optionKeyPressed; -{ - (tkIntPlatStubsPtr->tkMacHandleMenuSelect)(mResult, optionKeyPressed); -} - -/* Slot 42 */ -int -TkMacHaveAppearance() -{ - return (tkIntPlatStubsPtr->tkMacHaveAppearance)(); -} - -/* Slot 43 */ -void -TkMacInitAppleEvents(interp) - Tcl_Interp * interp; -{ - (tkIntPlatStubsPtr->tkMacInitAppleEvents)(interp); -} - -/* Slot 44 */ -void -TkMacInitMenus(interp) - Tcl_Interp * interp; -{ - (tkIntPlatStubsPtr->tkMacInitMenus)(interp); -} - -/* Slot 45 */ -void -TkMacInvalidateWindow(macWin, flag) - MacDrawable * macWin; - int flag; -{ - (tkIntPlatStubsPtr->tkMacInvalidateWindow)(macWin, flag); -} - -/* Slot 46 */ -int -TkMacIsCharacterMissing(tkfont, searchChar) - Tk_Font tkfont; - unsigned int searchChar; -{ - return (tkIntPlatStubsPtr->tkMacIsCharacterMissing)(tkfont, searchChar); -} - -/* Slot 47 */ -void -TkMacMakeRealWindowExist(winPtr) - TkWindow * winPtr; -{ - (tkIntPlatStubsPtr->tkMacMakeRealWindowExist)(winPtr); -} - -/* Slot 48 */ -BitMapPtr -TkMacMakeStippleMap(d1, d2) - Drawable d1; - Drawable d2; -{ - return (tkIntPlatStubsPtr->tkMacMakeStippleMap)(d1, d2); -} - -/* Slot 49 */ -void -TkMacMenuClick() -{ - (tkIntPlatStubsPtr->tkMacMenuClick)(); -} - -/* Slot 50 */ -void -TkMacRegisterOffScreenWindow(window, portPtr) - Window window; - GWorldPtr portPtr; -{ - (tkIntPlatStubsPtr->tkMacRegisterOffScreenWindow)(window, portPtr); -} - -/* Slot 51 */ -int -TkMacResizable(winPtr) - TkWindow * winPtr; -{ - return (tkIntPlatStubsPtr->tkMacResizable)(winPtr); -} - -/* Slot 52 */ -void -TkMacSetEmbedRgn(winPtr, rgn) - TkWindow * winPtr; - RgnHandle rgn; -{ - (tkIntPlatStubsPtr->tkMacSetEmbedRgn)(winPtr, rgn); -} - -/* Slot 53 */ -void -TkMacSetHelpMenuItemCount() -{ - (tkIntPlatStubsPtr->tkMacSetHelpMenuItemCount)(); -} - -/* Slot 54 */ -void -TkMacSetScrollbarGrow(winPtr, flag) - TkWindow * winPtr; - int flag; -{ - (tkIntPlatStubsPtr->tkMacSetScrollbarGrow)(winPtr, flag); -} - -/* Slot 55 */ -void -TkMacSetUpClippingRgn(drawable) - Drawable drawable; -{ - (tkIntPlatStubsPtr->tkMacSetUpClippingRgn)(drawable); -} - -/* Slot 56 */ -void -TkMacSetUpGraphicsPort(gc) - GC gc; -{ - (tkIntPlatStubsPtr->tkMacSetUpGraphicsPort)(gc); -} - -/* Slot 57 */ -void -TkMacUpdateClipRgn(winPtr) - TkWindow * winPtr; -{ - (tkIntPlatStubsPtr->tkMacUpdateClipRgn)(winPtr); -} - -/* Slot 58 */ -void -TkMacUnregisterMacWindow(portPtr) - GWorldPtr portPtr; -{ - (tkIntPlatStubsPtr->tkMacUnregisterMacWindow)(portPtr); -} - -/* Slot 59 */ -int -TkMacUseMenuID(macID) - short macID; -{ - return (tkIntPlatStubsPtr->tkMacUseMenuID)(macID); -} - -/* Slot 60 */ -RgnHandle -TkMacVisableClipRgn(winPtr) - TkWindow * winPtr; -{ - return (tkIntPlatStubsPtr->tkMacVisableClipRgn)(winPtr); -} - -/* Slot 61 */ -void -TkMacWinBounds(winPtr, geometry) - TkWindow * winPtr; - Rect * geometry; -{ - (tkIntPlatStubsPtr->tkMacWinBounds)(winPtr, geometry); -} - -/* Slot 62 */ -void -TkMacWindowOffset(wRef, xOffset, yOffset) - WindowRef wRef; - int * xOffset; - int * yOffset; -{ - (tkIntPlatStubsPtr->tkMacWindowOffset)(wRef, xOffset, yOffset); -} - -/* Slot 63 */ -void -TkResumeClipboard() -{ - (tkIntPlatStubsPtr->tkResumeClipboard)(); -} - -/* Slot 64 */ -int -TkSetMacColor(pixel, macColor) - unsigned long pixel; - RGBColor * macColor; -{ - return (tkIntPlatStubsPtr->tkSetMacColor)(pixel, macColor); -} - -/* Slot 65 */ -void -TkSetWMName(winPtr, titleUid) - TkWindow * winPtr; - Tk_Uid titleUid; -{ - (tkIntPlatStubsPtr->tkSetWMName)(winPtr, titleUid); -} - -/* Slot 66 */ -void -TkSuspendClipboard() -{ - (tkIntPlatStubsPtr->tkSuspendClipboard)(); -} - -/* Slot 67 */ -int -TkWMGrowToplevel(whichWindow, start) - WindowRef whichWindow; - Point start; -{ - return (tkIntPlatStubsPtr->tkWMGrowToplevel)(whichWindow, start); -} - -/* Slot 68 */ -int -TkMacZoomToplevel(whichWindow, where, zoomPart) - WindowPtr whichWindow; - Point where; - short zoomPart; -{ - return (tkIntPlatStubsPtr->tkMacZoomToplevel)(whichWindow, where, zoomPart); -} - -/* Slot 69 */ -Tk_Window -Tk_TopCoordsToWindow(tkwin, rootX, rootY, newX, newY) - Tk_Window tkwin; - int rootX; - int rootY; - int * newX; - int * newY; -{ - return (tkIntPlatStubsPtr->tk_TopCoordsToWindow)(tkwin, rootX, rootY, newX, newY); -} - -/* Slot 70 */ -MacDrawable * -TkMacContainerId(winPtr) - TkWindow * winPtr; -{ - return (tkIntPlatStubsPtr->tkMacContainerId)(winPtr); -} - -/* Slot 71 */ -MacDrawable * -TkMacGetHostToplevel(winPtr) - TkWindow * winPtr; -{ - return (tkIntPlatStubsPtr->tkMacGetHostToplevel)(winPtr); -} - -#endif /* MAC_TCL */ - -/* !END!: Do not edit above this line. */ diff --git a/generic/tkIntStubs.c b/generic/tkIntStubs.c deleted file mode 100644 index 1c33059..0000000 --- a/generic/tkIntStubs.c +++ /dev/null @@ -1,965 +0,0 @@ -/* - * tkIntStubs.c -- - * - * This file contains the wrapper functions for the platform independent - * unsupported Tk API. - * - * Copyright (c) 1998-1999 by Scriptics Corporation. - * All rights reserved. - * - * RCS: @(#) $Id: tkIntStubs.c,v 1.2 1999/03/10 07:04:41 stanton Exp $ - */ - -#include "tkInt.h" - -/* - * WARNING: This file is automatically generated by the tools/genStubs.tcl - * script. Any modifications to the function declarations below should be made - * in the generic/tkInt.decls script. - */ - -/* !BEGIN!: Do not edit below this line. */ - -/* - * Exported stub functions: - */ - -/* Slot 0 */ -TkWindow * -TkAllocWindow(dispPtr, screenNum, parentPtr) - TkDisplay * dispPtr; - int screenNum; - TkWindow * parentPtr; -{ - return (tkIntStubsPtr->tkAllocWindow)(dispPtr, screenNum, parentPtr); -} - -/* Slot 1 */ -void -TkBezierPoints(control, numSteps, coordPtr) - double control[]; - int numSteps; - double * coordPtr; -{ - (tkIntStubsPtr->tkBezierPoints)(control, numSteps, coordPtr); -} - -/* Slot 2 */ -void -TkBezierScreenPoints(canvas, control, numSteps, xPointPtr) - Tk_Canvas canvas; - double control[]; - int numSteps; - XPoint * xPointPtr; -{ - (tkIntStubsPtr->tkBezierScreenPoints)(canvas, control, numSteps, xPointPtr); -} - -/* Slot 3 */ -void -TkBindDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkBindDeadWindow)(winPtr); -} - -/* Slot 4 */ -void -TkBindEventProc(winPtr, eventPtr) - TkWindow * winPtr; - XEvent * eventPtr; -{ - (tkIntStubsPtr->tkBindEventProc)(winPtr, eventPtr); -} - -/* Slot 5 */ -void -TkBindFree(mainPtr) - TkMainInfo * mainPtr; -{ - (tkIntStubsPtr->tkBindFree)(mainPtr); -} - -/* Slot 6 */ -void -TkBindInit(mainPtr) - TkMainInfo * mainPtr; -{ - (tkIntStubsPtr->tkBindInit)(mainPtr); -} - -/* Slot 7 */ -void -TkChangeEventWindow(eventPtr, winPtr) - XEvent * eventPtr; - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkChangeEventWindow)(eventPtr, winPtr); -} - -/* Slot 8 */ -int -TkClipInit(interp, dispPtr) - Tcl_Interp * interp; - TkDisplay * dispPtr; -{ - return (tkIntStubsPtr->tkClipInit)(interp, dispPtr); -} - -/* Slot 9 */ -void -TkComputeAnchor(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr) - Tk_Anchor anchor; - Tk_Window tkwin; - int padX; - int padY; - int innerWidth; - int innerHeight; - int * xPtr; - int * yPtr; -{ - (tkIntStubsPtr->tkComputeAnchor)(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr); -} - -/* Slot 10 */ -int -TkCopyAndGlobalEval(interp, script) - Tcl_Interp * interp; - char * script; -{ - return (tkIntStubsPtr->tkCopyAndGlobalEval)(interp, script); -} - -/* Slot 11 */ -unsigned long -TkCreateBindingProcedure(interp, bindingTable, object, eventString, evalProc, freeProc, clientData) - Tcl_Interp * interp; - Tk_BindingTable bindingTable; - ClientData object; - char * eventString; - TkBindEvalProc * evalProc; - TkBindFreeProc * freeProc; - ClientData clientData; -{ - return (tkIntStubsPtr->tkCreateBindingProcedure)(interp, bindingTable, object, eventString, evalProc, freeProc, clientData); -} - -/* Slot 12 */ -TkCursor * -TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot, fg, bg) - Tk_Window tkwin; - char * source; - char * mask; - int width; - int height; - int xHot; - int yHot; - XColor fg; - XColor bg; -{ - return (tkIntStubsPtr->tkCreateCursorFromData)(tkwin, source, mask, width, height, xHot, yHot, fg, bg); -} - -/* Slot 13 */ -int -TkCreateFrame(clientData, interp, argc, argv, toplevel, appName) - ClientData clientData; - Tcl_Interp * interp; - int argc; - char ** argv; - int toplevel; - char * appName; -{ - return (tkIntStubsPtr->tkCreateFrame)(clientData, interp, argc, argv, toplevel, appName); -} - -/* Slot 14 */ -Tk_Window -TkCreateMainWindow(interp, screenName, baseName) - Tcl_Interp * interp; - char * screenName; - char * baseName; -{ - return (tkIntStubsPtr->tkCreateMainWindow)(interp, screenName, baseName); -} - -/* Slot 15 */ -Time -TkCurrentTime(dispPtr) - TkDisplay * dispPtr; -{ - return (tkIntStubsPtr->tkCurrentTime)(dispPtr); -} - -/* Slot 16 */ -void -TkDeleteAllImages(mainPtr) - TkMainInfo * mainPtr; -{ - (tkIntStubsPtr->tkDeleteAllImages)(mainPtr); -} - -/* Slot 17 */ -void -TkDoConfigureNotify(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkDoConfigureNotify)(winPtr); -} - -/* Slot 18 */ -void -TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding) - Tk_Window tkwin; - GC gc; - int width; - Drawable drawable; - int padding; -{ - (tkIntStubsPtr->tkDrawInsetFocusHighlight)(tkwin, gc, width, drawable, padding); -} - -/* Slot 19 */ -void -TkEventDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkEventDeadWindow)(winPtr); -} - -/* Slot 20 */ -void -TkFillPolygon(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC) - Tk_Canvas canvas; - double * coordPtr; - int numPoints; - Display * display; - Drawable drawable; - GC gc; - GC outlineGC; -{ - (tkIntStubsPtr->tkFillPolygon)(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC); -} - -/* Slot 21 */ -int -TkFindStateNum(interp, option, mapPtr, strKey) - Tcl_Interp * interp; - CONST char * option; - CONST TkStateMap * mapPtr; - CONST char * strKey; -{ - return (tkIntStubsPtr->tkFindStateNum)(interp, option, mapPtr, strKey); -} - -/* Slot 22 */ -char * -TkFindStateString(mapPtr, numKey) - CONST TkStateMap * mapPtr; - int numKey; -{ - return (tkIntStubsPtr->tkFindStateString)(mapPtr, numKey); -} - -/* Slot 23 */ -void -TkFocusDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkFocusDeadWindow)(winPtr); -} - -/* Slot 24 */ -int -TkFocusFilterEvent(winPtr, eventPtr) - TkWindow * winPtr; - XEvent * eventPtr; -{ - return (tkIntStubsPtr->tkFocusFilterEvent)(winPtr, eventPtr); -} - -/* Slot 25 */ -TkWindow * -TkFocusKeyEvent(winPtr, eventPtr) - TkWindow * winPtr; - XEvent * eventPtr; -{ - return (tkIntStubsPtr->tkFocusKeyEvent)(winPtr, eventPtr); -} - -/* Slot 26 */ -void -TkFontPkgInit(mainPtr) - TkMainInfo * mainPtr; -{ - (tkIntStubsPtr->tkFontPkgInit)(mainPtr); -} - -/* Slot 27 */ -void -TkFontPkgFree(mainPtr) - TkMainInfo * mainPtr; -{ - (tkIntStubsPtr->tkFontPkgFree)(mainPtr); -} - -/* Slot 28 */ -void -TkFreeBindingTags(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkFreeBindingTags)(winPtr); -} - -/* Slot 29 */ -void -TkFreeCursor(cursorPtr) - TkCursor * cursorPtr; -{ - (tkIntStubsPtr->tkFreeCursor)(cursorPtr); -} - -/* Slot 30 */ -char * -TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr, hotXPtr, hotYPtr) - Tcl_Interp * interp; - char * string; - char * fileName; - int * widthPtr; - int * heightPtr; - int * hotXPtr; - int * hotYPtr; -{ - return (tkIntStubsPtr->tkGetBitmapData)(interp, string, fileName, widthPtr, heightPtr, hotXPtr, hotYPtr); -} - -/* Slot 31 */ -void -TkGetButtPoints(p1, p2, width, project, m1, m2) - double p1[]; - double p2[]; - double width; - int project; - double m1[]; - double m2[]; -{ - (tkIntStubsPtr->tkGetButtPoints)(p1, p2, width, project, m1, m2); -} - -/* Slot 32 */ -TkCursor * -TkGetCursorByName(interp, tkwin, string) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_Uid string; -{ - return (tkIntStubsPtr->tkGetCursorByName)(interp, tkwin, string); -} - -/* Slot 33 */ -char * -TkGetDefaultScreenName(interp, screenName) - Tcl_Interp * interp; - char * screenName; -{ - return (tkIntStubsPtr->tkGetDefaultScreenName)(interp, screenName); -} - -/* Slot 34 */ -TkDisplay * -TkGetDisplay(display) - Display * display; -{ - return (tkIntStubsPtr->tkGetDisplay)(display); -} - -/* Slot 35 */ -int -TkGetDisplayOf(interp, objc, objv, tkwinPtr) - Tcl_Interp * interp; - int objc; - Tcl_Obj *CONST objv[]; - Tk_Window * tkwinPtr; -{ - return (tkIntStubsPtr->tkGetDisplayOf)(interp, objc, objv, tkwinPtr); -} - -/* Slot 36 */ -TkWindow * -TkGetFocusWin(winPtr) - TkWindow * winPtr; -{ - return (tkIntStubsPtr->tkGetFocusWin)(winPtr); -} - -/* Slot 37 */ -int -TkGetInterpNames(interp, tkwin) - Tcl_Interp * interp; - Tk_Window tkwin; -{ - return (tkIntStubsPtr->tkGetInterpNames)(interp, tkwin); -} - -/* Slot 38 */ -int -TkGetMiterPoints(p1, p2, p3, width, m1, m2) - double p1[]; - double p2[]; - double p3[]; - double width; - double m1[]; - double m2[]; -{ - return (tkIntStubsPtr->tkGetMiterPoints)(p1, p2, p3, width, m1, m2); -} - -/* Slot 39 */ -void -TkGetPointerCoords(tkwin, xPtr, yPtr) - Tk_Window tkwin; - int * xPtr; - int * yPtr; -{ - (tkIntStubsPtr->tkGetPointerCoords)(tkwin, xPtr, yPtr); -} - -/* Slot 40 */ -void -TkGetServerInfo(interp, tkwin) - Tcl_Interp * interp; - Tk_Window tkwin; -{ - (tkIntStubsPtr->tkGetServerInfo)(interp, tkwin); -} - -/* Slot 41 */ -void -TkGrabDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkGrabDeadWindow)(winPtr); -} - -/* Slot 42 */ -int -TkGrabState(winPtr) - TkWindow * winPtr; -{ - return (tkIntStubsPtr->tkGrabState)(winPtr); -} - -/* Slot 43 */ -void -TkIncludePoint(itemPtr, pointPtr) - Tk_Item * itemPtr; - double * pointPtr; -{ - (tkIntStubsPtr->tkIncludePoint)(itemPtr, pointPtr); -} - -/* Slot 44 */ -void -TkInOutEvents(eventPtr, sourcePtr, destPtr, leaveType, enterType, position) - XEvent * eventPtr; - TkWindow * sourcePtr; - TkWindow * destPtr; - int leaveType; - int enterType; - Tcl_QueuePosition position; -{ - (tkIntStubsPtr->tkInOutEvents)(eventPtr, sourcePtr, destPtr, leaveType, enterType, position); -} - -/* Slot 45 */ -void -TkInstallFrameMenu(tkwin) - Tk_Window tkwin; -{ - (tkIntStubsPtr->tkInstallFrameMenu)(tkwin); -} - -/* Slot 46 */ -char * -TkKeysymToString(keysym) - KeySym keysym; -{ - return (tkIntStubsPtr->tkKeysymToString)(keysym); -} - -/* Slot 47 */ -int -TkLineToArea(end1Ptr, end2Ptr, rectPtr) - TkDouble2 end1Ptr; - TkDouble2 end2Ptr; - TkDouble4 rectPtr; -{ - return (tkIntStubsPtr->tkLineToArea)(end1Ptr, end2Ptr, rectPtr); -} - -/* Slot 48 */ -double -TkLineToPoint(end1Ptr, end2Ptr, pointPtr) - double end1Ptr[]; - TkDouble2 end2Ptr; - TkDouble2 pointPtr; -{ - return (tkIntStubsPtr->tkLineToPoint)(end1Ptr, end2Ptr, pointPtr); -} - -/* Slot 49 */ -int -TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints) - Tk_Canvas canvas; - double * pointPtr; - int numPoints; - int numSteps; - XPoint xPoints[]; - double dblPoints[]; -{ - return (tkIntStubsPtr->tkMakeBezierCurve)(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints); -} - -/* Slot 50 */ -void -TkMakeBezierPostscript(interp, canvas, pointPtr, numPoints) - Tcl_Interp * interp; - Tk_Canvas canvas; - double * pointPtr; - int numPoints; -{ - (tkIntStubsPtr->tkMakeBezierPostscript)(interp, canvas, pointPtr, numPoints); -} - -/* Slot 51 */ -void -TkOptionClassChanged(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkOptionClassChanged)(winPtr); -} - -/* Slot 52 */ -void -TkOptionDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkOptionDeadWindow)(winPtr); -} - -/* Slot 53 */ -int -TkOvalToArea(ovalPtr, rectPtr) - double * ovalPtr; - double * rectPtr; -{ - return (tkIntStubsPtr->tkOvalToArea)(ovalPtr, rectPtr); -} - -/* Slot 54 */ -double -TkOvalToPoint(ovalPtr, width, filled, pointPtr) - TkDouble4 ovalPtr; - double width; - int filled; - TkDouble2 pointPtr; -{ - return (tkIntStubsPtr->tkOvalToPoint)(ovalPtr, width, filled, pointPtr); -} - -/* Slot 55 */ -int -TkpChangeFocus(winPtr, force) - TkWindow * winPtr; - int force; -{ - return (tkIntStubsPtr->tkpChangeFocus)(winPtr, force); -} - -/* Slot 56 */ -void -TkpCloseDisplay(dispPtr) - TkDisplay * dispPtr; -{ - (tkIntStubsPtr->tkpCloseDisplay)(dispPtr); -} - -/* Slot 57 */ -void -TkpClaimFocus(topLevelPtr, force) - TkWindow * topLevelPtr; - int force; -{ - (tkIntStubsPtr->tkpClaimFocus)(topLevelPtr, force); -} - -/* Slot 58 */ -void -TkpDisplayWarning(msg, title) - char * msg; - char * title; -{ - (tkIntStubsPtr->tkpDisplayWarning)(msg, title); -} - -/* Slot 59 */ -void -TkpGetAppName(interp, name) - Tcl_Interp * interp; - Tcl_DString * name; -{ - (tkIntStubsPtr->tkpGetAppName)(interp, name); -} - -/* Slot 60 */ -TkWindow * -TkpGetOtherWindow(winPtr) - TkWindow * winPtr; -{ - return (tkIntStubsPtr->tkpGetOtherWindow)(winPtr); -} - -/* Slot 61 */ -TkWindow * -TkpGetWrapperWindow(winPtr) - TkWindow * winPtr; -{ - return (tkIntStubsPtr->tkpGetWrapperWindow)(winPtr); -} - -/* Slot 62 */ -int -TkpInit(interp) - Tcl_Interp * interp; -{ - return (tkIntStubsPtr->tkpInit)(interp); -} - -/* Slot 63 */ -void -TkpInitializeMenuBindings(interp, bindingTable) - Tcl_Interp * interp; - Tk_BindingTable bindingTable; -{ - (tkIntStubsPtr->tkpInitializeMenuBindings)(interp, bindingTable); -} - -/* Slot 64 */ -void -TkpMakeContainer(tkwin) - Tk_Window tkwin; -{ - (tkIntStubsPtr->tkpMakeContainer)(tkwin); -} - -/* Slot 65 */ -void -TkpMakeMenuWindow(tkwin, transient) - Tk_Window tkwin; - int transient; -{ - (tkIntStubsPtr->tkpMakeMenuWindow)(tkwin, transient); -} - -/* Slot 66 */ -Window -TkpMakeWindow(winPtr, parent) - TkWindow * winPtr; - Window parent; -{ - return (tkIntStubsPtr->tkpMakeWindow)(winPtr, parent); -} - -/* Slot 67 */ -void -TkpMenuNotifyToplevelCreate(interp1, menuName) - Tcl_Interp * interp1; - char * menuName; -{ - (tkIntStubsPtr->tkpMenuNotifyToplevelCreate)(interp1, menuName); -} - -/* Slot 68 */ -TkDisplay * -TkpOpenDisplay(display_name) - char * display_name; -{ - return (tkIntStubsPtr->tkpOpenDisplay)(display_name); -} - -/* Slot 69 */ -int -TkPointerEvent(eventPtr, winPtr) - XEvent * eventPtr; - TkWindow * winPtr; -{ - return (tkIntStubsPtr->tkPointerEvent)(eventPtr, winPtr); -} - -/* Slot 70 */ -int -TkPolygonToArea(polyPtr, numPoints, rectPtr) - double * polyPtr; - int numPoints; - double * rectPtr; -{ - return (tkIntStubsPtr->tkPolygonToArea)(polyPtr, numPoints, rectPtr); -} - -/* Slot 71 */ -double -TkPolygonToPoint(polyPtr, numPoints, pointPtr) - double * polyPtr; - int numPoints; - double * pointPtr; -{ - return (tkIntStubsPtr->tkPolygonToPoint)(polyPtr, numPoints, pointPtr); -} - -/* Slot 72 */ -int -TkPositionInTree(winPtr, treePtr) - TkWindow * winPtr; - TkWindow * treePtr; -{ - return (tkIntStubsPtr->tkPositionInTree)(winPtr, treePtr); -} - -/* Slot 73 */ -void -TkpRedirectKeyEvent(winPtr, eventPtr) - TkWindow * winPtr; - XEvent * eventPtr; -{ - (tkIntStubsPtr->tkpRedirectKeyEvent)(winPtr, eventPtr); -} - -/* Slot 74 */ -void -TkpSetMainMenubar(interp, tkwin, menuName) - Tcl_Interp * interp; - Tk_Window tkwin; - char * menuName; -{ - (tkIntStubsPtr->tkpSetMainMenubar)(interp, tkwin, menuName); -} - -/* Slot 75 */ -int -TkpUseWindow(interp, tkwin, string) - Tcl_Interp * interp; - Tk_Window tkwin; - char * string; -{ - return (tkIntStubsPtr->tkpUseWindow)(interp, tkwin, string); -} - -/* Slot 76 */ -int -TkpWindowWasRecentlyDeleted(win, dispPtr) - Window win; - TkDisplay * dispPtr; -{ - return (tkIntStubsPtr->tkpWindowWasRecentlyDeleted)(win, dispPtr); -} - -/* Slot 77 */ -void -TkQueueEventForAllChildren(winPtr, eventPtr) - TkWindow * winPtr; - XEvent * eventPtr; -{ - (tkIntStubsPtr->tkQueueEventForAllChildren)(winPtr, eventPtr); -} - -/* Slot 78 */ -int -TkReadBitmapFile(display, d, filename, width_return, height_return, bitmap_return, x_hot_return, y_hot_return) - 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; -{ - return (tkIntStubsPtr->tkReadBitmapFile)(display, d, filename, width_return, height_return, bitmap_return, x_hot_return, y_hot_return); -} - -/* Slot 79 */ -int -TkScrollWindow(tkwin, gc, x, y, width, height, dx, dy, damageRgn) - Tk_Window tkwin; - GC gc; - int x; - int y; - int width; - int height; - int dx; - int dy; - TkRegion damageRgn; -{ - return (tkIntStubsPtr->tkScrollWindow)(tkwin, gc, x, y, width, height, dx, dy, damageRgn); -} - -/* Slot 80 */ -void -TkSelDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkSelDeadWindow)(winPtr); -} - -/* Slot 81 */ -void -TkSelEventProc(tkwin, eventPtr) - Tk_Window tkwin; - XEvent * eventPtr; -{ - (tkIntStubsPtr->tkSelEventProc)(tkwin, eventPtr); -} - -/* Slot 82 */ -void -TkSelInit(tkwin) - Tk_Window tkwin; -{ - (tkIntStubsPtr->tkSelInit)(tkwin); -} - -/* Slot 83 */ -void -TkSelPropProc(eventPtr) - XEvent * eventPtr; -{ - (tkIntStubsPtr->tkSelPropProc)(eventPtr); -} - -/* Slot 84 */ -void -TkSetClassProcs(tkwin, procs, instanceData) - Tk_Window tkwin; - TkClassProcs * procs; - ClientData instanceData; -{ - (tkIntStubsPtr->tkSetClassProcs)(tkwin, procs, instanceData); -} - -/* Slot 85 */ -void -TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName) - Tcl_Interp * interp; - Tk_Window tkwin; - char * oldMenuName; - char * menuName; -{ - (tkIntStubsPtr->tkSetWindowMenuBar)(interp, tkwin, oldMenuName, menuName); -} - -/* Slot 86 */ -KeySym -TkStringToKeysym(name) - char * name; -{ - return (tkIntStubsPtr->tkStringToKeysym)(name); -} - -/* Slot 87 */ -int -TkThickPolyLineToArea(coordPtr, numPoints, width, capStyle, joinStyle, rectPtr) - double * coordPtr; - int numPoints; - double width; - int capStyle; - int joinStyle; - double * rectPtr; -{ - return (tkIntStubsPtr->tkThickPolyLineToArea)(coordPtr, numPoints, width, capStyle, joinStyle, rectPtr); -} - -/* Slot 88 */ -void -TkWmAddToColormapWindows(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkWmAddToColormapWindows)(winPtr); -} - -/* Slot 89 */ -void -TkWmDeadWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkWmDeadWindow)(winPtr); -} - -/* Slot 90 */ -TkWindow * -TkWmFocusToplevel(winPtr) - TkWindow * winPtr; -{ - return (tkIntStubsPtr->tkWmFocusToplevel)(winPtr); -} - -/* Slot 91 */ -void -TkWmMapWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkWmMapWindow)(winPtr); -} - -/* Slot 92 */ -void -TkWmNewWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkWmNewWindow)(winPtr); -} - -/* Slot 93 */ -void -TkWmProtocolEventProc(winPtr, evenvPtr) - TkWindow * winPtr; - XEvent * evenvPtr; -{ - (tkIntStubsPtr->tkWmProtocolEventProc)(winPtr, evenvPtr); -} - -/* Slot 94 */ -void -TkWmRemoveFromColormapWindows(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkWmRemoveFromColormapWindows)(winPtr); -} - -/* Slot 95 */ -void -TkWmRestackToplevel(winPtr, aboveBelow, otherPtr) - TkWindow * winPtr; - int aboveBelow; - TkWindow * otherPtr; -{ - (tkIntStubsPtr->tkWmRestackToplevel)(winPtr, aboveBelow, otherPtr); -} - -/* Slot 96 */ -void -TkWmSetClass(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkWmSetClass)(winPtr); -} - -/* Slot 97 */ -void -TkWmUnmapWindow(winPtr) - TkWindow * winPtr; -{ - (tkIntStubsPtr->tkWmUnmapWindow)(winPtr); -} - - -/* !END!: Do not edit above this line. */ diff --git a/generic/tkIntXlibDecls.h b/generic/tkIntXlibDecls.h index e9b9ab2..03d8209 100644 --- a/generic/tkIntXlibDecls.h +++ b/generic/tkIntXlibDecls.h @@ -9,12 +9,14 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tkIntXlibDecls.h,v 1.4 1999/03/12 03:17:47 stanton Exp $ + * RCS: @(#) $Id: tkIntXlibDecls.h,v 1.5 1999/04/16 01:51:18 stanton Exp $ */ #ifndef _TKINTXLIBDECLS #define _TKINTXLIBDECLS +#include "X11/Xutil.h" + #ifdef BUILD_tk #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT @@ -277,6 +279,74 @@ EXTERN void TkPutImage _ANSI_ARGS_((unsigned long * colors, GC gc, XImage* image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height)); +/* Slot 81 is reserved */ +/* 82 */ +EXTERN Status XParseColor _ANSI_ARGS_((Display * display, + Colormap map, _Xconst char* spec, + XColor * colorPtr)); +/* 83 */ +EXTERN GC XCreateGC _ANSI_ARGS_((Display* display, Drawable d, + unsigned long valuemask, XGCValues* values)); +/* 84 */ +EXTERN void XFreeGC _ANSI_ARGS_((Display* display, GC gc)); +/* 85 */ +EXTERN Atom XInternAtom _ANSI_ARGS_((Display* display, + _Xconst char* atom_name, Bool only_if_exists)); +/* 86 */ +EXTERN void XSetBackground _ANSI_ARGS_((Display* display, GC gc, + unsigned long foreground)); +/* 87 */ +EXTERN void XSetForeground _ANSI_ARGS_((Display* display, GC gc, + unsigned long foreground)); +/* 88 */ +EXTERN void XSetClipMask _ANSI_ARGS_((Display* display, GC gc, + Pixmap pixmap)); +/* 89 */ +EXTERN void XSetClipOrigin _ANSI_ARGS_((Display* display, GC gc, + int clip_x_origin, int clip_y_origin)); +/* 90 */ +EXTERN void XSetTSOrigin _ANSI_ARGS_((Display* display, GC gc, + int ts_x_origin, int ts_y_origin)); +/* 91 */ +EXTERN void XChangeGC _ANSI_ARGS_((Display * d, GC gc, + unsigned long mask, XGCValues * values)); +/* 92 */ +EXTERN void XSetFont _ANSI_ARGS_((Display * display, GC gc, + Font font)); +/* 93 */ +EXTERN void XSetArcMode _ANSI_ARGS_((Display * display, GC gc, + int arc_mode)); +/* 94 */ +EXTERN void XSetStipple _ANSI_ARGS_((Display * display, GC gc, + Pixmap stipple)); +/* 95 */ +EXTERN void XSetFillRule _ANSI_ARGS_((Display * display, GC gc, + int fill_rule)); +/* 96 */ +EXTERN void XSetFillStyle _ANSI_ARGS_((Display * display, GC gc, + int fill_style)); +/* 97 */ +EXTERN void XSetFunction _ANSI_ARGS_((Display * display, GC gc, + int function)); +/* 98 */ +EXTERN void XSetLineAttributes _ANSI_ARGS_((Display * display, + GC gc, unsigned int line_width, + int line_style, int cap_style, + int join_style)); +/* 99 */ +EXTERN int _XInitImageFuncPtrs _ANSI_ARGS_((XImage * image)); +/* 100 */ +EXTERN XIC XCreateIC _ANSI_ARGS_((void)); +/* 101 */ +EXTERN XVisualInfo * XGetVisualInfo _ANSI_ARGS_((Display* display, + long vinfo_mask, XVisualInfo* vinfo_template, + int* nitems_return)); +/* 102 */ +EXTERN void XSetWMClientMachine _ANSI_ARGS_((Display* display, + Window w, XTextProperty* text_prop)); +/* 103 */ +EXTERN Status XStringListToTextProperty _ANSI_ARGS_((char** list, + int count, XTextProperty* text_prop_return)); #endif /* __WIN32__ */ #ifdef MAC_TCL /* Slot 0 is reserved */ @@ -457,6 +527,73 @@ EXTERN void TkPutImage _ANSI_ARGS_((unsigned long * colors, GC gc, XImage* image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height)); +/* 58 */ +EXTERN Status XParseColor _ANSI_ARGS_((Display * display, + Colormap map, _Xconst char* spec, + XColor * colorPtr)); +/* 59 */ +EXTERN GC XCreateGC _ANSI_ARGS_((Display* display, Drawable d, + unsigned long valuemask, XGCValues* values)); +/* 60 */ +EXTERN void XFreeGC _ANSI_ARGS_((Display* display, GC gc)); +/* 61 */ +EXTERN Atom XInternAtom _ANSI_ARGS_((Display* display, + _Xconst char* atom_name, Bool only_if_exists)); +/* 62 */ +EXTERN void XSetBackground _ANSI_ARGS_((Display* display, GC gc, + unsigned long foreground)); +/* 63 */ +EXTERN void XSetForeground _ANSI_ARGS_((Display* display, GC gc, + unsigned long foreground)); +/* 64 */ +EXTERN void XSetClipMask _ANSI_ARGS_((Display* display, GC gc, + Pixmap pixmap)); +/* 65 */ +EXTERN void XSetClipOrigin _ANSI_ARGS_((Display* display, GC gc, + int clip_x_origin, int clip_y_origin)); +/* 66 */ +EXTERN void XSetTSOrigin _ANSI_ARGS_((Display* display, GC gc, + int ts_x_origin, int ts_y_origin)); +/* 67 */ +EXTERN void XChangeGC _ANSI_ARGS_((Display * d, GC gc, + unsigned long mask, XGCValues * values)); +/* 68 */ +EXTERN void XSetFont _ANSI_ARGS_((Display * display, GC gc, + Font font)); +/* 69 */ +EXTERN void XSetArcMode _ANSI_ARGS_((Display * display, GC gc, + int arc_mode)); +/* 70 */ +EXTERN void XSetStipple _ANSI_ARGS_((Display * display, GC gc, + Pixmap stipple)); +/* 71 */ +EXTERN void XSetFillRule _ANSI_ARGS_((Display * display, GC gc, + int fill_rule)); +/* 72 */ +EXTERN void XSetFillStyle _ANSI_ARGS_((Display * display, GC gc, + int fill_style)); +/* 73 */ +EXTERN void XSetFunction _ANSI_ARGS_((Display * display, GC gc, + int function)); +/* 74 */ +EXTERN void XSetLineAttributes _ANSI_ARGS_((Display * display, + GC gc, unsigned int line_width, + int line_style, int cap_style, + int join_style)); +/* 75 */ +EXTERN int _XInitImageFuncPtrs _ANSI_ARGS_((XImage * image)); +/* 76 */ +EXTERN XIC XCreateIC _ANSI_ARGS_((void)); +/* 77 */ +EXTERN XVisualInfo * XGetVisualInfo _ANSI_ARGS_((Display* display, + long vinfo_mask, XVisualInfo* vinfo_template, + int* nitems_return)); +/* 78 */ +EXTERN void XSetWMClientMachine _ANSI_ARGS_((Display* display, + Window w, XTextProperty* text_prop)); +/* 79 */ +EXTERN Status XStringListToTextProperty _ANSI_ARGS_((char** list, + int count, XTextProperty* text_prop_return)); #endif /* MAC_TCL */ typedef struct TkIntXlibStubs { @@ -545,6 +682,29 @@ typedef struct TkIntXlibStubs { Bool (*xFilterEvent) _ANSI_ARGS_((XEvent* x, Window w)); /* 78 */ int (*xmbLookupString) _ANSI_ARGS_((XIC xi, XKeyPressedEvent* xk, char* c, int i, KeySym* k, Status* s)); /* 79 */ void (*tkPutImage) _ANSI_ARGS_((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; + Status (*xParseColor) _ANSI_ARGS_((Display * display, Colormap map, _Xconst char* spec, XColor * colorPtr)); /* 82 */ + GC (*xCreateGC) _ANSI_ARGS_((Display* display, Drawable d, unsigned long valuemask, XGCValues* values)); /* 83 */ + void (*xFreeGC) _ANSI_ARGS_((Display* display, GC gc)); /* 84 */ + Atom (*xInternAtom) _ANSI_ARGS_((Display* display, _Xconst char* atom_name, Bool only_if_exists)); /* 85 */ + void (*xSetBackground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 86 */ + void (*xSetForeground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 87 */ + void (*xSetClipMask) _ANSI_ARGS_((Display* display, GC gc, Pixmap pixmap)); /* 88 */ + void (*xSetClipOrigin) _ANSI_ARGS_((Display* display, GC gc, int clip_x_origin, int clip_y_origin)); /* 89 */ + void (*xSetTSOrigin) _ANSI_ARGS_((Display* display, GC gc, int ts_x_origin, int ts_y_origin)); /* 90 */ + void (*xChangeGC) _ANSI_ARGS_((Display * d, GC gc, unsigned long mask, XGCValues * values)); /* 91 */ + void (*xSetFont) _ANSI_ARGS_((Display * display, GC gc, Font font)); /* 92 */ + void (*xSetArcMode) _ANSI_ARGS_((Display * display, GC gc, int arc_mode)); /* 93 */ + void (*xSetStipple) _ANSI_ARGS_((Display * display, GC gc, Pixmap stipple)); /* 94 */ + void (*xSetFillRule) _ANSI_ARGS_((Display * display, GC gc, int fill_rule)); /* 95 */ + void (*xSetFillStyle) _ANSI_ARGS_((Display * display, GC gc, int fill_style)); /* 96 */ + void (*xSetFunction) _ANSI_ARGS_((Display * display, GC gc, int function)); /* 97 */ + void (*xSetLineAttributes) _ANSI_ARGS_((Display * display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style)); /* 98 */ + int (*_XInitImageFuncPtrs) _ANSI_ARGS_((XImage * image)); /* 99 */ + XIC (*xCreateIC) _ANSI_ARGS_((void)); /* 100 */ + XVisualInfo * (*xGetVisualInfo) _ANSI_ARGS_((Display* display, long vinfo_mask, XVisualInfo* vinfo_template, int* nitems_return)); /* 101 */ + void (*xSetWMClientMachine) _ANSI_ARGS_((Display* display, Window w, XTextProperty* text_prop)); /* 102 */ + Status (*xStringListToTextProperty) _ANSI_ARGS_((char** list, int count, XTextProperty* text_prop_return)); /* 103 */ #endif /* __WIN32__ */ #ifdef MAC_TCL void *reserved0; @@ -605,6 +765,28 @@ typedef struct TkIntXlibStubs { void (*xUngrabPointer) _ANSI_ARGS_((Display* d, Time t)); /* 55 */ void (*xUnmapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 56 */ void (*tkPutImage) _ANSI_ARGS_((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)); /* 57 */ + Status (*xParseColor) _ANSI_ARGS_((Display * display, Colormap map, _Xconst char* spec, XColor * colorPtr)); /* 58 */ + GC (*xCreateGC) _ANSI_ARGS_((Display* display, Drawable d, unsigned long valuemask, XGCValues* values)); /* 59 */ + void (*xFreeGC) _ANSI_ARGS_((Display* display, GC gc)); /* 60 */ + Atom (*xInternAtom) _ANSI_ARGS_((Display* display, _Xconst char* atom_name, Bool only_if_exists)); /* 61 */ + void (*xSetBackground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 62 */ + void (*xSetForeground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 63 */ + void (*xSetClipMask) _ANSI_ARGS_((Display* display, GC gc, Pixmap pixmap)); /* 64 */ + void (*xSetClipOrigin) _ANSI_ARGS_((Display* display, GC gc, int clip_x_origin, int clip_y_origin)); /* 65 */ + void (*xSetTSOrigin) _ANSI_ARGS_((Display* display, GC gc, int ts_x_origin, int ts_y_origin)); /* 66 */ + void (*xChangeGC) _ANSI_ARGS_((Display * d, GC gc, unsigned long mask, XGCValues * values)); /* 67 */ + void (*xSetFont) _ANSI_ARGS_((Display * display, GC gc, Font font)); /* 68 */ + void (*xSetArcMode) _ANSI_ARGS_((Display * display, GC gc, int arc_mode)); /* 69 */ + void (*xSetStipple) _ANSI_ARGS_((Display * display, GC gc, Pixmap stipple)); /* 70 */ + void (*xSetFillRule) _ANSI_ARGS_((Display * display, GC gc, int fill_rule)); /* 71 */ + void (*xSetFillStyle) _ANSI_ARGS_((Display * display, GC gc, int fill_style)); /* 72 */ + void (*xSetFunction) _ANSI_ARGS_((Display * display, GC gc, int function)); /* 73 */ + void (*xSetLineAttributes) _ANSI_ARGS_((Display * display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style)); /* 74 */ + int (*_XInitImageFuncPtrs) _ANSI_ARGS_((XImage * image)); /* 75 */ + XIC (*xCreateIC) _ANSI_ARGS_((void)); /* 76 */ + XVisualInfo * (*xGetVisualInfo) _ANSI_ARGS_((Display* display, long vinfo_mask, XVisualInfo* vinfo_template, int* nitems_return)); /* 77 */ + void (*xSetWMClientMachine) _ANSI_ARGS_((Display* display, Window w, XTextProperty* text_prop)); /* 78 */ + Status (*xStringListToTextProperty) _ANSI_ARGS_((char** list, int count, XTextProperty* text_prop_return)); /* 79 */ #endif /* MAC_TCL */ } TkIntXlibStubs; @@ -619,555 +801,732 @@ extern TkIntXlibStubs *tkIntXlibStubsPtr; #ifdef __WIN32__ /* Slot 0 is reserved */ #ifndef XGetModifierMapping -#define XGetModifierMapping(d) \ - (tkIntXlibStubsPtr->xGetModifierMapping)(d) /* 1 */ +#define XGetModifierMapping \ + (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */ #endif #ifndef XCreateImage -#define XCreateImage(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4) \ - (tkIntXlibStubsPtr->xCreateImage)(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4) /* 2 */ +#define XCreateImage \ + (tkIntXlibStubsPtr->xCreateImage) /* 2 */ #endif #ifndef XGetImage -#define XGetImage(d, dr, i1, i2, ui1, ui2, ul, i3) \ - (tkIntXlibStubsPtr->xGetImage)(d, dr, i1, i2, ui1, ui2, ul, i3) /* 3 */ +#define XGetImage \ + (tkIntXlibStubsPtr->xGetImage) /* 3 */ #endif #ifndef XGetAtomName -#define XGetAtomName(d, a) \ - (tkIntXlibStubsPtr->xGetAtomName)(d, a) /* 4 */ +#define XGetAtomName \ + (tkIntXlibStubsPtr->xGetAtomName) /* 4 */ #endif #ifndef XKeysymToString -#define XKeysymToString(k) \ - (tkIntXlibStubsPtr->xKeysymToString)(k) /* 5 */ +#define XKeysymToString \ + (tkIntXlibStubsPtr->xKeysymToString) /* 5 */ #endif #ifndef XCreateColormap -#define XCreateColormap(d, w, v, i) \ - (tkIntXlibStubsPtr->xCreateColormap)(d, w, v, i) /* 6 */ +#define XCreateColormap \ + (tkIntXlibStubsPtr->xCreateColormap) /* 6 */ #endif #ifndef XCreatePixmapCursor -#define XCreatePixmapCursor(d, p1, p2, x1, x2, ui1, ui2) \ - (tkIntXlibStubsPtr->xCreatePixmapCursor)(d, p1, p2, x1, x2, ui1, ui2) /* 7 */ +#define XCreatePixmapCursor \ + (tkIntXlibStubsPtr->xCreatePixmapCursor) /* 7 */ #endif #ifndef XCreateGlyphCursor -#define XCreateGlyphCursor(d, f1, f2, ui1, ui2, x1, x2) \ - (tkIntXlibStubsPtr->xCreateGlyphCursor)(d, f1, f2, ui1, ui2, x1, x2) /* 8 */ +#define XCreateGlyphCursor \ + (tkIntXlibStubsPtr->xCreateGlyphCursor) /* 8 */ #endif #ifndef XGContextFromGC -#define XGContextFromGC(g) \ - (tkIntXlibStubsPtr->xGContextFromGC)(g) /* 9 */ +#define XGContextFromGC \ + (tkIntXlibStubsPtr->xGContextFromGC) /* 9 */ #endif #ifndef XListHosts -#define XListHosts(d, i, b) \ - (tkIntXlibStubsPtr->xListHosts)(d, i, b) /* 10 */ +#define XListHosts \ + (tkIntXlibStubsPtr->xListHosts) /* 10 */ #endif #ifndef XKeycodeToKeysym -#define XKeycodeToKeysym(d, k, i) \ - (tkIntXlibStubsPtr->xKeycodeToKeysym)(d, k, i) /* 11 */ +#define XKeycodeToKeysym \ + (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 11 */ #endif #ifndef XStringToKeysym -#define XStringToKeysym(c) \ - (tkIntXlibStubsPtr->xStringToKeysym)(c) /* 12 */ +#define XStringToKeysym \ + (tkIntXlibStubsPtr->xStringToKeysym) /* 12 */ #endif #ifndef XRootWindow -#define XRootWindow(d, i) \ - (tkIntXlibStubsPtr->xRootWindow)(d, i) /* 13 */ +#define XRootWindow \ + (tkIntXlibStubsPtr->xRootWindow) /* 13 */ #endif #ifndef XSetErrorHandler -#define XSetErrorHandler(x) \ - (tkIntXlibStubsPtr->xSetErrorHandler)(x) /* 14 */ +#define XSetErrorHandler \ + (tkIntXlibStubsPtr->xSetErrorHandler) /* 14 */ #endif #ifndef XIconifyWindow -#define XIconifyWindow(d, w, i) \ - (tkIntXlibStubsPtr->xIconifyWindow)(d, w, i) /* 15 */ +#define XIconifyWindow \ + (tkIntXlibStubsPtr->xIconifyWindow) /* 15 */ #endif #ifndef XWithdrawWindow -#define XWithdrawWindow(d, w, i) \ - (tkIntXlibStubsPtr->xWithdrawWindow)(d, w, i) /* 16 */ +#define XWithdrawWindow \ + (tkIntXlibStubsPtr->xWithdrawWindow) /* 16 */ #endif #ifndef XGetWMColormapWindows -#define XGetWMColormapWindows(d, w, wpp, ip) \ - (tkIntXlibStubsPtr->xGetWMColormapWindows)(d, w, wpp, ip) /* 17 */ +#define XGetWMColormapWindows \ + (tkIntXlibStubsPtr->xGetWMColormapWindows) /* 17 */ #endif #ifndef XAllocColor -#define XAllocColor(d, c, xp) \ - (tkIntXlibStubsPtr->xAllocColor)(d, c, xp) /* 18 */ +#define XAllocColor \ + (tkIntXlibStubsPtr->xAllocColor) /* 18 */ #endif #ifndef XBell -#define XBell(d, i) \ - (tkIntXlibStubsPtr->xBell)(d, i) /* 19 */ +#define XBell \ + (tkIntXlibStubsPtr->xBell) /* 19 */ #endif #ifndef XChangeProperty -#define XChangeProperty(d, w, a1, a2, i1, i2, c, i3) \ - (tkIntXlibStubsPtr->xChangeProperty)(d, w, a1, a2, i1, i2, c, i3) /* 20 */ +#define XChangeProperty \ + (tkIntXlibStubsPtr->xChangeProperty) /* 20 */ #endif #ifndef XChangeWindowAttributes -#define XChangeWindowAttributes(d, w, ul, x) \ - (tkIntXlibStubsPtr->xChangeWindowAttributes)(d, w, ul, x) /* 21 */ +#define XChangeWindowAttributes \ + (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 21 */ #endif #ifndef XClearWindow -#define XClearWindow(d, w) \ - (tkIntXlibStubsPtr->xClearWindow)(d, w) /* 22 */ +#define XClearWindow \ + (tkIntXlibStubsPtr->xClearWindow) /* 22 */ #endif #ifndef XConfigureWindow -#define XConfigureWindow(d, w, i, x) \ - (tkIntXlibStubsPtr->xConfigureWindow)(d, w, i, x) /* 23 */ +#define XConfigureWindow \ + (tkIntXlibStubsPtr->xConfigureWindow) /* 23 */ #endif #ifndef XCopyArea -#define XCopyArea(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4) \ - (tkIntXlibStubsPtr->xCopyArea)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4) /* 24 */ +#define XCopyArea \ + (tkIntXlibStubsPtr->xCopyArea) /* 24 */ #endif #ifndef XCopyPlane -#define XCopyPlane(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul) \ - (tkIntXlibStubsPtr->xCopyPlane)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul) /* 25 */ +#define XCopyPlane \ + (tkIntXlibStubsPtr->xCopyPlane) /* 25 */ #endif #ifndef XCreateBitmapFromData -#define XCreateBitmapFromData(display, d, data, width, height) \ - (tkIntXlibStubsPtr->xCreateBitmapFromData)(display, d, data, width, height) /* 26 */ +#define XCreateBitmapFromData \ + (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 26 */ #endif #ifndef XDefineCursor -#define XDefineCursor(d, w, c) \ - (tkIntXlibStubsPtr->xDefineCursor)(d, w, c) /* 27 */ +#define XDefineCursor \ + (tkIntXlibStubsPtr->xDefineCursor) /* 27 */ #endif #ifndef XDeleteProperty -#define XDeleteProperty(d, w, a) \ - (tkIntXlibStubsPtr->xDeleteProperty)(d, w, a) /* 28 */ +#define XDeleteProperty \ + (tkIntXlibStubsPtr->xDeleteProperty) /* 28 */ #endif #ifndef XDestroyWindow -#define XDestroyWindow(d, w) \ - (tkIntXlibStubsPtr->xDestroyWindow)(d, w) /* 29 */ +#define XDestroyWindow \ + (tkIntXlibStubsPtr->xDestroyWindow) /* 29 */ #endif #ifndef XDrawArc -#define XDrawArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) \ - (tkIntXlibStubsPtr->xDrawArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4) /* 30 */ +#define XDrawArc \ + (tkIntXlibStubsPtr->xDrawArc) /* 30 */ #endif #ifndef XDrawLines -#define XDrawLines(d, dr, g, x, i1, i2) \ - (tkIntXlibStubsPtr->xDrawLines)(d, dr, g, x, i1, i2) /* 31 */ +#define XDrawLines \ + (tkIntXlibStubsPtr->xDrawLines) /* 31 */ #endif #ifndef XDrawRectangle -#define XDrawRectangle(d, dr, g, i1, i2, ui1, ui2) \ - (tkIntXlibStubsPtr->xDrawRectangle)(d, dr, g, i1, i2, ui1, ui2) /* 32 */ +#define XDrawRectangle \ + (tkIntXlibStubsPtr->xDrawRectangle) /* 32 */ #endif #ifndef XFillArc -#define XFillArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) \ - (tkIntXlibStubsPtr->xFillArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4) /* 33 */ +#define XFillArc \ + (tkIntXlibStubsPtr->xFillArc) /* 33 */ #endif #ifndef XFillPolygon -#define XFillPolygon(d, dr, g, x, i1, i2, i3) \ - (tkIntXlibStubsPtr->xFillPolygon)(d, dr, g, x, i1, i2, i3) /* 34 */ +#define XFillPolygon \ + (tkIntXlibStubsPtr->xFillPolygon) /* 34 */ #endif #ifndef XFillRectangles -#define XFillRectangles(d, dr, g, x, i) \ - (tkIntXlibStubsPtr->xFillRectangles)(d, dr, g, x, i) /* 35 */ +#define XFillRectangles \ + (tkIntXlibStubsPtr->xFillRectangles) /* 35 */ #endif #ifndef XForceScreenSaver -#define XForceScreenSaver(d, i) \ - (tkIntXlibStubsPtr->xForceScreenSaver)(d, i) /* 36 */ +#define XForceScreenSaver \ + (tkIntXlibStubsPtr->xForceScreenSaver) /* 36 */ #endif #ifndef XFreeColormap -#define XFreeColormap(d, c) \ - (tkIntXlibStubsPtr->xFreeColormap)(d, c) /* 37 */ +#define XFreeColormap \ + (tkIntXlibStubsPtr->xFreeColormap) /* 37 */ #endif #ifndef XFreeColors -#define XFreeColors(d, c, ulp, i, ul) \ - (tkIntXlibStubsPtr->xFreeColors)(d, c, ulp, i, ul) /* 38 */ +#define XFreeColors \ + (tkIntXlibStubsPtr->xFreeColors) /* 38 */ #endif #ifndef XFreeCursor -#define XFreeCursor(d, c) \ - (tkIntXlibStubsPtr->xFreeCursor)(d, c) /* 39 */ +#define XFreeCursor \ + (tkIntXlibStubsPtr->xFreeCursor) /* 39 */ #endif #ifndef XFreeModifiermap -#define XFreeModifiermap(x) \ - (tkIntXlibStubsPtr->xFreeModifiermap)(x) /* 40 */ +#define XFreeModifiermap \ + (tkIntXlibStubsPtr->xFreeModifiermap) /* 40 */ #endif #ifndef XGetGeometry -#define XGetGeometry(d, dr, w, i1, i2, ui1, ui2, ui3, ui4) \ - (tkIntXlibStubsPtr->xGetGeometry)(d, dr, w, i1, i2, ui1, ui2, ui3, ui4) /* 41 */ +#define XGetGeometry \ + (tkIntXlibStubsPtr->xGetGeometry) /* 41 */ #endif #ifndef XGetInputFocus -#define XGetInputFocus(d, w, i) \ - (tkIntXlibStubsPtr->xGetInputFocus)(d, w, i) /* 42 */ +#define XGetInputFocus \ + (tkIntXlibStubsPtr->xGetInputFocus) /* 42 */ #endif #ifndef XGetWindowProperty -#define XGetWindowProperty(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp) \ - (tkIntXlibStubsPtr->xGetWindowProperty)(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp) /* 43 */ +#define XGetWindowProperty \ + (tkIntXlibStubsPtr->xGetWindowProperty) /* 43 */ #endif #ifndef XGetWindowAttributes -#define XGetWindowAttributes(d, w, x) \ - (tkIntXlibStubsPtr->xGetWindowAttributes)(d, w, x) /* 44 */ +#define XGetWindowAttributes \ + (tkIntXlibStubsPtr->xGetWindowAttributes) /* 44 */ #endif #ifndef XGrabKeyboard -#define XGrabKeyboard(d, w, b, i1, i2, t) \ - (tkIntXlibStubsPtr->xGrabKeyboard)(d, w, b, i1, i2, t) /* 45 */ +#define XGrabKeyboard \ + (tkIntXlibStubsPtr->xGrabKeyboard) /* 45 */ #endif #ifndef XGrabPointer -#define XGrabPointer(d, w1, b, ui, i1, i2, w2, c, t) \ - (tkIntXlibStubsPtr->xGrabPointer)(d, w1, b, ui, i1, i2, w2, c, t) /* 46 */ +#define XGrabPointer \ + (tkIntXlibStubsPtr->xGrabPointer) /* 46 */ #endif #ifndef XKeysymToKeycode -#define XKeysymToKeycode(d, k) \ - (tkIntXlibStubsPtr->xKeysymToKeycode)(d, k) /* 47 */ +#define XKeysymToKeycode \ + (tkIntXlibStubsPtr->xKeysymToKeycode) /* 47 */ #endif #ifndef XLookupColor -#define XLookupColor(d, c1, c2, x1, x2) \ - (tkIntXlibStubsPtr->xLookupColor)(d, c1, c2, x1, x2) /* 48 */ +#define XLookupColor \ + (tkIntXlibStubsPtr->xLookupColor) /* 48 */ #endif #ifndef XMapWindow -#define XMapWindow(d, w) \ - (tkIntXlibStubsPtr->xMapWindow)(d, w) /* 49 */ +#define XMapWindow \ + (tkIntXlibStubsPtr->xMapWindow) /* 49 */ #endif #ifndef XMoveResizeWindow -#define XMoveResizeWindow(d, w, i1, i2, ui1, ui2) \ - (tkIntXlibStubsPtr->xMoveResizeWindow)(d, w, i1, i2, ui1, ui2) /* 50 */ +#define XMoveResizeWindow \ + (tkIntXlibStubsPtr->xMoveResizeWindow) /* 50 */ #endif #ifndef XMoveWindow -#define XMoveWindow(d, w, i1, i2) \ - (tkIntXlibStubsPtr->xMoveWindow)(d, w, i1, i2) /* 51 */ +#define XMoveWindow \ + (tkIntXlibStubsPtr->xMoveWindow) /* 51 */ #endif #ifndef XNextEvent -#define XNextEvent(d, x) \ - (tkIntXlibStubsPtr->xNextEvent)(d, x) /* 52 */ +#define XNextEvent \ + (tkIntXlibStubsPtr->xNextEvent) /* 52 */ #endif #ifndef XPutBackEvent -#define XPutBackEvent(d, x) \ - (tkIntXlibStubsPtr->xPutBackEvent)(d, x) /* 53 */ +#define XPutBackEvent \ + (tkIntXlibStubsPtr->xPutBackEvent) /* 53 */ #endif #ifndef XQueryColors -#define XQueryColors(d, c, x, i) \ - (tkIntXlibStubsPtr->xQueryColors)(d, c, x, i) /* 54 */ +#define XQueryColors \ + (tkIntXlibStubsPtr->xQueryColors) /* 54 */ #endif #ifndef XQueryPointer -#define XQueryPointer(d, w1, w2, w3, i1, i2, i3, i4, ui) \ - (tkIntXlibStubsPtr->xQueryPointer)(d, w1, w2, w3, i1, i2, i3, i4, ui) /* 55 */ +#define XQueryPointer \ + (tkIntXlibStubsPtr->xQueryPointer) /* 55 */ #endif #ifndef XQueryTree -#define XQueryTree(d, w1, w2, w3, w4, ui) \ - (tkIntXlibStubsPtr->xQueryTree)(d, w1, w2, w3, w4, ui) /* 56 */ +#define XQueryTree \ + (tkIntXlibStubsPtr->xQueryTree) /* 56 */ #endif #ifndef XRaiseWindow -#define XRaiseWindow(d, w) \ - (tkIntXlibStubsPtr->xRaiseWindow)(d, w) /* 57 */ +#define XRaiseWindow \ + (tkIntXlibStubsPtr->xRaiseWindow) /* 57 */ #endif #ifndef XRefreshKeyboardMapping -#define XRefreshKeyboardMapping(x) \ - (tkIntXlibStubsPtr->xRefreshKeyboardMapping)(x) /* 58 */ +#define XRefreshKeyboardMapping \ + (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 58 */ #endif #ifndef XResizeWindow -#define XResizeWindow(d, w, ui1, ui2) \ - (tkIntXlibStubsPtr->xResizeWindow)(d, w, ui1, ui2) /* 59 */ +#define XResizeWindow \ + (tkIntXlibStubsPtr->xResizeWindow) /* 59 */ #endif #ifndef XSelectInput -#define XSelectInput(d, w, l) \ - (tkIntXlibStubsPtr->xSelectInput)(d, w, l) /* 60 */ +#define XSelectInput \ + (tkIntXlibStubsPtr->xSelectInput) /* 60 */ #endif #ifndef XSendEvent -#define XSendEvent(d, w, b, l, x) \ - (tkIntXlibStubsPtr->xSendEvent)(d, w, b, l, x) /* 61 */ +#define XSendEvent \ + (tkIntXlibStubsPtr->xSendEvent) /* 61 */ #endif #ifndef XSetCommand -#define XSetCommand(d, w, c, i) \ - (tkIntXlibStubsPtr->xSetCommand)(d, w, c, i) /* 62 */ +#define XSetCommand \ + (tkIntXlibStubsPtr->xSetCommand) /* 62 */ #endif #ifndef XSetIconName -#define XSetIconName(d, w, c) \ - (tkIntXlibStubsPtr->xSetIconName)(d, w, c) /* 63 */ +#define XSetIconName \ + (tkIntXlibStubsPtr->xSetIconName) /* 63 */ #endif #ifndef XSetInputFocus -#define XSetInputFocus(d, w, i, t) \ - (tkIntXlibStubsPtr->xSetInputFocus)(d, w, i, t) /* 64 */ +#define XSetInputFocus \ + (tkIntXlibStubsPtr->xSetInputFocus) /* 64 */ #endif #ifndef XSetSelectionOwner -#define XSetSelectionOwner(d, a, w, t) \ - (tkIntXlibStubsPtr->xSetSelectionOwner)(d, a, w, t) /* 65 */ +#define XSetSelectionOwner \ + (tkIntXlibStubsPtr->xSetSelectionOwner) /* 65 */ #endif #ifndef XSetWindowBackground -#define XSetWindowBackground(d, w, ul) \ - (tkIntXlibStubsPtr->xSetWindowBackground)(d, w, ul) /* 66 */ +#define XSetWindowBackground \ + (tkIntXlibStubsPtr->xSetWindowBackground) /* 66 */ #endif #ifndef XSetWindowBackgroundPixmap -#define XSetWindowBackgroundPixmap(d, w, p) \ - (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap)(d, w, p) /* 67 */ +#define XSetWindowBackgroundPixmap \ + (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 67 */ #endif #ifndef XSetWindowBorder -#define XSetWindowBorder(d, w, ul) \ - (tkIntXlibStubsPtr->xSetWindowBorder)(d, w, ul) /* 68 */ +#define XSetWindowBorder \ + (tkIntXlibStubsPtr->xSetWindowBorder) /* 68 */ #endif #ifndef XSetWindowBorderPixmap -#define XSetWindowBorderPixmap(d, w, p) \ - (tkIntXlibStubsPtr->xSetWindowBorderPixmap)(d, w, p) /* 69 */ +#define XSetWindowBorderPixmap \ + (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 69 */ #endif #ifndef XSetWindowBorderWidth -#define XSetWindowBorderWidth(d, w, ui) \ - (tkIntXlibStubsPtr->xSetWindowBorderWidth)(d, w, ui) /* 70 */ +#define XSetWindowBorderWidth \ + (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 70 */ #endif #ifndef XSetWindowColormap -#define XSetWindowColormap(d, w, c) \ - (tkIntXlibStubsPtr->xSetWindowColormap)(d, w, c) /* 71 */ +#define XSetWindowColormap \ + (tkIntXlibStubsPtr->xSetWindowColormap) /* 71 */ #endif #ifndef XTranslateCoordinates -#define XTranslateCoordinates(d, w1, w2, i1, i2, i3, i4, w3) \ - (tkIntXlibStubsPtr->xTranslateCoordinates)(d, w1, w2, i1, i2, i3, i4, w3) /* 72 */ +#define XTranslateCoordinates \ + (tkIntXlibStubsPtr->xTranslateCoordinates) /* 72 */ #endif #ifndef XUngrabKeyboard -#define XUngrabKeyboard(d, t) \ - (tkIntXlibStubsPtr->xUngrabKeyboard)(d, t) /* 73 */ +#define XUngrabKeyboard \ + (tkIntXlibStubsPtr->xUngrabKeyboard) /* 73 */ #endif #ifndef XUngrabPointer -#define XUngrabPointer(d, t) \ - (tkIntXlibStubsPtr->xUngrabPointer)(d, t) /* 74 */ +#define XUngrabPointer \ + (tkIntXlibStubsPtr->xUngrabPointer) /* 74 */ #endif #ifndef XUnmapWindow -#define XUnmapWindow(d, w) \ - (tkIntXlibStubsPtr->xUnmapWindow)(d, w) /* 75 */ +#define XUnmapWindow \ + (tkIntXlibStubsPtr->xUnmapWindow) /* 75 */ #endif #ifndef XWindowEvent -#define XWindowEvent(d, w, l, x) \ - (tkIntXlibStubsPtr->xWindowEvent)(d, w, l, x) /* 76 */ +#define XWindowEvent \ + (tkIntXlibStubsPtr->xWindowEvent) /* 76 */ #endif #ifndef XDestroyIC -#define XDestroyIC(x) \ - (tkIntXlibStubsPtr->xDestroyIC)(x) /* 77 */ +#define XDestroyIC \ + (tkIntXlibStubsPtr->xDestroyIC) /* 77 */ #endif #ifndef XFilterEvent -#define XFilterEvent(x, w) \ - (tkIntXlibStubsPtr->xFilterEvent)(x, w) /* 78 */ +#define XFilterEvent \ + (tkIntXlibStubsPtr->xFilterEvent) /* 78 */ #endif #ifndef XmbLookupString -#define XmbLookupString(xi, xk, c, i, k, s) \ - (tkIntXlibStubsPtr->xmbLookupString)(xi, xk, c, i, k, s) /* 79 */ +#define XmbLookupString \ + (tkIntXlibStubsPtr->xmbLookupString) /* 79 */ #endif #ifndef TkPutImage -#define TkPutImage(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height) \ - (tkIntXlibStubsPtr->tkPutImage)(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height) /* 80 */ +#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 #endif /* __WIN32__ */ #ifdef MAC_TCL /* Slot 0 is reserved */ #ifndef XGetModifierMapping -#define XGetModifierMapping(d) \ - (tkIntXlibStubsPtr->xGetModifierMapping)(d) /* 1 */ +#define XGetModifierMapping \ + (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */ #endif #ifndef XCreateImage -#define XCreateImage(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4) \ - (tkIntXlibStubsPtr->xCreateImage)(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4) /* 2 */ +#define XCreateImage \ + (tkIntXlibStubsPtr->xCreateImage) /* 2 */ #endif #ifndef XGetImage -#define XGetImage(d, dr, i1, i2, ui1, ui2, ul, i3) \ - (tkIntXlibStubsPtr->xGetImage)(d, dr, i1, i2, ui1, ui2, ul, i3) /* 3 */ +#define XGetImage \ + (tkIntXlibStubsPtr->xGetImage) /* 3 */ #endif #ifndef XGetAtomName -#define XGetAtomName(d, a) \ - (tkIntXlibStubsPtr->xGetAtomName)(d, a) /* 4 */ +#define XGetAtomName \ + (tkIntXlibStubsPtr->xGetAtomName) /* 4 */ #endif #ifndef XKeysymToString -#define XKeysymToString(k) \ - (tkIntXlibStubsPtr->xKeysymToString)(k) /* 5 */ +#define XKeysymToString \ + (tkIntXlibStubsPtr->xKeysymToString) /* 5 */ #endif #ifndef XCreateColormap -#define XCreateColormap(d, w, v, i) \ - (tkIntXlibStubsPtr->xCreateColormap)(d, w, v, i) /* 6 */ +#define XCreateColormap \ + (tkIntXlibStubsPtr->xCreateColormap) /* 6 */ #endif #ifndef XGContextFromGC -#define XGContextFromGC(g) \ - (tkIntXlibStubsPtr->xGContextFromGC)(g) /* 7 */ +#define XGContextFromGC \ + (tkIntXlibStubsPtr->xGContextFromGC) /* 7 */ #endif #ifndef XKeycodeToKeysym -#define XKeycodeToKeysym(d, k, i) \ - (tkIntXlibStubsPtr->xKeycodeToKeysym)(d, k, i) /* 8 */ +#define XKeycodeToKeysym \ + (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 8 */ #endif #ifndef XStringToKeysym -#define XStringToKeysym(c) \ - (tkIntXlibStubsPtr->xStringToKeysym)(c) /* 9 */ +#define XStringToKeysym \ + (tkIntXlibStubsPtr->xStringToKeysym) /* 9 */ #endif #ifndef XRootWindow -#define XRootWindow(d, i) \ - (tkIntXlibStubsPtr->xRootWindow)(d, i) /* 10 */ +#define XRootWindow \ + (tkIntXlibStubsPtr->xRootWindow) /* 10 */ #endif #ifndef XSetErrorHandler -#define XSetErrorHandler(x) \ - (tkIntXlibStubsPtr->xSetErrorHandler)(x) /* 11 */ +#define XSetErrorHandler \ + (tkIntXlibStubsPtr->xSetErrorHandler) /* 11 */ #endif #ifndef XAllocColor -#define XAllocColor(d, c, xp) \ - (tkIntXlibStubsPtr->xAllocColor)(d, c, xp) /* 12 */ +#define XAllocColor \ + (tkIntXlibStubsPtr->xAllocColor) /* 12 */ #endif #ifndef XBell -#define XBell(d, i) \ - (tkIntXlibStubsPtr->xBell)(d, i) /* 13 */ +#define XBell \ + (tkIntXlibStubsPtr->xBell) /* 13 */ #endif #ifndef XChangeProperty -#define XChangeProperty(d, w, a, a, i1, i2, c, i3) \ - (tkIntXlibStubsPtr->xChangeProperty)(d, w, a, a, i1, i2, c, i3) /* 14 */ +#define XChangeProperty \ + (tkIntXlibStubsPtr->xChangeProperty) /* 14 */ #endif #ifndef XChangeWindowAttributes -#define XChangeWindowAttributes(d, w, ul, x) \ - (tkIntXlibStubsPtr->xChangeWindowAttributes)(d, w, ul, x) /* 15 */ +#define XChangeWindowAttributes \ + (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 15 */ #endif #ifndef XConfigureWindow -#define XConfigureWindow(d, w, i, x) \ - (tkIntXlibStubsPtr->xConfigureWindow)(d, w, i, x) /* 16 */ +#define XConfigureWindow \ + (tkIntXlibStubsPtr->xConfigureWindow) /* 16 */ #endif #ifndef XCopyArea -#define XCopyArea(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4) \ - (tkIntXlibStubsPtr->xCopyArea)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4) /* 17 */ +#define XCopyArea \ + (tkIntXlibStubsPtr->xCopyArea) /* 17 */ #endif #ifndef XCopyPlane -#define XCopyPlane(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul) \ - (tkIntXlibStubsPtr->xCopyPlane)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul) /* 18 */ +#define XCopyPlane \ + (tkIntXlibStubsPtr->xCopyPlane) /* 18 */ #endif #ifndef XCreateBitmapFromData -#define XCreateBitmapFromData(display, d, data, width, height) \ - (tkIntXlibStubsPtr->xCreateBitmapFromData)(display, d, data, width, height) /* 19 */ +#define XCreateBitmapFromData \ + (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 19 */ #endif #ifndef XDefineCursor -#define XDefineCursor(d, w, c) \ - (tkIntXlibStubsPtr->xDefineCursor)(d, w, c) /* 20 */ +#define XDefineCursor \ + (tkIntXlibStubsPtr->xDefineCursor) /* 20 */ #endif #ifndef XDestroyWindow -#define XDestroyWindow(d, w) \ - (tkIntXlibStubsPtr->xDestroyWindow)(d, w) /* 21 */ +#define XDestroyWindow \ + (tkIntXlibStubsPtr->xDestroyWindow) /* 21 */ #endif #ifndef XDrawArc -#define XDrawArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) \ - (tkIntXlibStubsPtr->xDrawArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4) /* 22 */ +#define XDrawArc \ + (tkIntXlibStubsPtr->xDrawArc) /* 22 */ #endif #ifndef XDrawLines -#define XDrawLines(d, dr, g, x, i1, i2) \ - (tkIntXlibStubsPtr->xDrawLines)(d, dr, g, x, i1, i2) /* 23 */ +#define XDrawLines \ + (tkIntXlibStubsPtr->xDrawLines) /* 23 */ #endif #ifndef XDrawRectangle -#define XDrawRectangle(d, dr, g, i1, i2, ui1, ui2) \ - (tkIntXlibStubsPtr->xDrawRectangle)(d, dr, g, i1, i2, ui1, ui2) /* 24 */ +#define XDrawRectangle \ + (tkIntXlibStubsPtr->xDrawRectangle) /* 24 */ #endif #ifndef XFillArc -#define XFillArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) \ - (tkIntXlibStubsPtr->xFillArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4) /* 25 */ +#define XFillArc \ + (tkIntXlibStubsPtr->xFillArc) /* 25 */ #endif #ifndef XFillPolygon -#define XFillPolygon(d, dr, g, x, i1, i2, i3) \ - (tkIntXlibStubsPtr->xFillPolygon)(d, dr, g, x, i1, i2, i3) /* 26 */ +#define XFillPolygon \ + (tkIntXlibStubsPtr->xFillPolygon) /* 26 */ #endif #ifndef XFillRectangles -#define XFillRectangles(d, dr, g, x, i) \ - (tkIntXlibStubsPtr->xFillRectangles)(d, dr, g, x, i) /* 27 */ +#define XFillRectangles \ + (tkIntXlibStubsPtr->xFillRectangles) /* 27 */ #endif #ifndef XFreeColormap -#define XFreeColormap(d, c) \ - (tkIntXlibStubsPtr->xFreeColormap)(d, c) /* 28 */ +#define XFreeColormap \ + (tkIntXlibStubsPtr->xFreeColormap) /* 28 */ #endif #ifndef XFreeColors -#define XFreeColors(d, c, ulp, i, ul) \ - (tkIntXlibStubsPtr->xFreeColors)(d, c, ulp, i, ul) /* 29 */ +#define XFreeColors \ + (tkIntXlibStubsPtr->xFreeColors) /* 29 */ #endif #ifndef XFreeModifiermap -#define XFreeModifiermap(x) \ - (tkIntXlibStubsPtr->xFreeModifiermap)(x) /* 30 */ +#define XFreeModifiermap \ + (tkIntXlibStubsPtr->xFreeModifiermap) /* 30 */ #endif #ifndef XGetGeometry -#define XGetGeometry(d, dr, w, i1, i2, ui1, ui2, ui3, ui4) \ - (tkIntXlibStubsPtr->xGetGeometry)(d, dr, w, i1, i2, ui1, ui2, ui3, ui4) /* 31 */ +#define XGetGeometry \ + (tkIntXlibStubsPtr->xGetGeometry) /* 31 */ #endif #ifndef XGetWindowProperty -#define XGetWindowProperty(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp) \ - (tkIntXlibStubsPtr->xGetWindowProperty)(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp) /* 32 */ +#define XGetWindowProperty \ + (tkIntXlibStubsPtr->xGetWindowProperty) /* 32 */ #endif #ifndef XGrabKeyboard -#define XGrabKeyboard(d, w, b, i1, i2, t) \ - (tkIntXlibStubsPtr->xGrabKeyboard)(d, w, b, i1, i2, t) /* 33 */ +#define XGrabKeyboard \ + (tkIntXlibStubsPtr->xGrabKeyboard) /* 33 */ #endif #ifndef XGrabPointer -#define XGrabPointer(d, w1, b, ui, i1, i2, w2, c, t) \ - (tkIntXlibStubsPtr->xGrabPointer)(d, w1, b, ui, i1, i2, w2, c, t) /* 34 */ +#define XGrabPointer \ + (tkIntXlibStubsPtr->xGrabPointer) /* 34 */ #endif #ifndef XKeysymToKeycode -#define XKeysymToKeycode(d, k) \ - (tkIntXlibStubsPtr->xKeysymToKeycode)(d, k) /* 35 */ +#define XKeysymToKeycode \ + (tkIntXlibStubsPtr->xKeysymToKeycode) /* 35 */ #endif #ifndef XMapWindow -#define XMapWindow(d, w) \ - (tkIntXlibStubsPtr->xMapWindow)(d, w) /* 36 */ +#define XMapWindow \ + (tkIntXlibStubsPtr->xMapWindow) /* 36 */ #endif #ifndef XMoveResizeWindow -#define XMoveResizeWindow(d, w, i1, i2, ui1, ui2) \ - (tkIntXlibStubsPtr->xMoveResizeWindow)(d, w, i1, i2, ui1, ui2) /* 37 */ +#define XMoveResizeWindow \ + (tkIntXlibStubsPtr->xMoveResizeWindow) /* 37 */ #endif #ifndef XMoveWindow -#define XMoveWindow(d, w, i1, i2) \ - (tkIntXlibStubsPtr->xMoveWindow)(d, w, i1, i2) /* 38 */ +#define XMoveWindow \ + (tkIntXlibStubsPtr->xMoveWindow) /* 38 */ #endif #ifndef XQueryPointer -#define XQueryPointer(d, w1, w2, w3, i1, i2, i3, i4, ui) \ - (tkIntXlibStubsPtr->xQueryPointer)(d, w1, w2, w3, i1, i2, i3, i4, ui) /* 39 */ +#define XQueryPointer \ + (tkIntXlibStubsPtr->xQueryPointer) /* 39 */ #endif #ifndef XRaiseWindow -#define XRaiseWindow(d, w) \ - (tkIntXlibStubsPtr->xRaiseWindow)(d, w) /* 40 */ +#define XRaiseWindow \ + (tkIntXlibStubsPtr->xRaiseWindow) /* 40 */ #endif #ifndef XRefreshKeyboardMapping -#define XRefreshKeyboardMapping(x) \ - (tkIntXlibStubsPtr->xRefreshKeyboardMapping)(x) /* 41 */ +#define XRefreshKeyboardMapping \ + (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 41 */ #endif #ifndef XResizeWindow -#define XResizeWindow(d, w, ui1, ui2) \ - (tkIntXlibStubsPtr->xResizeWindow)(d, w, ui1, ui2) /* 42 */ +#define XResizeWindow \ + (tkIntXlibStubsPtr->xResizeWindow) /* 42 */ #endif #ifndef XSelectInput -#define XSelectInput(d, w, l) \ - (tkIntXlibStubsPtr->xSelectInput)(d, w, l) /* 43 */ +#define XSelectInput \ + (tkIntXlibStubsPtr->xSelectInput) /* 43 */ #endif #ifndef XSendEvent -#define XSendEvent(d, w, b, l, x) \ - (tkIntXlibStubsPtr->xSendEvent)(d, w, b, l, x) /* 44 */ +#define XSendEvent \ + (tkIntXlibStubsPtr->xSendEvent) /* 44 */ #endif #ifndef XSetIconName -#define XSetIconName(d, w, c) \ - (tkIntXlibStubsPtr->xSetIconName)(d, w, c) /* 45 */ +#define XSetIconName \ + (tkIntXlibStubsPtr->xSetIconName) /* 45 */ #endif #ifndef XSetInputFocus -#define XSetInputFocus(d, w, i, t) \ - (tkIntXlibStubsPtr->xSetInputFocus)(d, w, i, t) /* 46 */ +#define XSetInputFocus \ + (tkIntXlibStubsPtr->xSetInputFocus) /* 46 */ #endif #ifndef XSetSelectionOwner -#define XSetSelectionOwner(d, a, w, t) \ - (tkIntXlibStubsPtr->xSetSelectionOwner)(d, a, w, t) /* 47 */ +#define XSetSelectionOwner \ + (tkIntXlibStubsPtr->xSetSelectionOwner) /* 47 */ #endif #ifndef XSetWindowBackground -#define XSetWindowBackground(d, w, ul) \ - (tkIntXlibStubsPtr->xSetWindowBackground)(d, w, ul) /* 48 */ +#define XSetWindowBackground \ + (tkIntXlibStubsPtr->xSetWindowBackground) /* 48 */ #endif #ifndef XSetWindowBackgroundPixmap -#define XSetWindowBackgroundPixmap(d, w, p) \ - (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap)(d, w, p) /* 49 */ +#define XSetWindowBackgroundPixmap \ + (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 49 */ #endif #ifndef XSetWindowBorder -#define XSetWindowBorder(d, w, ul) \ - (tkIntXlibStubsPtr->xSetWindowBorder)(d, w, ul) /* 50 */ +#define XSetWindowBorder \ + (tkIntXlibStubsPtr->xSetWindowBorder) /* 50 */ #endif #ifndef XSetWindowBorderPixmap -#define XSetWindowBorderPixmap(d, w, p) \ - (tkIntXlibStubsPtr->xSetWindowBorderPixmap)(d, w, p) /* 51 */ +#define XSetWindowBorderPixmap \ + (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 51 */ #endif #ifndef XSetWindowBorderWidth -#define XSetWindowBorderWidth(d, w, ui) \ - (tkIntXlibStubsPtr->xSetWindowBorderWidth)(d, w, ui) /* 52 */ +#define XSetWindowBorderWidth \ + (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 52 */ #endif #ifndef XSetWindowColormap -#define XSetWindowColormap(d, w, c) \ - (tkIntXlibStubsPtr->xSetWindowColormap)(d, w, c) /* 53 */ +#define XSetWindowColormap \ + (tkIntXlibStubsPtr->xSetWindowColormap) /* 53 */ #endif #ifndef XUngrabKeyboard -#define XUngrabKeyboard(d, t) \ - (tkIntXlibStubsPtr->xUngrabKeyboard)(d, t) /* 54 */ +#define XUngrabKeyboard \ + (tkIntXlibStubsPtr->xUngrabKeyboard) /* 54 */ #endif #ifndef XUngrabPointer -#define XUngrabPointer(d, t) \ - (tkIntXlibStubsPtr->xUngrabPointer)(d, t) /* 55 */ +#define XUngrabPointer \ + (tkIntXlibStubsPtr->xUngrabPointer) /* 55 */ #endif #ifndef XUnmapWindow -#define XUnmapWindow(d, w) \ - (tkIntXlibStubsPtr->xUnmapWindow)(d, w) /* 56 */ +#define XUnmapWindow \ + (tkIntXlibStubsPtr->xUnmapWindow) /* 56 */ #endif #ifndef TkPutImage -#define TkPutImage(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height) \ - (tkIntXlibStubsPtr->tkPutImage)(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height) /* 57 */ +#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 #endif /* MAC_TCL */ diff --git a/generic/tkIntXlibStubs.c b/generic/tkIntXlibStubs.c deleted file mode 100644 index 01906f1..0000000 --- a/generic/tkIntXlibStubs.c +++ /dev/null @@ -1,1596 +0,0 @@ -/* - * tkIntPlatStubs.c -- - * - * This file contains the wrapper functions for the platform dependent - * unsupported Tk API. - * - * Copyright (c) 1998-1999 by Scriptics Corporation. - * All rights reserved. - * - * RCS: @(#) $Id: tkIntXlibStubs.c,v 1.4 1999/03/12 03:17:48 stanton Exp $ - */ - -#include "tkInt.h" -#include <X11/Xlib.h> - -/* - * WARNING: This file is automatically generated by the tools/genStubs.tcl - * script. Any modifications to the function declarations below should be made - * in the generic/tkInt.decls script. - */ - -/* !BEGIN!: Do not edit below this line. */ - -/* - * Exported stub functions: - */ - -#ifdef __WIN32__ -/* Slot 0 is reserved */ -/* Slot 1 */ -XModifierKeymap* -XGetModifierMapping(d) - Display* d; -{ - return (tkIntXlibStubsPtr->xGetModifierMapping)(d); -} - -/* Slot 2 */ -XImage * -XCreateImage(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4) - Display* d; - Visual* v; - unsigned int ui1; - int i1; - int i2; - char* cp; - unsigned int ui2; - unsigned int ui3; - int i3; - int i4; -{ - return (tkIntXlibStubsPtr->xCreateImage)(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4); -} - -/* Slot 3 */ -XImage * -XGetImage(d, dr, i1, i2, ui1, ui2, ul, i3) - Display* d; - Drawable dr; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - unsigned long ul; - int i3; -{ - return (tkIntXlibStubsPtr->xGetImage)(d, dr, i1, i2, ui1, ui2, ul, i3); -} - -/* Slot 4 */ -char * -XGetAtomName(d, a) - Display* d; - Atom a; -{ - return (tkIntXlibStubsPtr->xGetAtomName)(d, a); -} - -/* Slot 5 */ -char * -XKeysymToString(k) - KeySym k; -{ - return (tkIntXlibStubsPtr->xKeysymToString)(k); -} - -/* Slot 6 */ -Colormap -XCreateColormap(d, w, v, i) - Display* d; - Window w; - Visual* v; - int i; -{ - return (tkIntXlibStubsPtr->xCreateColormap)(d, w, v, i); -} - -/* Slot 7 */ -Cursor -XCreatePixmapCursor(d, p1, p2, x1, x2, ui1, ui2) - Display* d; - Pixmap p1; - Pixmap p2; - XColor* x1; - XColor* x2; - unsigned int ui1; - unsigned int ui2; -{ - return (tkIntXlibStubsPtr->xCreatePixmapCursor)(d, p1, p2, x1, x2, ui1, ui2); -} - -/* Slot 8 */ -Cursor -XCreateGlyphCursor(d, f1, f2, ui1, ui2, x1, x2) - Display* d; - Font f1; - Font f2; - unsigned int ui1; - unsigned int ui2; - XColor* x1; - XColor* x2; -{ - return (tkIntXlibStubsPtr->xCreateGlyphCursor)(d, f1, f2, ui1, ui2, x1, x2); -} - -/* Slot 9 */ -GContext -XGContextFromGC(g) - GC g; -{ - return (tkIntXlibStubsPtr->xGContextFromGC)(g); -} - -/* Slot 10 */ -XHostAddress * -XListHosts(d, i, b) - Display* d; - int* i; - Bool* b; -{ - return (tkIntXlibStubsPtr->xListHosts)(d, i, b); -} - -/* Slot 11 */ -KeySym -XKeycodeToKeysym(d, k, i) - Display* d; - unsigned int k; - int i; -{ - return (tkIntXlibStubsPtr->xKeycodeToKeysym)(d, k, i); -} - -/* Slot 12 */ -KeySym -XStringToKeysym(c) - _Xconst char* c; -{ - return (tkIntXlibStubsPtr->xStringToKeysym)(c); -} - -/* Slot 13 */ -Window -XRootWindow(d, i) - Display* d; - int i; -{ - return (tkIntXlibStubsPtr->xRootWindow)(d, i); -} - -/* Slot 14 */ -XErrorHandler -XSetErrorHandler(x) - XErrorHandler x; -{ - return (tkIntXlibStubsPtr->xSetErrorHandler)(x); -} - -/* Slot 15 */ -Status -XIconifyWindow(d, w, i) - Display* d; - Window w; - int i; -{ - return (tkIntXlibStubsPtr->xIconifyWindow)(d, w, i); -} - -/* Slot 16 */ -Status -XWithdrawWindow(d, w, i) - Display* d; - Window w; - int i; -{ - return (tkIntXlibStubsPtr->xWithdrawWindow)(d, w, i); -} - -/* Slot 17 */ -Status -XGetWMColormapWindows(d, w, wpp, ip) - Display* d; - Window w; - Window** wpp; - int* ip; -{ - return (tkIntXlibStubsPtr->xGetWMColormapWindows)(d, w, wpp, ip); -} - -/* Slot 18 */ -Status -XAllocColor(d, c, xp) - Display* d; - Colormap c; - XColor* xp; -{ - return (tkIntXlibStubsPtr->xAllocColor)(d, c, xp); -} - -/* Slot 19 */ -void -XBell(d, i) - Display* d; - int i; -{ - (tkIntXlibStubsPtr->xBell)(d, i); -} - -/* Slot 20 */ -void -XChangeProperty(d, w, a1, a2, i1, i2, c, i3) - Display* d; - Window w; - Atom a1; - Atom a2; - int i1; - int i2; - _Xconst unsigned char* c; - int i3; -{ - (tkIntXlibStubsPtr->xChangeProperty)(d, w, a1, a2, i1, i2, c, i3); -} - -/* Slot 21 */ -void -XChangeWindowAttributes(d, w, ul, x) - Display* d; - Window w; - unsigned long ul; - XSetWindowAttributes* x; -{ - (tkIntXlibStubsPtr->xChangeWindowAttributes)(d, w, ul, x); -} - -/* Slot 22 */ -void -XClearWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xClearWindow)(d, w); -} - -/* Slot 23 */ -void -XConfigureWindow(d, w, i, x) - Display* d; - Window w; - unsigned int i; - XWindowChanges* x; -{ - (tkIntXlibStubsPtr->xConfigureWindow)(d, w, i, x); -} - -/* Slot 24 */ -void -XCopyArea(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4) - Display* d; - Drawable dr1; - Drawable dr2; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - int i3; - int i4; -{ - (tkIntXlibStubsPtr->xCopyArea)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4); -} - -/* Slot 25 */ -void -XCopyPlane(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul) - 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; -{ - (tkIntXlibStubsPtr->xCopyPlane)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul); -} - -/* Slot 26 */ -Pixmap -XCreateBitmapFromData(display, d, data, width, height) - Display* display; - Drawable d; - _Xconst char* data; - unsigned int width; - unsigned int height; -{ - return (tkIntXlibStubsPtr->xCreateBitmapFromData)(display, d, data, width, height); -} - -/* Slot 27 */ -void -XDefineCursor(d, w, c) - Display* d; - Window w; - Cursor c; -{ - (tkIntXlibStubsPtr->xDefineCursor)(d, w, c); -} - -/* Slot 28 */ -void -XDeleteProperty(d, w, a) - Display* d; - Window w; - Atom a; -{ - (tkIntXlibStubsPtr->xDeleteProperty)(d, w, a); -} - -/* Slot 29 */ -void -XDestroyWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xDestroyWindow)(d, w); -} - -/* Slot 30 */ -void -XDrawArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) - Display* d; - Drawable dr; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - int i3; - int i4; -{ - (tkIntXlibStubsPtr->xDrawArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4); -} - -/* Slot 31 */ -void -XDrawLines(d, dr, g, x, i1, i2) - Display* d; - Drawable dr; - GC g; - XPoint* x; - int i1; - int i2; -{ - (tkIntXlibStubsPtr->xDrawLines)(d, dr, g, x, i1, i2); -} - -/* Slot 32 */ -void -XDrawRectangle(d, dr, g, i1, i2, ui1, ui2) - Display* d; - Drawable dr; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; -{ - (tkIntXlibStubsPtr->xDrawRectangle)(d, dr, g, i1, i2, ui1, ui2); -} - -/* Slot 33 */ -void -XFillArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) - Display* d; - Drawable dr; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - int i3; - int i4; -{ - (tkIntXlibStubsPtr->xFillArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4); -} - -/* Slot 34 */ -void -XFillPolygon(d, dr, g, x, i1, i2, i3) - Display* d; - Drawable dr; - GC g; - XPoint* x; - int i1; - int i2; - int i3; -{ - (tkIntXlibStubsPtr->xFillPolygon)(d, dr, g, x, i1, i2, i3); -} - -/* Slot 35 */ -void -XFillRectangles(d, dr, g, x, i) - Display* d; - Drawable dr; - GC g; - XRectangle* x; - int i; -{ - (tkIntXlibStubsPtr->xFillRectangles)(d, dr, g, x, i); -} - -/* Slot 36 */ -void -XForceScreenSaver(d, i) - Display* d; - int i; -{ - (tkIntXlibStubsPtr->xForceScreenSaver)(d, i); -} - -/* Slot 37 */ -void -XFreeColormap(d, c) - Display* d; - Colormap c; -{ - (tkIntXlibStubsPtr->xFreeColormap)(d, c); -} - -/* Slot 38 */ -void -XFreeColors(d, c, ulp, i, ul) - Display* d; - Colormap c; - unsigned long* ulp; - int i; - unsigned long ul; -{ - (tkIntXlibStubsPtr->xFreeColors)(d, c, ulp, i, ul); -} - -/* Slot 39 */ -void -XFreeCursor(d, c) - Display* d; - Cursor c; -{ - (tkIntXlibStubsPtr->xFreeCursor)(d, c); -} - -/* Slot 40 */ -void -XFreeModifiermap(x) - XModifierKeymap* x; -{ - (tkIntXlibStubsPtr->xFreeModifiermap)(x); -} - -/* Slot 41 */ -Status -XGetGeometry(d, dr, w, i1, i2, ui1, ui2, ui3, ui4) - Display* d; - Drawable dr; - Window* w; - int* i1; - int* i2; - unsigned int* ui1; - unsigned int* ui2; - unsigned int* ui3; - unsigned int* ui4; -{ - return (tkIntXlibStubsPtr->xGetGeometry)(d, dr, w, i1, i2, ui1, ui2, ui3, ui4); -} - -/* Slot 42 */ -void -XGetInputFocus(d, w, i) - Display* d; - Window* w; - int* i; -{ - (tkIntXlibStubsPtr->xGetInputFocus)(d, w, i); -} - -/* Slot 43 */ -int -XGetWindowProperty(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp) - 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; -{ - return (tkIntXlibStubsPtr->xGetWindowProperty)(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp); -} - -/* Slot 44 */ -Status -XGetWindowAttributes(d, w, x) - Display* d; - Window w; - XWindowAttributes* x; -{ - return (tkIntXlibStubsPtr->xGetWindowAttributes)(d, w, x); -} - -/* Slot 45 */ -int -XGrabKeyboard(d, w, b, i1, i2, t) - Display* d; - Window w; - Bool b; - int i1; - int i2; - Time t; -{ - return (tkIntXlibStubsPtr->xGrabKeyboard)(d, w, b, i1, i2, t); -} - -/* Slot 46 */ -int -XGrabPointer(d, w1, b, ui, i1, i2, w2, c, t) - Display* d; - Window w1; - Bool b; - unsigned int ui; - int i1; - int i2; - Window w2; - Cursor c; - Time t; -{ - return (tkIntXlibStubsPtr->xGrabPointer)(d, w1, b, ui, i1, i2, w2, c, t); -} - -/* Slot 47 */ -KeyCode -XKeysymToKeycode(d, k) - Display* d; - KeySym k; -{ - return (tkIntXlibStubsPtr->xKeysymToKeycode)(d, k); -} - -/* Slot 48 */ -Status -XLookupColor(d, c1, c2, x1, x2) - Display* d; - Colormap c1; - _Xconst char* c2; - XColor* x1; - XColor* x2; -{ - return (tkIntXlibStubsPtr->xLookupColor)(d, c1, c2, x1, x2); -} - -/* Slot 49 */ -void -XMapWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xMapWindow)(d, w); -} - -/* Slot 50 */ -void -XMoveResizeWindow(d, w, i1, i2, ui1, ui2) - Display* d; - Window w; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; -{ - (tkIntXlibStubsPtr->xMoveResizeWindow)(d, w, i1, i2, ui1, ui2); -} - -/* Slot 51 */ -void -XMoveWindow(d, w, i1, i2) - Display* d; - Window w; - int i1; - int i2; -{ - (tkIntXlibStubsPtr->xMoveWindow)(d, w, i1, i2); -} - -/* Slot 52 */ -void -XNextEvent(d, x) - Display* d; - XEvent* x; -{ - (tkIntXlibStubsPtr->xNextEvent)(d, x); -} - -/* Slot 53 */ -void -XPutBackEvent(d, x) - Display* d; - XEvent* x; -{ - (tkIntXlibStubsPtr->xPutBackEvent)(d, x); -} - -/* Slot 54 */ -void -XQueryColors(d, c, x, i) - Display* d; - Colormap c; - XColor* x; - int i; -{ - (tkIntXlibStubsPtr->xQueryColors)(d, c, x, i); -} - -/* Slot 55 */ -Bool -XQueryPointer(d, w1, w2, w3, i1, i2, i3, i4, ui) - Display* d; - Window w1; - Window* w2; - Window* w3; - int* i1; - int* i2; - int* i3; - int* i4; - unsigned int* ui; -{ - return (tkIntXlibStubsPtr->xQueryPointer)(d, w1, w2, w3, i1, i2, i3, i4, ui); -} - -/* Slot 56 */ -Status -XQueryTree(d, w1, w2, w3, w4, ui) - Display* d; - Window w1; - Window* w2; - Window* w3; - Window** w4; - unsigned int* ui; -{ - return (tkIntXlibStubsPtr->xQueryTree)(d, w1, w2, w3, w4, ui); -} - -/* Slot 57 */ -void -XRaiseWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xRaiseWindow)(d, w); -} - -/* Slot 58 */ -void -XRefreshKeyboardMapping(x) - XMappingEvent* x; -{ - (tkIntXlibStubsPtr->xRefreshKeyboardMapping)(x); -} - -/* Slot 59 */ -void -XResizeWindow(d, w, ui1, ui2) - Display* d; - Window w; - unsigned int ui1; - unsigned int ui2; -{ - (tkIntXlibStubsPtr->xResizeWindow)(d, w, ui1, ui2); -} - -/* Slot 60 */ -void -XSelectInput(d, w, l) - Display* d; - Window w; - long l; -{ - (tkIntXlibStubsPtr->xSelectInput)(d, w, l); -} - -/* Slot 61 */ -Status -XSendEvent(d, w, b, l, x) - Display* d; - Window w; - Bool b; - long l; - XEvent* x; -{ - return (tkIntXlibStubsPtr->xSendEvent)(d, w, b, l, x); -} - -/* Slot 62 */ -void -XSetCommand(d, w, c, i) - Display* d; - Window w; - char** c; - int i; -{ - (tkIntXlibStubsPtr->xSetCommand)(d, w, c, i); -} - -/* Slot 63 */ -void -XSetIconName(d, w, c) - Display* d; - Window w; - _Xconst char* c; -{ - (tkIntXlibStubsPtr->xSetIconName)(d, w, c); -} - -/* Slot 64 */ -void -XSetInputFocus(d, w, i, t) - Display* d; - Window w; - int i; - Time t; -{ - (tkIntXlibStubsPtr->xSetInputFocus)(d, w, i, t); -} - -/* Slot 65 */ -void -XSetSelectionOwner(d, a, w, t) - Display* d; - Atom a; - Window w; - Time t; -{ - (tkIntXlibStubsPtr->xSetSelectionOwner)(d, a, w, t); -} - -/* Slot 66 */ -void -XSetWindowBackground(d, w, ul) - Display* d; - Window w; - unsigned long ul; -{ - (tkIntXlibStubsPtr->xSetWindowBackground)(d, w, ul); -} - -/* Slot 67 */ -void -XSetWindowBackgroundPixmap(d, w, p) - Display* d; - Window w; - Pixmap p; -{ - (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap)(d, w, p); -} - -/* Slot 68 */ -void -XSetWindowBorder(d, w, ul) - Display* d; - Window w; - unsigned long ul; -{ - (tkIntXlibStubsPtr->xSetWindowBorder)(d, w, ul); -} - -/* Slot 69 */ -void -XSetWindowBorderPixmap(d, w, p) - Display* d; - Window w; - Pixmap p; -{ - (tkIntXlibStubsPtr->xSetWindowBorderPixmap)(d, w, p); -} - -/* Slot 70 */ -void -XSetWindowBorderWidth(d, w, ui) - Display* d; - Window w; - unsigned int ui; -{ - (tkIntXlibStubsPtr->xSetWindowBorderWidth)(d, w, ui); -} - -/* Slot 71 */ -void -XSetWindowColormap(d, w, c) - Display* d; - Window w; - Colormap c; -{ - (tkIntXlibStubsPtr->xSetWindowColormap)(d, w, c); -} - -/* Slot 72 */ -Bool -XTranslateCoordinates(d, w1, w2, i1, i2, i3, i4, w3) - Display* d; - Window w1; - Window w2; - int i1; - int i2; - int* i3; - int* i4; - Window* w3; -{ - return (tkIntXlibStubsPtr->xTranslateCoordinates)(d, w1, w2, i1, i2, i3, i4, w3); -} - -/* Slot 73 */ -void -XUngrabKeyboard(d, t) - Display* d; - Time t; -{ - (tkIntXlibStubsPtr->xUngrabKeyboard)(d, t); -} - -/* Slot 74 */ -void -XUngrabPointer(d, t) - Display* d; - Time t; -{ - (tkIntXlibStubsPtr->xUngrabPointer)(d, t); -} - -/* Slot 75 */ -void -XUnmapWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xUnmapWindow)(d, w); -} - -/* Slot 76 */ -void -XWindowEvent(d, w, l, x) - Display* d; - Window w; - long l; - XEvent* x; -{ - (tkIntXlibStubsPtr->xWindowEvent)(d, w, l, x); -} - -/* Slot 77 */ -void -XDestroyIC(x) - XIC x; -{ - (tkIntXlibStubsPtr->xDestroyIC)(x); -} - -/* Slot 78 */ -Bool -XFilterEvent(x, w) - XEvent* x; - Window w; -{ - return (tkIntXlibStubsPtr->xFilterEvent)(x, w); -} - -/* Slot 79 */ -int -XmbLookupString(xi, xk, c, i, k, s) - XIC xi; - XKeyPressedEvent* xk; - char* c; - int i; - KeySym* k; - Status* s; -{ - return (tkIntXlibStubsPtr->xmbLookupString)(xi, xk, c, i, k, s); -} - -/* Slot 80 */ -void -TkPutImage(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height) - 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; -{ - (tkIntXlibStubsPtr->tkPutImage)(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height); -} - -#endif /* __WIN32__ */ -#ifdef MAC_TCL -/* Slot 0 is reserved */ -/* Slot 1 */ -XModifierKeymap* -XGetModifierMapping(d) - Display* d; -{ - return (tkIntXlibStubsPtr->xGetModifierMapping)(d); -} - -/* Slot 2 */ -XImage * -XCreateImage(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4) - Display* d; - Visual* v; - unsigned int ui1; - int i1; - int i2; - char* cp; - unsigned int ui2; - unsigned int ui3; - int i3; - int i4; -{ - return (tkIntXlibStubsPtr->xCreateImage)(d, v, ui1, i1, i2, cp, ui2, ui3, i3, i4); -} - -/* Slot 3 */ -XImage * -XGetImage(d, dr, i1, i2, ui1, ui2, ul, i3) - Display* d; - Drawable dr; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - unsigned long ul; - int i3; -{ - return (tkIntXlibStubsPtr->xGetImage)(d, dr, i1, i2, ui1, ui2, ul, i3); -} - -/* Slot 4 */ -char * -XGetAtomName(d, a) - Display* d; - Atom a; -{ - return (tkIntXlibStubsPtr->xGetAtomName)(d, a); -} - -/* Slot 5 */ -char * -XKeysymToString(k) - KeySym k; -{ - return (tkIntXlibStubsPtr->xKeysymToString)(k); -} - -/* Slot 6 */ -Colormap -XCreateColormap(d, w, v, i) - Display* d; - Window w; - Visual* v; - int i; -{ - return (tkIntXlibStubsPtr->xCreateColormap)(d, w, v, i); -} - -/* Slot 7 */ -GContext -XGContextFromGC(g) - GC g; -{ - return (tkIntXlibStubsPtr->xGContextFromGC)(g); -} - -/* Slot 8 */ -KeySym -XKeycodeToKeysym(d, k, i) - Display* d; - KeyCode k; - int i; -{ - return (tkIntXlibStubsPtr->xKeycodeToKeysym)(d, k, i); -} - -/* Slot 9 */ -KeySym -XStringToKeysym(c) - _Xconst char* c; -{ - return (tkIntXlibStubsPtr->xStringToKeysym)(c); -} - -/* Slot 10 */ -Window -XRootWindow(d, i) - Display* d; - int i; -{ - return (tkIntXlibStubsPtr->xRootWindow)(d, i); -} - -/* Slot 11 */ -XErrorHandler -XSetErrorHandler(x) - XErrorHandler x; -{ - return (tkIntXlibStubsPtr->xSetErrorHandler)(x); -} - -/* Slot 12 */ -Status -XAllocColor(d, c, xp) - Display* d; - Colormap c; - XColor* xp; -{ - return (tkIntXlibStubsPtr->xAllocColor)(d, c, xp); -} - -/* Slot 13 */ -void -XBell(d, i) - Display* d; - int i; -{ - (tkIntXlibStubsPtr->xBell)(d, i); -} - -/* Slot 14 */ -void -XChangeProperty(d, w, a, a, i1, i2, c, i3) - Display* d; - Window w; - Atom a; - Atom a; - int i1; - int i2; - _Xconst unsigned char* c; - int i3; -{ - (tkIntXlibStubsPtr->xChangeProperty)(d, w, a, a, i1, i2, c, i3); -} - -/* Slot 15 */ -void -XChangeWindowAttributes(d, w, ul, x) - Display* d; - Window w; - unsigned long ul; - XSetWindowAttributes* x; -{ - (tkIntXlibStubsPtr->xChangeWindowAttributes)(d, w, ul, x); -} - -/* Slot 16 */ -void -XConfigureWindow(d, w, i, x) - Display* d; - Window w; - unsigned int i; - XWindowChanges* x; -{ - (tkIntXlibStubsPtr->xConfigureWindow)(d, w, i, x); -} - -/* Slot 17 */ -void -XCopyArea(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4) - Display* d; - Drawable dr1; - Drawable dr2; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - int i3; - int i4; -{ - (tkIntXlibStubsPtr->xCopyArea)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4); -} - -/* Slot 18 */ -void -XCopyPlane(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul) - 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; -{ - (tkIntXlibStubsPtr->xCopyPlane)(d, dr1, dr2, g, i1, i2, ui1, ui2, i3, i4, ul); -} - -/* Slot 19 */ -Pixmap -XCreateBitmapFromData(display, d, data, width, height) - Display* display; - Drawable d; - _Xconst char* data; - unsigned int width; - unsigned int height; -{ - return (tkIntXlibStubsPtr->xCreateBitmapFromData)(display, d, data, width, height); -} - -/* Slot 20 */ -void -XDefineCursor(d, w, c) - Display* d; - Window w; - Cursor c; -{ - (tkIntXlibStubsPtr->xDefineCursor)(d, w, c); -} - -/* Slot 21 */ -void -XDestroyWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xDestroyWindow)(d, w); -} - -/* Slot 22 */ -void -XDrawArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) - Display* d; - Drawable dr; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - int i3; - int i4; -{ - (tkIntXlibStubsPtr->xDrawArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4); -} - -/* Slot 23 */ -void -XDrawLines(d, dr, g, x, i1, i2) - Display* d; - Drawable dr; - GC g; - XPoint* x; - int i1; - int i2; -{ - (tkIntXlibStubsPtr->xDrawLines)(d, dr, g, x, i1, i2); -} - -/* Slot 24 */ -void -XDrawRectangle(d, dr, g, i1, i2, ui1, ui2) - Display* d; - Drawable dr; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; -{ - (tkIntXlibStubsPtr->xDrawRectangle)(d, dr, g, i1, i2, ui1, ui2); -} - -/* Slot 25 */ -void -XFillArc(d, dr, g, i1, i2, ui1, ui2, i3, i4) - Display* d; - Drawable dr; - GC g; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; - int i3; - int i4; -{ - (tkIntXlibStubsPtr->xFillArc)(d, dr, g, i1, i2, ui1, ui2, i3, i4); -} - -/* Slot 26 */ -void -XFillPolygon(d, dr, g, x, i1, i2, i3) - Display* d; - Drawable dr; - GC g; - XPoint* x; - int i1; - int i2; - int i3; -{ - (tkIntXlibStubsPtr->xFillPolygon)(d, dr, g, x, i1, i2, i3); -} - -/* Slot 27 */ -void -XFillRectangles(d, dr, g, x, i) - Display* d; - Drawable dr; - GC g; - XRectangle* x; - int i; -{ - (tkIntXlibStubsPtr->xFillRectangles)(d, dr, g, x, i); -} - -/* Slot 28 */ -void -XFreeColormap(d, c) - Display* d; - Colormap c; -{ - (tkIntXlibStubsPtr->xFreeColormap)(d, c); -} - -/* Slot 29 */ -void -XFreeColors(d, c, ulp, i, ul) - Display* d; - Colormap c; - unsigned long* ulp; - int i; - unsigned long ul; -{ - (tkIntXlibStubsPtr->xFreeColors)(d, c, ulp, i, ul); -} - -/* Slot 30 */ -void -XFreeModifiermap(x) - XModifierKeymap* x; -{ - (tkIntXlibStubsPtr->xFreeModifiermap)(x); -} - -/* Slot 31 */ -Status -XGetGeometry(d, dr, w, i1, i2, ui1, ui2, ui3, ui4) - Display* d; - Drawable dr; - Window* w; - int* i1; - int* i2; - unsigned int* ui1; - unsigned int* ui2; - unsigned int* ui3; - unsigned int* ui4; -{ - return (tkIntXlibStubsPtr->xGetGeometry)(d, dr, w, i1, i2, ui1, ui2, ui3, ui4); -} - -/* Slot 32 */ -int -XGetWindowProperty(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp) - 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; -{ - return (tkIntXlibStubsPtr->xGetWindowProperty)(d, w, a1, l1, l2, b, a2, ap, ip, ulp1, ulp2, cpp); -} - -/* Slot 33 */ -int -XGrabKeyboard(d, w, b, i1, i2, t) - Display* d; - Window w; - Bool b; - int i1; - int i2; - Time t; -{ - return (tkIntXlibStubsPtr->xGrabKeyboard)(d, w, b, i1, i2, t); -} - -/* Slot 34 */ -int -XGrabPointer(d, w1, b, ui, i1, i2, w2, c, t) - Display* d; - Window w1; - Bool b; - unsigned int ui; - int i1; - int i2; - Window w2; - Cursor c; - Time t; -{ - return (tkIntXlibStubsPtr->xGrabPointer)(d, w1, b, ui, i1, i2, w2, c, t); -} - -/* Slot 35 */ -KeyCode -XKeysymToKeycode(d, k) - Display* d; - KeySym k; -{ - return (tkIntXlibStubsPtr->xKeysymToKeycode)(d, k); -} - -/* Slot 36 */ -void -XMapWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xMapWindow)(d, w); -} - -/* Slot 37 */ -void -XMoveResizeWindow(d, w, i1, i2, ui1, ui2) - Display* d; - Window w; - int i1; - int i2; - unsigned int ui1; - unsigned int ui2; -{ - (tkIntXlibStubsPtr->xMoveResizeWindow)(d, w, i1, i2, ui1, ui2); -} - -/* Slot 38 */ -void -XMoveWindow(d, w, i1, i2) - Display* d; - Window w; - int i1; - int i2; -{ - (tkIntXlibStubsPtr->xMoveWindow)(d, w, i1, i2); -} - -/* Slot 39 */ -Bool -XQueryPointer(d, w1, w2, w3, i1, i2, i3, i4, ui) - Display* d; - Window w1; - Window* w2; - Window* w3; - int* i1; - int* i2; - int* i3; - int* i4; - unsigned int* ui; -{ - return (tkIntXlibStubsPtr->xQueryPointer)(d, w1, w2, w3, i1, i2, i3, i4, ui); -} - -/* Slot 40 */ -void -XRaiseWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xRaiseWindow)(d, w); -} - -/* Slot 41 */ -void -XRefreshKeyboardMapping(x) - XMappingEvent* x; -{ - (tkIntXlibStubsPtr->xRefreshKeyboardMapping)(x); -} - -/* Slot 42 */ -void -XResizeWindow(d, w, ui1, ui2) - Display* d; - Window w; - unsigned int ui1; - unsigned int ui2; -{ - (tkIntXlibStubsPtr->xResizeWindow)(d, w, ui1, ui2); -} - -/* Slot 43 */ -void -XSelectInput(d, w, l) - Display* d; - Window w; - long l; -{ - (tkIntXlibStubsPtr->xSelectInput)(d, w, l); -} - -/* Slot 44 */ -Status -XSendEvent(d, w, b, l, x) - Display* d; - Window w; - Bool b; - long l; - XEvent* x; -{ - return (tkIntXlibStubsPtr->xSendEvent)(d, w, b, l, x); -} - -/* Slot 45 */ -void -XSetIconName(d, w, c) - Display* d; - Window w; - _Xconst char* c; -{ - (tkIntXlibStubsPtr->xSetIconName)(d, w, c); -} - -/* Slot 46 */ -void -XSetInputFocus(d, w, i, t) - Display* d; - Window w; - int i; - Time t; -{ - (tkIntXlibStubsPtr->xSetInputFocus)(d, w, i, t); -} - -/* Slot 47 */ -void -XSetSelectionOwner(d, a, w, t) - Display* d; - Atom a; - Window w; - Time t; -{ - (tkIntXlibStubsPtr->xSetSelectionOwner)(d, a, w, t); -} - -/* Slot 48 */ -void -XSetWindowBackground(d, w, ul) - Display* d; - Window w; - unsigned long ul; -{ - (tkIntXlibStubsPtr->xSetWindowBackground)(d, w, ul); -} - -/* Slot 49 */ -void -XSetWindowBackgroundPixmap(d, w, p) - Display* d; - Window w; - Pixmap p; -{ - (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap)(d, w, p); -} - -/* Slot 50 */ -void -XSetWindowBorder(d, w, ul) - Display* d; - Window w; - unsigned long ul; -{ - (tkIntXlibStubsPtr->xSetWindowBorder)(d, w, ul); -} - -/* Slot 51 */ -void -XSetWindowBorderPixmap(d, w, p) - Display* d; - Window w; - Pixmap p; -{ - (tkIntXlibStubsPtr->xSetWindowBorderPixmap)(d, w, p); -} - -/* Slot 52 */ -void -XSetWindowBorderWidth(d, w, ui) - Display* d; - Window w; - unsigned int ui; -{ - (tkIntXlibStubsPtr->xSetWindowBorderWidth)(d, w, ui); -} - -/* Slot 53 */ -void -XSetWindowColormap(d, w, c) - Display* d; - Window w; - Colormap c; -{ - (tkIntXlibStubsPtr->xSetWindowColormap)(d, w, c); -} - -/* Slot 54 */ -void -XUngrabKeyboard(d, t) - Display* d; - Time t; -{ - (tkIntXlibStubsPtr->xUngrabKeyboard)(d, t); -} - -/* Slot 55 */ -void -XUngrabPointer(d, t) - Display* d; - Time t; -{ - (tkIntXlibStubsPtr->xUngrabPointer)(d, t); -} - -/* Slot 56 */ -void -XUnmapWindow(d, w) - Display* d; - Window w; -{ - (tkIntXlibStubsPtr->xUnmapWindow)(d, w); -} - -/* Slot 57 */ -void -TkPutImage(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height) - 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; -{ - (tkIntXlibStubsPtr->tkPutImage)(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height); -} - -#endif /* MAC_TCL */ - -/* !END!: Do not edit above this line. */ diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 34189c7..241c05b 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkListbox.c,v 1.2 1998/09/14 18:23:13 stanton Exp $ + * RCS: @(#) $Id: tkListbox.c,v 1.3 1999/04/16 01:51:19 stanton Exp $ */ #include "tkPort.h" @@ -24,7 +24,7 @@ */ typedef struct Element { - int textLength; /* # non-NULL characters in text. */ + int textLength; /* # non-NULL bytes in text string. */ int lBearing; /* Distance from first character's * origin to left edge of character. */ int pixelWidth; /* Total width of element in pixels (including @@ -428,7 +428,7 @@ Tk_ListboxCmd(clientData, interp, argc, argv) goto error; } - interp->result = Tk_PathName(listPtr->tkwin); + Tcl_SetResult(interp, Tk_PathName(listPtr->tkwin), TCL_STATIC); return TCL_OK; error: @@ -518,12 +518,14 @@ ListboxWidgetCmd(clientData, interp, argc, argv) if ((index >= listPtr->topIndex) && (index < listPtr->numElements) && (index < (listPtr->topIndex + listPtr->fullLines + listPtr->partialLine))) { + char buf[TCL_INTEGER_SPACE * 4]; + x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; y = ((index - listPtr->topIndex)*listPtr->lineHeight) + listPtr->inset + listPtr->selBorderWidth; Tk_GetFontMetrics(listPtr->tkfont, &fm); - sprintf(interp->result, "%d %d %d %d", x, y, elPtr->pixelWidth, - fm.linespace); + sprintf(buf, "%d %d %d %d", x, y, elPtr->pixelWidth, fm.linespace); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) && (length >= 2)) { @@ -550,7 +552,6 @@ ListboxWidgetCmd(clientData, interp, argc, argv) } else if ((c == 'c') && (strncmp(argv[1], "curselection", length) == 0) && (length >= 2)) { int i, count; - char index[20]; Element *elPtr; if (argc != 2) { @@ -563,6 +564,8 @@ ListboxWidgetCmd(clientData, interp, argc, argv) for (i = 0, elPtr = listPtr->firstPtr; elPtr != NULL; i++, elPtr = elPtr->nextPtr) { if (elPtr->selected) { + char index[TCL_INTEGER_SPACE]; + sprintf(index, "%d", i); Tcl_AppendElement(interp, index); count++; @@ -609,8 +612,10 @@ ListboxWidgetCmd(clientData, interp, argc, argv) if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) { goto error; } - if ((argc == 4) && (GetListboxIndex(interp, listPtr, argv[3], - 0, &last) != TCL_OK)) { + last = first; + if ((argc == 4) + && (GetListboxIndex(interp, listPtr, argv[3], 0, + &last) != TCL_OK)) { goto error; } if (first >= listPtr->numElements) { @@ -627,7 +632,7 @@ ListboxWidgetCmd(clientData, interp, argc, argv) if (elPtr != NULL) { if (argc == 3) { if (first >= 0) { - interp->result = elPtr->text; + Tcl_SetResult(interp, elPtr->text, TCL_STATIC); } } else { for ( ; i <= last; i++, elPtr = elPtr->nextPtr) { @@ -638,6 +643,7 @@ ListboxWidgetCmd(clientData, interp, argc, argv) } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) && (length >= 3)) { int index; + char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -649,7 +655,8 @@ ListboxWidgetCmd(clientData, interp, argc, argv) != TCL_OK) { goto error; } - sprintf(interp->result, "%d", index); + sprintf(buf, "%d", index); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) && (length >= 3)) { int index; @@ -667,6 +674,7 @@ ListboxWidgetCmd(clientData, interp, argc, argv) InsertEls(listPtr, index, argc-3, argv+3); } else if ((c == 'n') && (strncmp(argv[1], "nearest", length) == 0)) { int index, y; + char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -677,7 +685,8 @@ ListboxWidgetCmd(clientData, interp, argc, argv) goto error; } index = NearestListboxElement(listPtr, y); - sprintf(interp->result, "%d", index); + sprintf(buf, "%d", index); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 's') && (length >= 2) && (strncmp(argv[1], "scan", length) == 0)) { int x, y; @@ -788,7 +797,7 @@ ListboxWidgetCmd(clientData, interp, argc, argv) goto error; } if ((first < 0) || (first >= listPtr->numElements)) { - interp->result = "0"; + Tcl_SetResult(interp, "0", TCL_STATIC); goto done; } for (elPtr = listPtr->firstPtr, i = 0; i < first; @@ -796,9 +805,9 @@ ListboxWidgetCmd(clientData, interp, argc, argv) /* Empty loop body. */ } if (elPtr->selected) { - interp->result = "1"; + Tcl_SetResult(interp, "1", TCL_STATIC); } else { - interp->result = "0"; + Tcl_SetResult(interp, "0", TCL_STATIC); } } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) { ListboxSelect(listPtr, first, last, 1); @@ -810,12 +819,15 @@ ListboxWidgetCmd(clientData, interp, argc, argv) } } else if ((c == 's') && (length >= 2) && (strncmp(argv[1], "size", length) == 0)) { + char buf[TCL_INTEGER_SPACE]; + if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " size\"", (char *) NULL); goto error; } - sprintf(interp->result, "%d", listPtr->numElements); + sprintf(buf, "%d", listPtr->numElements); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { int index, count, type, windowWidth, windowUnits; int offset = 0; /* Initialized to stop gcc warnings. */ @@ -825,15 +837,18 @@ ListboxWidgetCmd(clientData, interp, argc, argv) - 2*(listPtr->inset + listPtr->selBorderWidth); if (argc == 2) { if (listPtr->maxWidth == 0) { - interp->result = "0 1"; + Tcl_SetResult(interp, "0 1", TCL_STATIC); } else { + char buf[TCL_DOUBLE_SPACE * 2]; + fraction = listPtr->xOffset/((double) listPtr->maxWidth); fraction2 = (listPtr->xOffset + windowWidth) /((double) listPtr->maxWidth); if (fraction2 > 1.0) { fraction2 = 1.0; } - sprintf(interp->result, "%g %g", fraction, fraction2); + sprintf(buf, "%g %g", fraction, fraction2); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } } else if (argc == 3) { if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) { @@ -869,15 +884,18 @@ ListboxWidgetCmd(clientData, interp, argc, argv) if (argc == 2) { if (listPtr->numElements == 0) { - interp->result = "0 1"; + Tcl_SetResult(interp, "0 1", TCL_STATIC); } else { + char buf[TCL_DOUBLE_SPACE * 2]; + fraction = listPtr->topIndex/((double) listPtr->numElements); fraction2 = (listPtr->topIndex+listPtr->fullLines) /((double) listPtr->numElements); if (fraction2 > 1.0) { fraction2 = 1.0; } - sprintf(interp->result, "%g %g", fraction, fraction2); + sprintf(buf, "%g %g", fraction, fraction2); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } } else if (argc == 3) { if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) @@ -986,7 +1004,7 @@ DestroyListbox(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as colors, border width, @@ -1718,7 +1736,7 @@ ListboxCmdDeletedProc(clientData) * Results: * A standard Tcl result. If all went well, then *indexPtr is * filled in with the index (into listPtr) corresponding to - * string. Otherwise an error message is left in interp->result. + * string. Otherwise an error message is left in the interp's result. * * Side effects: * None. diff --git a/generic/tkMacWinMenu.c b/generic/tkMacWinMenu.c index 6453a5f..ca77c45 100644 --- a/generic/tkMacWinMenu.c +++ b/generic/tkMacWinMenu.c @@ -9,12 +9,16 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacWinMenu.c,v 1.2 1998/09/14 18:23:14 stanton Exp $ + * RCS: @(#) $Id: tkMacWinMenu.c,v 1.3 1999/04/16 01:51:19 stanton Exp $ */ #include "tkMenu.h" -static int postCommandGeneration; +typedef struct ThreadSpecificData { + int postCommandGeneration; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + static int PreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr)); @@ -43,6 +47,8 @@ PreprocessMenu(menuPtr) { int index, result, finished; TkMenu *cascadeMenuPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_Preserve((ClientData) menuPtr); @@ -67,16 +73,16 @@ PreprocessMenu(menuPtr) finished = 1; for (index = 0; index < menuPtr->numEntries; index++) { if ((menuPtr->entries[index]->type == CASCADE_ENTRY) - && (menuPtr->entries[index]->name != NULL)) { + && (menuPtr->entries[index]->namePtr != NULL)) { if ((menuPtr->entries[index]->childMenuRefPtr != NULL) && (menuPtr->entries[index]->childMenuRefPtr->menuPtr != NULL)) { cascadeMenuPtr = menuPtr->entries[index]->childMenuRefPtr->menuPtr; if (cascadeMenuPtr->postCommandGeneration != - postCommandGeneration) { + tsdPtr->postCommandGeneration) { cascadeMenuPtr->postCommandGeneration = - postCommandGeneration; + tsdPtr->postCommandGeneration; result = PreprocessMenu(cascadeMenuPtr); if (result != TCL_OK) { goto done; @@ -128,7 +134,10 @@ int TkPreprocessMenu(menuPtr) TkMenu *menuPtr; { - postCommandGeneration++; - menuPtr->postCommandGeneration = postCommandGeneration; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + tsdPtr->postCommandGeneration++; + menuPtr->postCommandGeneration = tsdPtr->postCommandGeneration; return PreprocessMenu(menuPtr); } diff --git a/generic/tkMain.c b/generic/tkMain.c index d55f920..9502926 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -8,12 +8,12 @@ * for Tk applications. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMain.c,v 1.3 1999/03/10 07:04:42 stanton Exp $ + * RCS: @(#) $Id: tkMain.c,v 1.4 1999/04/16 01:51:19 stanton Exp $ */ #include <ctype.h> @@ -27,6 +27,22 @@ #else # include <stdlib.h> #endif +#ifdef __WIN32__ +#include "tkWinInt.h" +#endif + + +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; +Tcl_ThreadDataKey dataKey; /* * Declarations for various library procedures and variables (don't want @@ -37,8 +53,6 @@ * some systems. */ -void TkConsoleCreate_ _ANSI_ARGS_((void)); - #if !defined(__WIN32__) && !defined(_WIN32) extern int isatty _ANSI_ARGS_((int fd)); extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); @@ -46,18 +60,7 @@ extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); extern void TkpDisplayWarning _ANSI_ARGS_((char *msg, char *title)); -/* - * Global variables used by the main program: - */ - -static Tcl_Interp *interp; /* Interpreter for this application. */ -static Tcl_DString command; /* Used to assemble lines of terminal input - * into Tcl commands. */ -static Tcl_DString line; /* Used to read the next line from the - * terminal input. */ -static int tty; /* Non-zero means standard input is a - * terminal-like device. Zero means it's - * a file. */ +extern void TkConsoleCreate_ _ANSI_ARGS_((void)); /* * Forward declarations for procedures defined later in this file. @@ -70,7 +73,7 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData, /* *---------------------------------------------------------------------- * - * Tk_Main, Tk_MainEx -- + * TkMainEx -- * * Main program for Wish and most other Tk-based applications. * @@ -85,19 +88,6 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData, * *---------------------------------------------------------------------- */ - -void -Tk_Main(argc, argv, appInitProc) - 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. */ -{ - Tk_MainEx(argc, argv, appInitProc, Tcl_CreateInterp()); -} - void Tk_MainEx(argc, argv, appInitProc, interp) int argc; /* Number of arguments. */ @@ -106,25 +96,33 @@ Tk_MainEx(argc, argv, appInitProc, interp) * procedure to call after most * initialization but before starting * to execute commands. */ - Tcl_Interp *interp; /* Application interpreter. */ + Tcl_Interp *interp; { char *args, *fileName; - char buf[20]; + char buf[TCL_INTEGER_SPACE]; int code; size_t length; Tcl_Channel inChannel, outChannel; + Tcl_DString argString; + ThreadSpecificData *tsdPtr; +#ifdef __WIN32__ + HANDLE handle; +#endif /* - * Make sure that Tcl is present. If using stubs this will initialize the - * stub table pointers. (for 8.1, noop in 8.0.x) + * Ensure that we are getting the matching version of Tcl. This is + * really only an issue when Tk is loaded dynamically. */ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { abort(); } + + tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_FindExecutable(argv[0]); - + tsdPtr->interp = interp; #if (defined(__WIN32__) || defined(MAC_TCL)) TkConsoleCreate_(); @@ -161,12 +159,19 @@ Tk_MainEx(argc, argv, appInitProc, interp) */ args = Tcl_Merge(argc-1, argv+1); - Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); + Tcl_ExternalToUtfDString(NULL, args, -1, &argString); + Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); + Tcl_DStringFree(&argString); ckfree(args); sprintf(buf, "%d", argc-1); + + if (fileName == NULL) { + Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString); + } else { + fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString); + } Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0], - TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); /* * Set the "tcl_interactive" variable. @@ -180,19 +185,39 @@ Tk_MainEx(argc, argv, appInitProc, interp) */ #ifdef __WIN32__ - tty = 1; + handle = GetStdHandle(STD_INPUT_HANDLE); + + 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. + */ + + tsdPtr->tty = 1; + } else if (GetFileType(handle) == FILE_TYPE_CHAR) { + /* + * A character file handle is a tty by definition. + */ + + tsdPtr->tty = 1; + } else { + tsdPtr->tty = 0; + } + #else - tty = isatty(0); + tsdPtr->tty = isatty(0); #endif Tcl_SetVar(interp, "tcl_interactive", - ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); + ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ if ((*appInitProc)(interp) != TCL_OK) { - TkpDisplayWarning(interp->result, "Application initialization failed"); + TkpDisplayWarning(Tcl_GetStringResult(interp), + "Application initialization failed"); } /* @@ -200,6 +225,7 @@ Tk_MainEx(argc, argv, appInitProc, interp) */ if (fileName != NULL) { + Tcl_ResetResult(interp); code = Tcl_EvalFile(interp, fileName); if (code != TCL_OK) { /* @@ -213,7 +239,7 @@ Tk_MainEx(argc, argv, appInitProc, interp) Tcl_DeleteInterp(interp); Tcl_Exit(1); } - tty = 0; + tsdPtr->tty = 0; } else { /* @@ -231,17 +257,18 @@ Tk_MainEx(argc, argv, appInitProc, interp) Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, (ClientData) inChannel); } - if (tty) { + if (tsdPtr->tty) { Prompt(interp, 0); } } + Tcl_DStringFree(&argString); outChannel = Tcl_GetStdChannel(TCL_STDOUT); if (outChannel) { Tcl_Flush(outChannel); } - Tcl_DStringInit(&command); - Tcl_DStringInit(&line); + Tcl_DStringInit(&tsdPtr->command); + Tcl_DStringInit(&tsdPtr->line); Tcl_ResetResult(interp); /* @@ -284,12 +311,15 @@ StdinProc(clientData, mask) char *cmd; int code, count; Tcl_Channel chan = (Tcl_Channel) clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_Interp *interp = tsdPtr->interp; - count = Tcl_Gets(chan, &line); + count = Tcl_Gets(chan, &tsdPtr->line); if (count < 0) { if (!gotPartial) { - if (tty) { + if (tsdPtr->tty) { Tcl_Exit(0); } else { Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); @@ -298,9 +328,10 @@ StdinProc(clientData, mask) } } - (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1); - cmd = Tcl_DStringAppend(&command, "\n", -1); - Tcl_DStringFree(&line); + (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( + &tsdPtr->line), -1); + cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1); + Tcl_DStringFree(&tsdPtr->line); if (!Tcl_CommandComplete(cmd)) { gotPartial = 1; goto prompt; @@ -323,17 +354,14 @@ StdinProc(clientData, mask) Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, (ClientData) chan); } - Tcl_DStringFree(&command); - if (*interp->result != 0) { - if ((code != TCL_OK) || (tty)) { - /* - * The statement below used to call "printf", but that resulted - * in core dumps under Solaris 2.3 if the result was very long. - * - * NOTE: This probably will not work under Windows either. - */ - - puts(interp->result); + Tcl_DStringFree(&tsdPtr->command); + if (Tcl_GetStringResult(interp)[0] != '\0') { + if ((code != TCL_OK) || (tsdPtr->tty)) { + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); + } } } @@ -342,7 +370,7 @@ StdinProc(clientData, mask) */ prompt: - if (tty) { + if (tsdPtr->tty) { Prompt(interp, gotPartial); } Tcl_ResetResult(interp); @@ -391,7 +419,7 @@ defaultPrompt: outChannel = Tcl_GetChannel(interp, "stdout", NULL); if (outChannel != (Tcl_Channel) NULL) { - Tcl_Write(outChannel, "% ", 2); + Tcl_WriteChars(outChannel, "% ", 2); } } } else { @@ -407,8 +435,8 @@ defaultPrompt: errChannel = Tcl_GetChannel(interp, "stderr", NULL); if (errChannel != (Tcl_Channel) NULL) { - Tcl_Write(errChannel, interp->result, -1); - Tcl_Write(errChannel, "\n", 1); + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); + Tcl_WriteChars(errChannel, "\n", 1); } goto defaultPrompt; } diff --git a/generic/tkMenu.c b/generic/tkMenu.c index cbcdcb8..5a3de18 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -7,12 +7,12 @@ * and drawing code for menus is in the file tkMenuDraw.c * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * 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. * - * RCS: @(#) $Id: tkMenu.c,v 1.2 1998/09/14 18:23:14 stanton Exp $ + * RCS: @(#) $Id: tkMenu.c,v 1.3 1999/04/16 01:51:19 stanton Exp $ */ /* @@ -68,174 +68,247 @@ * */ +#if 0 + +/* + * used only to test for old config code + */ + +#define __NO_OLD_CONFIG +#endif + #include "tkPort.h" #include "tkMenu.h" #define MENU_HASH_KEY "tkMenus" -static int menusInitialized; /* Whether or not the hash tables, etc., have - * been setup */ +typedef struct ThreadSpecificData { + int menusInitialized; /* Flag indicates whether thread-specific + * elements of the Windows Menu module + * have been initialized. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * The following flag indicates whether the process-wide state for + * the Menu module has been intialized. The Mutex protects access to + * that flag. + */ + +static int menusInitialized; +TCL_DECLARE_MUTEX(menuMutex) /* * Configuration specs for individual menu entries. If this changes, be sure * to update code in TkpMenuInit that changes the font string entry. */ -Tk_ConfigSpec tkMenuEntryConfigSpecs[] = { - {TK_CONFIG_BORDER, "-activebackground", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorder), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_ACTIVE_FG, Tk_Offset(TkMenuEntry, activeFg), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(TkMenuEntry, accel), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_BG, Tk_Offset(TkMenuEntry, border), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |SEPARATOR_MASK|TEAROFF_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_BITMAP, Tk_Offset(TkMenuEntry, bitmap), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_COLUMN_BREAK, Tk_Offset(TkMenuEntry, columnBreak), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK}, - {TK_CONFIG_STRING, "-command", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_COMMAND, Tk_Offset(TkMenuEntry, command), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_FONT, Tk_Offset(TkMenuEntry, tkfont), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_FG, Tk_Offset(TkMenuEntry, fg), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_HIDE_MARGIN, Tk_Offset(TkMenuEntry, hideMargin), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |SEPARATOR_MASK|TEAROFF_MASK}, - {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_IMAGE, Tk_Offset(TkMenuEntry, imageString), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_INDICATOR, Tk_Offset(TkMenuEntry, indicatorOn), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_LABEL, Tk_Offset(TkMenuEntry, label), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK}, - {TK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_MENU, Tk_Offset(TkMenuEntry, name), - CASCADE_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-offvalue", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_OFF_VALUE, Tk_Offset(TkMenuEntry, offValue), - CHECK_BUTTON_MASK}, - {TK_CONFIG_STRING, "-onvalue", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_ON_VALUE, Tk_Offset(TkMenuEntry, onValue), - CHECK_BUTTON_MASK}, - {TK_CONFIG_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_SELECT, Tk_Offset(TkMenuEntry, indicatorFg), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-selectimage", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_SELECT_IMAGE, Tk_Offset(TkMenuEntry, selectImageString), - CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_UID, "-state", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_STATE, Tk_Offset(TkMenuEntry, state), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TEAROFF_MASK|TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_STRING, "-value", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_VALUE, Tk_Offset(TkMenuEntry, onValue), - RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_CHECK_VARIABLE, Tk_Offset(TkMenuEntry, name), - CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_RADIO_VARIABLE, Tk_Offset(TkMenuEntry, name), - RADIO_BUTTON_MASK}, - {TK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL, - DEF_MENU_ENTRY_UNDERLINE, Tk_Offset(TkMenuEntry, underline), - COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK - |TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL}; + +static char *menuEntryTypeStrings[] = {"cascade", "checkbutton", "command", + "radiobutton", "separator", (char *) NULL}; + +Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { + {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1, + TK_OPTION_NULL_OK}, + {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACTIVE_FG, + Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ACCELERATOR, + Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_BG, + Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_BITMAP, + Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_COLUMN_BREAK, + -1, Tk_Offset(TkMenuEntry, columnBreak)}, + {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_COMMAND, + Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_FONT, + Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_FG, + Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_HIDE_MARGIN, + -1, Tk_Offset(TkMenuEntry, hideMargin)}, + {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_IMAGE, + Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_LABEL, + Tk_Offset(TkMenuEntry, labelPtr), -1, 0}, + {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_STATE, + -1, Tk_Offset(TkMenuEntry, state), 0, + (ClientData) tkMenuStateStrings}, + {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)}, + {TK_OPTION_END} +}; + +Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = { + {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_BG, + Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_END} +}; + +Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = { + {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_INDICATOR, + -1, Tk_Offset(TkMenuEntry, indicatorOn)}, + {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_OFF_VALUE, + Tk_Offset(TkMenuEntry, offValuePtr), -1}, + {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_ON_VALUE, + Tk_Offset(TkMenuEntry, onValuePtr), -1}, + {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_SELECT, + Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_SELECT_IMAGE, + Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_CHECK_VARIABLE, + Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} +}; + +Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = { + {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_INDICATOR, + -1, Tk_Offset(TkMenuEntry, indicatorOn)}, + {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_SELECT, + Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_SELECT_IMAGE, + Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_VALUE, + Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_RADIO_VARIABLE, + Tk_Offset(TkMenuEntry, namePtr), -1, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} }; +Tk_OptionSpec tkCascadeEntryConfigSpecs[] = { + {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_MENU, + Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} +}; + +Tk_OptionSpec tkTearoffEntryConfigSpecs[] = { + {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_BG, + Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL, + DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0, + (ClientData) tkMenuStateStrings}, + {TK_OPTION_END} +}; + +static Tk_OptionSpec *specsArray[] = { + tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs, + tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs, + tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs}; + /* - * Configuration specs valid for the menu as a whole. If this changes, be sure - * to update code in TkpMenuInit that changes the font string entry. + * Menu type strings for use with Tcl_GetIndexFromObj. */ -Tk_ConfigSpec tkMenuConfigSpecs[] = { - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_MENU_ACTIVE_BG_COLOR, Tk_Offset(TkMenu, activeBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_MENU_ACTIVE_BG_MONO, Tk_Offset(TkMenu, activeBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_PIXELS, "-activeborderwidth", "activeBorderWidth", +static char *menuTypeStrings[] = {"normal", "tearoff", "menubar", + (char *) NULL}; + +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}, + {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth", "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH, - Tk_Offset(TkMenu, activeBorderWidth), 0}, - {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", - DEF_MENU_ACTIVE_FG_COLOR, Tk_Offset(TkMenu, activeFg), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", - DEF_MENU_ACTIVE_FG_MONO, Tk_Offset(TkMenu, activeFg), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, border), TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_MENU_BG_MONO, Tk_Offset(TkMenu, border), TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_MENU_BORDER_WIDTH, Tk_Offset(TkMenu, borderWidth), 0}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_MENU_CURSOR, Tk_Offset(TkMenu, cursor), TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", + Tk_Offset(TkMenu, activeBorderWidthPtr), -1}, + {TK_OPTION_COLOR, "-activeforeground", "activeForeground", + "Background", DEF_MENU_ACTIVE_FG_COLOR, + Tk_Offset(TkMenu, activeFgPtr), -1, 0, + (ClientData) DEF_MENU_ACTIVE_FG_MONO}, + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0, + (ClientData) DEF_MENU_BG_MONO}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background"}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_MENU_BORDER_WIDTH, + Tk_Offset(TkMenu, borderWidthPtr), -1, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_MENU_CURSOR, + Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR, - Tk_Offset(TkMenu, disabledFg), TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", - "DisabledForeground", DEF_MENU_DISABLED_FG_MONO, - Tk_Offset(TkMenu, disabledFg), TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_FONT, "-font", "font", "Font", - DEF_MENU_FONT, Tk_Offset(TkMenu, tkfont), 0}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_MENU_FG, Tk_Offset(TkMenu, fg), 0}, - {TK_CONFIG_STRING, "-postcommand", "postCommand", "Command", - DEF_MENU_POST_COMMAND, Tk_Offset(TkMenu, postCommand), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_MENU_RELIEF, Tk_Offset(TkMenu, relief), 0}, - {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background", - DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFg), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background", - DEF_MENU_SELECT_MONO, Tk_Offset(TkMenu, indicatorFg), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_MENU_TAKE_FOCUS, Tk_Offset(TkMenu, takeFocus), TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-tearoff", "tearOff", "TearOff", - DEF_MENU_TEAROFF, Tk_Offset(TkMenu, tearOff), 0}, - {TK_CONFIG_STRING, "-tearoffcommand", "tearOffCommand", "TearOffCommand", - DEF_MENU_TEAROFF_CMD, Tk_Offset(TkMenu, tearOffCommand), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-title", "title", "Title", - DEF_MENU_TITLE, Tk_Offset(TkMenu, title), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-type", "type", "Type", - DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypeName), TK_CONFIG_NULL_OK}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} + Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK, + (ClientData) DEF_MENU_DISABLED_FG_MONO}, + {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-foreground"}, + {TK_OPTION_FONT, "-font", "font", "Font", + DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1}, + {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", + DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1}, + {TK_OPTION_STRING, "-postcommand", "postCommand", "Command", + DEF_MENU_POST_COMMAND, + Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1}, + {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background", + DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0, + (ClientData) DEF_MENU_SELECT_MONO}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_MENU_TAKE_FOCUS, + Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff", + DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)}, + {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand", + "TearOffCommand", DEF_MENU_TEAROFF_CMD, + Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK}, + {TK_OPTION_STRING, "-title", "title", "Title", + DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1, + TK_OPTION_NULL_OK}, + {TK_OPTION_STRING_TABLE, "-type", "type", "Type", + DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK, + (ClientData) menuTypeStrings}, + {TK_OPTION_END} +}; + +/* + * Command line options. Put here because MenuCmd has to look at them + * along with MenuWidgetObjCmd. + */ + +static char *menuOptions[] = { + "activate", "add", "cget", "clone", "configure", "delete", "entrycget", + "entryconfigure", "index", "insert", "invoke", "post", "postcascade", + "type", "unpost", "yposition", (char *) NULL +}; +enum options { + MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE, + MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX, + MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE, + MENU_UNPOST, MENU_YPOSITION }; /* @@ -243,15 +316,14 @@ Tk_ConfigSpec tkMenuConfigSpecs[] = { */ static int CloneMenu _ANSI_ARGS_((TkMenu *menuPtr, - char *newMenuName, char *newMenuTypeString)); + Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString)); static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp, - TkMenu *menuPtr, int argc, char **argv, - int flags)); + TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[])); static int ConfigureMenuCloneEntries _ANSI_ARGS_(( Tcl_Interp *interp, TkMenu *menuPtr, int index, - int argc, char **argv, int flags)); + int objc, Tcl_Obj *CONST objv[])); static int ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr, - int argc, char **argv, int flags)); + int objc, Tcl_Obj *CONST objv[])); static void DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr, int first, int last)); static void DestroyMenuHashTable _ANSI_ARGS_(( @@ -262,10 +334,13 @@ static int GetIndexFromCoords _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr, char *string, int *indexPtr)); static int MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp, - TkMenu *menuPtr, char *arg)); + TkMenu *menuPtr, Tcl_Obj *objPtr)); static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp, - TkMenu *menuPtr, char *indexString, int argc, - char **argv)); + TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc, + Tcl_Obj *CONST objv[])); +static int MenuCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static void MenuCmdDeletedProc _ANSI_ARGS_(( ClientData clientData)); static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index, @@ -273,10 +348,12 @@ static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index, static char * MenuVarProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)); -static int MenuWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +static int MenuWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static void MenuWorldChanged _ANSI_ARGS_(( ClientData instanceData)); +static int PostProcessEntry _ANSI_ARGS_((TkMenuEntry *mePtr)); static void RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr)); static void UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr)); @@ -290,13 +367,61 @@ static TkClassProcs menuClass = { NULL, /* createProc. */ MenuWorldChanged /* geometryProc. */ }; + +/* + *-------------------------------------------------------------- + * + * Tk_CreateMenuCmd -- + * + * Called by Tk at initialization time to create the menu + * command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ +int +TkCreateMenuCmd(interp) + 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, + (ClientData) optionTablesPtr, NULL); + + if (Tcl_IsSafe(interp)) { + Tcl_HideCommand(interp, "menu", "menu"); + } + return TCL_OK; +} /* *-------------------------------------------------------------- * - * Tk_MenuCmd -- + * MenuCmd -- * * This procedure is invoked to process the "menu" Tcl * command. See the user documentation for details on @@ -311,48 +436,45 @@ static TkClassProcs menuClass = { *-------------------------------------------------------------- */ -int -Tk_MenuCmd(clientData, interp, argc, argv) +static int +MenuCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = Tk_MainWindow(interp); Tk_Window new; register TkMenu *menuPtr; TkMenuReferences *menuRefPtr; - int i, len; - char *arg, c; + int i, index; int toplevel; + char *windowName; + static char *typeStringList[] = {"-type", (char *) NULL}; + TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } TkMenuInit(); toplevel = 1; - for (i = 2; i < argc; i += 2) { - arg = argv[i]; - len = strlen(arg); - if (len < 2) { - continue; - } - c = arg[1]; - if ((c == 't') && (strncmp(arg, "-type", strlen(arg)) == 0) - && (len >= 3)) { - if (strcmp(argv[i + 1], "menubar") == 0) { + 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)) { toplevel = 0; } break; } } - new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], toplevel ? "" + windowName = Tcl_GetStringFromObj(objv[1], NULL); + new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? "" : NULL); if (new == NULL) { return TCL_ERROR; @@ -366,27 +488,27 @@ Tk_MenuCmd(clientData, interp, argc, argv) menuPtr->tkwin = new; menuPtr->display = Tk_Display(new); menuPtr->interp = interp; - menuPtr->widgetCmd = Tcl_CreateCommand(interp, - Tk_PathName(menuPtr->tkwin), MenuWidgetCmd, + menuPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, (ClientData) menuPtr, MenuCmdDeletedProc); menuPtr->entries = NULL; menuPtr->numEntries = 0; menuPtr->active = -1; - menuPtr->border = NULL; - menuPtr->borderWidth = 0; - menuPtr->relief = TK_RELIEF_FLAT; - menuPtr->activeBorder = NULL; - menuPtr->activeBorderWidth = 0; - menuPtr->tkfont = NULL; - menuPtr->fg = NULL; - menuPtr->disabledFg = NULL; - menuPtr->activeFg = NULL; - menuPtr->indicatorFg = NULL; - menuPtr->tearOff = 1; - menuPtr->tearOffCommand = NULL; - menuPtr->cursor = None; - menuPtr->takeFocus = NULL; - menuPtr->postCommand = NULL; + menuPtr->borderPtr = NULL; + menuPtr->borderWidthPtr = NULL; + menuPtr->reliefPtr = NULL; + menuPtr->activeBorderPtr = NULL; + menuPtr->activeBorderWidthPtr = NULL; + menuPtr->fontPtr = NULL; + menuPtr->fgPtr = NULL; + menuPtr->disabledFgPtr = NULL; + menuPtr->activeFgPtr = NULL; + menuPtr->indicatorFgPtr = NULL; + menuPtr->tearoff = 0; + menuPtr->tearoffCommandPtr = NULL; + menuPtr->cursorPtr = None; + menuPtr->takeFocusPtr = NULL; + menuPtr->postCommandPtr = NULL; menuPtr->postCommandGeneration = 0; menuPtr->postedCascade = NULL; menuPtr->nextInstancePtr = NULL; @@ -394,24 +516,38 @@ Tk_MenuCmd(clientData, interp, argc, argv) menuPtr->menuType = UNKNOWN_TYPE; menuPtr->menuFlags = 0; menuPtr->parentTopLevelPtr = NULL; - menuPtr->menuTypeName = NULL; - menuPtr->title = NULL; + menuPtr->menuTypePtr = NULL; + menuPtr->titlePtr = NULL; + menuPtr->errorStructPtr = NULL; + menuPtr->optionTablesPtr = optionTablesPtr; TkMenuInitializeDrawingFields(menuPtr); + Tk_SetClass(menuPtr->tkwin, "Menu"); + TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr); + if (Tk_InitOptions(interp, (char *) menuPtr, + menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin) + != TCL_OK) { + Tk_DestroyWindow(menuPtr->tkwin); + ckfree((char *) menuPtr); + return TCL_ERROR; + } + + menuRefPtr = TkCreateMenuReferences(menuPtr->interp, Tk_PathName(menuPtr->tkwin)); menuRefPtr->menuPtr = menuPtr; menuPtr->menuRefPtr = menuRefPtr; if (TCL_OK != TkpNewMenu(menuPtr)) { - goto error; + Tk_DestroyWindow(menuPtr->tkwin); + ckfree((char *) menuPtr); + return TCL_ERROR; } - Tk_SetClass(menuPtr->tkwin, "Menu"); - TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr); Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask, TkMenuEventProc, (ClientData) menuPtr); - if (ConfigureMenu(interp, menuPtr, argc-2, argv+2, 0) != TCL_OK) { - goto error; + if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) { + Tk_DestroyWindow(menuPtr->tkwin); + return TCL_ERROR; } /* @@ -434,8 +570,8 @@ Tk_MenuCmd(clientData, interp, argc, argv) if (menuRefPtr->parentEntryPtr != NULL) { TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr; TkMenuEntry *nextCascadePtr; - char *newMenuName; - char *newArgv[2]; + Tcl_Obj *newMenuName; + Tcl_Obj *newObjv[2]; while (cascadeListPtr != NULL) { @@ -454,28 +590,38 @@ Tk_MenuCmd(clientData, interp, argc, argv) || ((menuPtr->masterMenuPtr == menuPtr) && ((cascadeListPtr->menuPtr->masterMenuPtr == cascadeListPtr->menuPtr)))) { - newArgv[0] = "-menu"; - newArgv[1] = Tk_PathName(menuPtr->tkwin); - ConfigureMenuEntry(cascadeListPtr, 2, newArgv, - TK_CONFIG_ARGV_ONLY); + newObjv[0] = Tcl_NewStringObj("-menu", -1); + newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); + Tcl_IncrRefCount(newObjv[0]); + Tcl_IncrRefCount(newObjv[1]); + ConfigureMenuEntry(cascadeListPtr, 2, newObjv); + Tcl_DecrRefCount(newObjv[0]); + Tcl_DecrRefCount(newObjv[1]); } else { + Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1); + Tcl_Obj *windowNamePtr = Tcl_NewStringObj( + Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1); + + Tcl_IncrRefCount(normalPtr); + Tcl_IncrRefCount(windowNamePtr); newMenuName = TkNewMenuName(menuPtr->interp, - Tk_PathName(cascadeListPtr->menuPtr->tkwin), - menuPtr); - CloneMenu(menuPtr, newMenuName, "normal"); + windowNamePtr, menuPtr); + Tcl_IncrRefCount(newMenuName); + CloneMenu(menuPtr, newMenuName, normalPtr); /* * Now we can set the new menu instance to be the cascade entry * of the parent's instance. */ - newArgv[0] = "-menu"; - newArgv[1] = newMenuName; - ConfigureMenuEntry(cascadeListPtr, 2, newArgv, - TK_CONFIG_ARGV_ONLY); - if (newMenuName != NULL) { - ckfree(newMenuName); - } + newObjv[0] = Tcl_NewStringObj("-menu", -1); + newObjv[1] = newMenuName; + Tcl_IncrRefCount(newObjv[0]); + ConfigureMenuEntry(cascadeListPtr, 2, newObjv); + Tcl_DecrRefCount(normalPtr); + Tcl_DecrRefCount(newObjv[0]); + Tcl_DecrRefCount(newObjv[1]); + Tcl_DecrRefCount(windowNamePtr); } cascadeListPtr = nextCascadePtr; } @@ -507,18 +653,14 @@ Tk_MenuCmd(clientData, interp, argc, argv) } } - interp->result = Tk_PathName(menuPtr->tkwin); + Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC); return TCL_OK; - - error: - Tk_DestroyWindow(menuPtr->tkwin); - return TCL_ERROR; } /* *-------------------------------------------------------------- * - * MenuWidgetCmd -- + * MenuWidgetObjCmd -- * * This procedure is invoked to process the Tcl command * that corresponds to a widget managed by this module. @@ -534,317 +676,351 @@ Tk_MenuCmd(clientData, interp, argc, argv) */ static int -MenuWidgetCmd(clientData, interp, argc, argv) +MenuWidgetObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about menu widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings. */ { register TkMenu *menuPtr = (TkMenu *) clientData; register TkMenuEntry *mePtr; int result = TCL_OK; - size_t length; - int c; + int option; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg arg ...?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0, + &option) != TCL_OK) { return TCL_ERROR; } Tcl_Preserve((ClientData) menuPtr); - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0) - && (length >= 2)) { - int index; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " activate index\"", (char *) NULL); - goto error; - } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { - goto error; - } - if (menuPtr->active == index) { - goto done; - } - if (index >= 0) { - if ((menuPtr->entries[index]->type == SEPARATOR_ENTRY) - || (menuPtr->entries[index]->state == tkDisabledUid)) { + + switch ((enum options) option) { + case MENU_ACTIVATE: { + int index; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "activate index"); + goto error; + } + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) + != TCL_OK) { + goto error; + } + if (menuPtr->active == index) { + goto done; + } + if ((index >= 0) + && ((menuPtr->entries[index]->type == SEPARATOR_ENTRY) + || (menuPtr->entries[index]->state + == ENTRY_DISABLED))) { index = -1; } + result = TkActivateMenuEntry(menuPtr, index); + break; } - result = TkActivateMenuEntry(menuPtr, index); - } else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0) - && (length >= 2)) { - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " add type ?options?\"", (char *) NULL); - goto error; + case MENU_ADD: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?"); + goto error; + } + + if (MenuAddOrInsert(interp, menuPtr, (Tcl_Obj *) NULL, + objc - 2, objv + 2) != TCL_OK) { + goto error; + } + break; + case MENU_CGET: { + Tcl_Obj *resultPtr; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); + goto error; + } + resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr, + menuPtr->optionTablesPtr->menuOptionTable, objv[2], + menuPtr->tkwin); + if (resultPtr == NULL) { + goto error; + } + Tcl_SetObjResult(interp, resultPtr); + break; } - if (MenuAddOrInsert(interp, menuPtr, (char *) NULL, - argc-2, argv+2) != TCL_OK) { - goto error; + case MENU_CLONE: + if ((objc < 3) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 1, objv, + "clone newMenuName ?menuType?"); + goto error; + } + result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]); + break; + case MENU_CONFIGURE: { + Tcl_Obj *resultPtr; + + if (objc == 2) { + resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, + menuPtr->optionTablesPtr->menuOptionTable, + (Tcl_Obj *) NULL, menuPtr->tkwin); + if (resultPtr == NULL) { + result = TCL_ERROR; + } else { + result = TCL_OK; + Tcl_SetObjResult(interp, resultPtr); + } + } else if (objc == 3) { + resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, + menuPtr->optionTablesPtr->menuOptionTable, + objv[2], menuPtr->tkwin); + if (resultPtr == NULL) { + result = TCL_ERROR; + } else { + result = TCL_OK; + Tcl_SetObjResult(interp, resultPtr); + } + } else { + result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2); + } + if (result != TCL_OK) { + goto error; + } + break; } - } 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\"", - (char *) NULL); - goto error; + case MENU_DELETE: { + int first, last; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?"); + goto error; + } + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first) + != TCL_OK) { + goto error; + } + if (objc == 3) { + last = first; + } else { + if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last) + != TCL_OK) { + goto error; + } + } + if (menuPtr->tearoff && (first == 0)) { + + /* + * Sorry, can't delete the tearoff entry; must reconfigure + * the menu. + */ + + first = 1; + } + if ((first < 0) || (last < first)) { + goto done; + } + DeleteMenuCloneEntries(menuPtr, first, last); + break; } - result = Tk_ConfigureValue(interp, menuPtr->tkwin, tkMenuConfigSpecs, - (char *) menuPtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "clone", length) == 0) - && (length >=2)) { - if ((argc < 3) || (argc > 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " clone newMenuName ?menuType?\"", - (char *) NULL); - goto error; - } - result = CloneMenu(menuPtr, argv[2], (argc == 3) ? NULL : argv[3]); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, menuPtr->tkwin, - tkMenuConfigSpecs, (char *) menuPtr, (char *) NULL, 0); - } else if (argc == 3) { - result = Tk_ConfigureInfo(interp, menuPtr->tkwin, - tkMenuConfigSpecs, (char *) menuPtr, argv[2], 0); - } else { - result = ConfigureMenu(interp, menuPtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); + case MENU_ENTRYCGET: { + int index; + Tcl_Obj *resultPtr; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option"); + goto error; + } + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) + != TCL_OK) { + goto error; + } + if (index < 0) { + goto done; + } + mePtr = menuPtr->entries[index]; + Tcl_Preserve((ClientData) mePtr); + resultPtr = Tk_GetOptionValue(interp, (char *) mePtr, + mePtr->optionTable, objv[3], menuPtr->tkwin); + Tcl_Release((ClientData) mePtr); + if (resultPtr == NULL) { + goto error; + } + Tcl_SetObjResult(interp, resultPtr); + break; } - } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) { - int first, last; + case MENU_ENTRYCONFIGURE: { + int index; + Tcl_Obj *resultPtr; - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delete first ?last?\"", (char *) NULL); - goto error; + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, + "entryconfigure index ?option value ...?"); + goto error; + } + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) + != TCL_OK) { + goto error; + } + if (index < 0) { + goto done; + } + mePtr = menuPtr->entries[index]; + Tcl_Preserve((ClientData) mePtr); + if (objc == 3) { + resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr, + mePtr->optionTable, (Tcl_Obj *) NULL, menuPtr->tkwin); + if (resultPtr == NULL) { + result = TCL_ERROR; + } else { + result = TCL_OK; + Tcl_SetObjResult(interp, resultPtr); + } + } else if (objc == 4) { + resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr, + mePtr->optionTable, objv[3], menuPtr->tkwin); + if (resultPtr == NULL) { + result = TCL_ERROR; + } else { + result = TCL_OK; + Tcl_SetObjResult(interp, resultPtr); + } + } else { + result = ConfigureMenuCloneEntries(interp, menuPtr, index, + objc - 3, objv + 3); + } + Tcl_Release((ClientData) mePtr); + break; } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &first) != TCL_OK) { - goto error; + case MENU_INDEX: { + int index; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "index string"); + goto error; + } + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) + != TCL_OK) { + goto error; + } + if (index < 0) { + Tcl_SetResult(interp, "none", TCL_STATIC); + } else { + Tcl_SetIntObj(Tcl_GetObjResult(interp), index); + } + break; } - if (argc == 3) { - last = first; - } else { - if (TkGetMenuIndex(interp, menuPtr, argv[3], 0, &last) != TCL_OK) { - goto error; + case MENU_INSERT: + if (objc < 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "insert index type ?options?"); + goto error; + } + if (MenuAddOrInsert(interp, menuPtr, objv[2], objc - 3, + objv + 3) != TCL_OK) { + goto error; + } + break; + case MENU_INVOKE: { + int index; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "invoke index"); + goto error; + } + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) + != TCL_OK) { + goto error; } + if (index < 0) { + goto done; + } + result = TkInvokeMenu(interp, menuPtr, index); + break; } - if (menuPtr->tearOff && (first == 0)) { + case MENU_POST: { + int x, y; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "post x y"); + goto error; + } + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { + goto error; + } /* - * Sorry, can't delete the tearoff entry; must reconfigure - * the menu. + * Tearoff menus are posted differently on Mac and Windows than + * non-tearoffs. TkpPostMenu does not actually map the menu's + * window on those platforms, and popup menus have to be + * handled specially. */ - first = 1; - } - if ((first < 0) || (last < first)) { - goto done; - } - DeleteMenuCloneEntries(menuPtr, first, last); - } else if ((c == 'e') && (length >= 7) - && (strncmp(argv[1], "entrycget", length) == 0)) { - int index; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " entrycget index option\"", - (char *) NULL); - goto error; - } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { - goto error; - } - if (index < 0) { - goto done; - } - mePtr = menuPtr->entries[index]; - Tcl_Preserve((ClientData) mePtr); - result = Tk_ConfigureValue(interp, menuPtr->tkwin, - tkMenuEntryConfigSpecs, (char *) mePtr, argv[3], - COMMAND_MASK << mePtr->type); - Tcl_Release((ClientData) mePtr); - } else if ((c == 'e') && (length >= 7) - && (strncmp(argv[1], "entryconfigure", length) == 0)) { - int index; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " entryconfigure index ?option value ...?\"", - (char *) NULL); - goto error; - } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { - goto error; - } - if (index < 0) { - goto done; - } - mePtr = menuPtr->entries[index]; - Tcl_Preserve((ClientData) mePtr); - if (argc == 3) { - result = Tk_ConfigureInfo(interp, menuPtr->tkwin, - tkMenuEntryConfigSpecs, (char *) mePtr, (char *) NULL, - COMMAND_MASK << mePtr->type); - } else if (argc == 4) { - result = Tk_ConfigureInfo(interp, menuPtr->tkwin, - tkMenuEntryConfigSpecs, (char *) mePtr, argv[3], - COMMAND_MASK << mePtr->type); - } else { - result = ConfigureMenuCloneEntries(interp, menuPtr, index, - argc-3, argv+3, - TK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type); - } - Tcl_Release((ClientData) mePtr); - } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) - && (length >= 3)) { - int index; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " index string\"", (char *) NULL); - goto error; - } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { - goto error; - } - if (index < 0) { - interp->result = "none"; - } else { - sprintf(interp->result, "%d", index); - } - } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) - && (length >= 3)) { - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " insert index type ?options?\"", (char *) NULL); - goto error; - } - if (MenuAddOrInsert(interp, menuPtr, argv[2], - argc-3, argv+3) != TCL_OK) { - goto error; + if (menuPtr->menuType != TEAROFF_MENU) { + result = TkpPostMenu(interp, menuPtr, x, y); + } else { + result = TkPostTearoffMenu(interp, menuPtr, x, y); + } + break; } - } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0) - && (length >= 3)) { - int index; + case MENU_POSTCASCADE: { + int index; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " invoke index\"", (char *) NULL); - goto error; - } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { - goto error; - } - if (index < 0) { - goto done; - } - result = TkInvokeMenu(interp, menuPtr, index); - } else if ((c == 'p') && (strncmp(argv[1], "post", length) == 0) - && (length == 4)) { - int x, y; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " post x y\"", (char *) NULL); - goto error; - } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { - goto error; - } + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "postcascade index"); + goto error; + } - /* - * Tearoff menus are posted differently on Mac and Windows than - * non-tearoffs. TkpPostMenu does not actually map the menu's - * window on those platforms, and popup menus have to be - * handled specially. - */ - - if (menuPtr->menuType != TEAROFF_MENU) { - result = TkpPostMenu(interp, menuPtr, x, y); - } else { - result = TkPostTearoffMenu(interp, menuPtr, x, y); - } - } else if ((c == 'p') && (strncmp(argv[1], "postcascade", length) == 0) - && (length > 4)) { - int index; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " postcascade index\"", (char *) NULL); - goto error; + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) + != TCL_OK) { + goto error; + } + if ((index < 0) || (menuPtr->entries[index]->type + != CASCADE_ENTRY)) { + result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL); + } else { + result = TkPostSubmenu(interp, menuPtr, + menuPtr->entries[index]); + } + break; } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { - goto error; + case MENU_TYPE: { + int index; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "type index"); + goto error; + } + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) + != TCL_OK) { + goto error; + } + if (index < 0) { + goto done; + } + if (menuPtr->entries[index]->type == TEAROFF_ENTRY) { + Tcl_SetResult(interp, "tearoff", TCL_STATIC); + } else { + Tcl_SetResult(interp, + menuEntryTypeStrings[menuPtr->entries[index]->type], + TCL_STATIC); + } + break; } - if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) { + case MENU_UNPOST: + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "unpost"); + goto error; + } + Tk_UnmapWindow(menuPtr->tkwin); result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL); - } else { - result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]); - } - } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) { - int index; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " type index\"", (char *) NULL); - goto error; - } - if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) { - goto error; - } - if (index < 0) { - goto done; - } - mePtr = menuPtr->entries[index]; - switch (mePtr->type) { - case COMMAND_ENTRY: - interp->result = "command"; - break; - case SEPARATOR_ENTRY: - interp->result = "separator"; - break; - case CHECK_BUTTON_ENTRY: - interp->result = "checkbutton"; - break; - case RADIO_BUTTON_ENTRY: - interp->result = "radiobutton"; - break; - case CASCADE_ENTRY: - interp->result = "cascade"; - break; - case TEAROFF_ENTRY: - interp->result = "tearoff"; - break; - } - } else if ((c == 'u') && (strncmp(argv[1], "unpost", length) == 0)) { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " unpost\"", (char *) NULL); - goto error; - } - Tk_UnmapWindow(menuPtr->tkwin); - result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL); - } else if ((c == 'y') && (strncmp(argv[1], "yposition", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " yposition index\"", (char *) NULL); - goto error; - } - result = MenuDoYPosition(interp, menuPtr, argv[2]); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be activate, add, cget, clone, configure, delete, ", - "entrycget, entryconfigure, index, insert, invoke, ", - "post, postcascade, type, unpost, or yposition", - (char *) NULL); - goto error; + break; + case MENU_YPOSITION: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "yposition index"); + goto error; + } + result = MenuDoYPosition(interp, menuPtr, objv[2]); + break; } done: Tcl_Release((ClientData) menuPtr); @@ -854,7 +1030,6 @@ MenuWidgetCmd(clientData, interp, argc, argv) Tcl_Release((ClientData) menuPtr); return TCL_ERROR; } - /* *---------------------------------------------------------------------- @@ -888,45 +1063,60 @@ TkInvokeMenu(interp, menuPtr, index) goto done; } mePtr = menuPtr->entries[index]; - if (mePtr->state == tkDisabledUid) { + if (mePtr->state == ENTRY_DISABLED) { goto done; } Tcl_Preserve((ClientData) mePtr); if (mePtr->type == TEAROFF_ENTRY) { - Tcl_DString commandDString; - - Tcl_DStringInit(&commandDString); - Tcl_DStringAppendElement(&commandDString, "tkTearOffMenu"); - Tcl_DStringAppendElement(&commandDString, Tk_PathName(menuPtr->tkwin)); - result = Tcl_Eval(interp, Tcl_DStringValue(&commandDString)); - Tcl_DStringFree(&commandDString); - } else if (mePtr->type == CHECK_BUTTON_ENTRY) { + Tcl_DString ds; + Tcl_DStringInit(&ds); + Tcl_DStringAppend(&ds, "tkTearOffMenu ", -1); + Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1); + result = Tcl_Eval(interp, Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + } else if ((mePtr->type == CHECK_BUTTON_ENTRY) + && (mePtr->namePtr != NULL)) { + Tcl_Obj *valuePtr; + if (mePtr->entryFlags & ENTRY_SELECTED) { - if (Tcl_SetVar(interp, mePtr->name, mePtr->offValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; - } + valuePtr = mePtr->offValuePtr; } else { - if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue, - TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; - } + valuePtr = mePtr->onValuePtr; + } + if (valuePtr == NULL) { + valuePtr = Tcl_NewObj(); + } + Tcl_IncrRefCount(valuePtr); + if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr, + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + } + Tcl_DecrRefCount(valuePtr); + } else if ((mePtr->type == RADIO_BUTTON_ENTRY) + && (mePtr->namePtr != NULL)) { + Tcl_Obj *valuePtr = mePtr->onValuePtr; + + if (valuePtr == NULL) { + valuePtr = Tcl_NewObj(); } - } else if (mePtr->type == RADIO_BUTTON_ENTRY) { - if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue, + Tcl_IncrRefCount(valuePtr); + if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } + Tcl_DecrRefCount(valuePtr); } - if ((result == TCL_OK) && (mePtr->command != NULL)) { - result = TkCopyAndGlobalEval(interp, mePtr->command); + if ((result == TCL_OK) && (mePtr->commandPtr != NULL)) { + Tcl_Obj *commandPtr = mePtr->commandPtr; + + Tcl_IncrRefCount(commandPtr); + result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(commandPtr); } Tcl_Release((ClientData) mePtr); done: return result; } - - /* *---------------------------------------------------------------------- @@ -951,13 +1141,12 @@ static void DestroyMenuInstance(menuPtr) TkMenu *menuPtr; /* Info about menu widget. */ { - int i, numEntries = menuPtr->numEntries; + int i; TkMenu *menuInstancePtr; TkMenuEntry *cascadePtr, *nextCascadePtr; - char *newArgv[2]; + Tcl_Obj *newObjv[2]; TkMenu *parentMasterMenuPtr; TkMenuEntry *parentMasterEntryPtr; - TkMenu *parentMenuPtr; /* * If the menu has any cascade menu entries pointing to it, the cascade @@ -979,18 +1168,23 @@ DestroyMenuInstance(menuPtr) TkFreeMenuReferences(menuPtr->menuRefPtr); for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) { - parentMenuPtr = cascadePtr->menuPtr; nextCascadePtr = cascadePtr->nextCascadePtr; if (menuPtr->masterMenuPtr != menuPtr) { + Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1); + parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr; parentMasterEntryPtr = parentMasterMenuPtr->entries[cascadePtr->index]; - newArgv[0] = "-menu"; - newArgv[1] = parentMasterEntryPtr->name; - ConfigureMenuEntry(cascadePtr, 2, newArgv, TK_CONFIG_ARGV_ONLY); + newObjv[0] = menuNamePtr; + newObjv[1] = parentMasterEntryPtr->namePtr; + Tcl_IncrRefCount(newObjv[0]); + Tcl_IncrRefCount(newObjv[1]); + ConfigureMenuEntry(cascadePtr, 2, newObjv); + Tcl_DecrRefCount(newObjv[0]); + Tcl_DecrRefCount(newObjv[1]); } else { - ConfigureMenuEntry(cascadePtr, 0, (char **) NULL, 0); + ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL); } } @@ -1010,20 +1204,27 @@ DestroyMenuInstance(menuPtr) /* * Free up all the stuff that requires special handling, then - * let Tk_FreeOptions handle all the standard option-related + * let Tk_FreeConfigurationOptions handle all the standard option-related * stuff. */ - for (i = numEntries - 1; i >= 0; i--) { + for (i = menuPtr->numEntries; --i >= 0; ) { + /* + * As each menu entry is deleted from the end of the array of + * entries, decrement menuPtr->numEntries. Otherwise, the act of + * deleting menu entry i will dereference freed memory attempting + * to queue a redraw for menu entries (i+1)...numEntries. + */ + DestroyMenuEntry((char *) menuPtr->entries[i]); + menuPtr->numEntries = i; } if (menuPtr->entries != NULL) { ckfree((char *) menuPtr->entries); } TkMenuFreeDrawOptions(menuPtr); - Tk_FreeOptions(tkMenuConfigSpecs, (char *) menuPtr, menuPtr->display, 0); - - Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC); + Tk_FreeConfigOptions((char *) menuPtr, + menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin); } /* @@ -1202,7 +1403,7 @@ DestroyMenuEntry(memPtr) /* * Free up all the stuff that requires special handling, then - * let Tk_FreeOptions handle all the standard option-related + * let Tk_FreeConfigurationOptions handle all the standard option-related * stuff. */ @@ -1215,15 +1416,17 @@ DestroyMenuEntry(memPtr) if (mePtr->selectImage != NULL) { Tk_FreeImage(mePtr->selectImage); } - if (mePtr->name != NULL) { - Tcl_UntraceVar(menuPtr->interp, mePtr->name, + if (((mePtr->type == CHECK_BUTTON_ENTRY) + || (mePtr->type == RADIO_BUTTON_ENTRY)) + && (mePtr->namePtr != NULL)) { + char *varName = Tcl_GetStringFromObj(mePtr->namePtr, NULL); + Tcl_UntraceVar(menuPtr->interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuVarProc, (ClientData) mePtr); } TkpDestroyMenuEntry(mePtr); TkMenuEntryFreeDrawOptions(mePtr); - Tk_FreeOptions(tkMenuEntryConfigSpecs, (char *) mePtr, menuPtr->display, - (COMMAND_MASK << mePtr->type)); + Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin); ckfree((char *) mePtr); } @@ -1259,7 +1462,6 @@ MenuWorldChanged(instanceData) TkpConfigureMenuEntry(menuPtr->entries[i]); } } - /* *---------------------------------------------------------------------- @@ -1272,7 +1474,7 @@ MenuWorldChanged(instanceData) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as colors, font, etc. get set @@ -1282,23 +1484,32 @@ MenuWorldChanged(instanceData) */ static int -ConfigureMenu(interp, menuPtr, argc, argv, flags) +ConfigureMenu(interp, menuPtr, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ register TkMenu *menuPtr; /* Information about widget; may or may * not already have values for some fields. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ - int flags; /* Flags to pass to Tk_ConfigureWidget. */ + int objc; /* Number of valid entries in argv. */ + Tcl_Obj *CONST objv[]; /* Arguments. */ { int i; - TkMenu* menuListPtr; + TkMenu *menuListPtr, *cleanupPtr; + int result; for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; menuListPtr = menuListPtr->nextInstancePtr) { - - if (Tk_ConfigureWidget(interp, menuListPtr->tkwin, - tkMenuConfigSpecs, argc, argv, (char *) menuListPtr, - flags) != TCL_OK) { + menuListPtr->errorStructPtr = (Tk_SavedOptions *) + ckalloc(sizeof(Tk_SavedOptions)); + result = Tk_SetOptions(interp, (char *) menuListPtr, + menuListPtr->optionTablesPtr->menuOptionTable, objc, objv, + menuListPtr->tkwin, menuListPtr->errorStructPtr, (int *) NULL); + if (result != TCL_OK) { + for (cleanupPtr = menuPtr->masterMenuPtr; + cleanupPtr != menuListPtr; + cleanupPtr = cleanupPtr->nextInstancePtr) { + Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); + ckfree((char *) cleanupPtr->errorStructPtr); + cleanupPtr->errorStructPtr = NULL; + } return TCL_ERROR; } @@ -1310,33 +1521,57 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags) */ if (menuListPtr->menuType == UNKNOWN_TYPE) { - if (strcmp(menuListPtr->menuTypeName, "menubar") == 0) { - menuListPtr->menuType = MENUBAR; - } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) { - menuListPtr->menuType = TEAROFF_MENU; - } else { - menuListPtr->menuType = MASTER_MENU; + Tcl_GetIndexFromObj(NULL, menuListPtr->menuTypePtr, + menuTypeStrings, NULL, 0, &menuListPtr->menuType); + + /* + * Configure the new window to be either a pop-up menu + * or a tear-off menu. + * We don't do this for menubars since they are not toplevel + * windows. Also, since this gets called before CloneMenu has + * a chance to set the menuType field, we have to look at the + * menuTypeName field to tell that this is a menu bar. + */ + + if (menuListPtr->menuType == MASTER_MENU) { + TkpMakeMenuWindow(menuListPtr->tkwin, 1); + } else if (menuListPtr->menuType == TEAROFF_MENU) { + TkpMakeMenuWindow(menuListPtr->tkwin, 0); } } - + + /* * Depending on the -tearOff option, make sure that there is or * isn't an initial tear-off entry at the beginning of the menu. */ - if (menuListPtr->tearOff) { + if (menuListPtr->tearoff) { if ((menuListPtr->numEntries == 0) || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) { if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) { + if (menuListPtr->errorStructPtr != NULL) { + for (cleanupPtr = menuPtr->masterMenuPtr; + cleanupPtr != menuListPtr; + cleanupPtr = cleanupPtr->nextInstancePtr) { + Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); + ckfree((char *) cleanupPtr->errorStructPtr); + cleanupPtr->errorStructPtr = NULL; + } + Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); + ckfree((char *) cleanupPtr->errorStructPtr); + cleanupPtr->errorStructPtr = NULL; + } return TCL_ERROR; } } } else if ((menuListPtr->numEntries > 0) && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) { int i; - + Tcl_EventuallyFree((ClientData) menuListPtr->entries[0], DestroyMenuEntry); + for (i = 0; i < menuListPtr->numEntries - 1; i++) { menuListPtr->entries[i] = menuListPtr->entries[i + 1]; menuListPtr->entries[i]->index = i; @@ -1349,21 +1584,6 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags) } TkMenuConfigureDrawOptions(menuListPtr); - - /* - * Configure the new window to be either a pop-up menu - * or a tear-off menu. - * We don't do this for menubars since they are not toplevel - * windows. Also, since this gets called before CloneMenu has - * a chance to set the menuType field, we have to look at the - * menuTypeName field to tell that this is a menu bar. - */ - - if (strcmp(menuListPtr->menuTypeName, "normal") == 0) { - TkpMakeMenuWindow(menuListPtr->tkwin, 1); - } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) { - TkpMakeMenuWindow(menuListPtr->tkwin, 0); - } /* * After reconfiguring a menu, we need to reconfigure all of the @@ -1376,28 +1596,35 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags) TkMenuEntry *mePtr; mePtr = menuListPtr->entries[i]; - ConfigureMenuEntry(mePtr, 0, - (char **) NULL, TK_CONFIG_ARGV_ONLY - | COMMAND_MASK << mePtr->type); + ConfigureMenuEntry(mePtr, 0, (Tcl_Obj **) NULL); } TkEventuallyRecomputeMenu(menuListPtr); } + for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL; + cleanupPtr = cleanupPtr->nextInstancePtr) { + Tk_FreeSavedOptions(cleanupPtr->errorStructPtr); + ckfree((char *) cleanupPtr->errorStructPtr); + cleanupPtr->errorStructPtr = NULL; + } + return TCL_OK; } + /* *---------------------------------------------------------------------- * - * ConfigureMenuEntry -- + * PostProcessEntry -- * - * This procedure is called to process an argv/argc list in order - * to configure (or reconfigure) one entry in a menu. + * This is called by ConfigureMenuEntry to do all of the configuration + * after Tk_SetOptions is called. This is separate + * so that error handling is easier. * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information such as label and accelerator get @@ -1407,55 +1634,29 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags) */ static int -ConfigureMenuEntry(mePtr, argc, argv, flags) - register TkMenuEntry *mePtr; /* Information about menu entry; may - * or may not already have values for - * some fields. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ - int flags; /* Additional flags to pass to - * Tk_ConfigureWidget. */ +PostProcessEntry(mePtr) + TkMenuEntry *mePtr; /* The entry we are configuring. */ { TkMenu *menuPtr = mePtr->menuPtr; int index = mePtr->index; + char *name; Tk_Image image; /* - * If this entry is a check button or radio button, then remove - * its old trace procedure. - */ - - if ((mePtr->name != NULL) - && ((mePtr->type == CHECK_BUTTON_ENTRY) - || (mePtr->type == RADIO_BUTTON_ENTRY))) { - Tcl_UntraceVar(menuPtr->interp, mePtr->name, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuVarProc, (ClientData) mePtr); - } - - if (menuPtr->tkwin != NULL) { - if (Tk_ConfigureWidget(menuPtr->interp, menuPtr->tkwin, - tkMenuEntryConfigSpecs, argc, argv, (char *) mePtr, - flags | (COMMAND_MASK << mePtr->type)) != TCL_OK) { - return TCL_ERROR; - } - } - - /* * The code below handles special configuration stuff not taken * care of by Tk_ConfigureWidget, such as special processing for * defaults, sizing strings, graphics contexts, etc. */ - if (mePtr->label == NULL) { + if (mePtr->labelPtr == NULL) { mePtr->labelLength = 0; } else { - mePtr->labelLength = strlen(mePtr->label); + Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength); } - if (mePtr->accel == NULL) { + if (mePtr->accelPtr == NULL) { mePtr->accelLength = 0; } else { - mePtr->accelLength = strlen(mePtr->accel); + Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength); } /* @@ -1464,9 +1665,8 @@ ConfigureMenuEntry(mePtr, argc, argv, flags) * cascades have to be updated. */ - if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) { + if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) { TkMenuEntry *cascadeEntryPtr; - TkMenu *cascadeMenuPtr; int alreadyThere; TkMenuReferences *menuRefPtr; char *oldHashKey = NULL; /* Initialization only needed to @@ -1482,19 +1682,18 @@ ConfigureMenuEntry(mePtr, argc, argv, flags) * BUG: We are not recloning for special case #3 yet. */ + name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); if (mePtr->childMenuRefPtr != NULL) { oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp), mePtr->childMenuRefPtr->hashEntryPtr); - if (strcmp(oldHashKey, mePtr->name) != 0) { + if (strcmp(oldHashKey, name) != 0) { UnhookCascadeEntry(mePtr); } } if ((mePtr->childMenuRefPtr == NULL) - || (strcmp(oldHashKey, mePtr->name) != 0)) { - menuRefPtr = TkCreateMenuReferences(menuPtr->interp, - mePtr->name); - cascadeMenuPtr = menuRefPtr->menuPtr; + || (strcmp(oldHashKey, name) != 0)) { + menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name); mePtr->childMenuRefPtr = menuRefPtr; if (menuRefPtr->parentEntryPtr == NULL) { @@ -1531,52 +1730,15 @@ ConfigureMenuEntry(mePtr, argc, argv, flags) return TCL_ERROR; } - if ((mePtr->type == CHECK_BUTTON_ENTRY) - || (mePtr->type == RADIO_BUTTON_ENTRY)) { - char *value; - - if (mePtr->name == NULL) { - mePtr->name = - (char *) ckalloc((unsigned) (mePtr->labelLength + 1)); - strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label); - } - if (mePtr->onValue == NULL) { - mePtr->onValue = (char *) ckalloc((unsigned) - (mePtr->labelLength + 1)); - strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label); - } - - /* - * Select the entry if the associated variable has the - * appropriate value, initialize the variable if it doesn't - * exist, then set a trace on the variable to monitor future - * changes to its value. - */ - - value = Tcl_GetVar(menuPtr->interp, mePtr->name, TCL_GLOBAL_ONLY); - mePtr->entryFlags &= ~ENTRY_SELECTED; - if (value != NULL) { - if (strcmp(value, mePtr->onValue) == 0) { - mePtr->entryFlags |= ENTRY_SELECTED; - } - } else { - Tcl_SetVar(menuPtr->interp, mePtr->name, - (mePtr->type == CHECK_BUTTON_ENTRY) ? mePtr->offValue : "", - TCL_GLOBAL_ONLY); - } - Tcl_TraceVar(menuPtr->interp, mePtr->name, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuVarProc, (ClientData) mePtr); - } - /* * Get the images for the entry, if there are any. Allocate the * new images before freeing the old ones, so that the reference * counts don't go to zero and cause image data to be discarded. */ - if (mePtr->imageString != NULL) { - image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->imageString, + if (mePtr->imagePtr != NULL) { + char *imageString = Tcl_GetStringFromObj(mePtr->imagePtr, NULL); + image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString, TkMenuImageProc, (ClientData) mePtr); if (image == NULL) { return TCL_ERROR; @@ -1588,8 +1750,10 @@ ConfigureMenuEntry(mePtr, argc, argv, flags) Tk_FreeImage(mePtr->image); } mePtr->image = image; - if (mePtr->selectImageString != NULL) { - image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->selectImageString, + if (mePtr->selectImagePtr != NULL) { + char *selectImageString = Tcl_GetStringFromObj( + mePtr->selectImagePtr, NULL); + image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString, TkMenuSelectImageProc, (ClientData) mePtr); if (image == NULL) { return TCL_ERROR; @@ -1602,7 +1766,69 @@ ConfigureMenuEntry(mePtr, argc, argv, flags) } mePtr->selectImage = image; - TkEventuallyRecomputeMenu(menuPtr); + if ((mePtr->type == CHECK_BUTTON_ENTRY) + || (mePtr->type == RADIO_BUTTON_ENTRY)) { + Tcl_Obj *valuePtr; + char *name; + + if (mePtr->namePtr == NULL) { + if (mePtr->labelPtr == NULL) { + mePtr->namePtr = NULL; + } else { + mePtr->namePtr = Tcl_DuplicateObj(mePtr->labelPtr); + Tcl_IncrRefCount(mePtr->namePtr); + } + } + if (mePtr->onValuePtr == NULL) { + if (mePtr->labelPtr == NULL) { + mePtr->onValuePtr = NULL; + } else { + mePtr->onValuePtr = Tcl_DuplicateObj(mePtr->labelPtr); + Tcl_IncrRefCount(mePtr->onValuePtr); + } + } + + /* + * Select the entry if the associated variable has the + * appropriate value, initialize the variable if it doesn't + * exist, then set a trace on the variable to monitor future + * changes to its value. + */ + + if (mePtr->namePtr != NULL) { + valuePtr = Tcl_ObjGetVar2(menuPtr->interp, mePtr->namePtr, NULL, + TCL_GLOBAL_ONLY); + } else { + valuePtr = NULL; + } + mePtr->entryFlags &= ~ENTRY_SELECTED; + if (valuePtr != NULL) { + if (mePtr->onValuePtr != NULL) { + char *value = Tcl_GetStringFromObj(valuePtr, NULL); + char *onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, + NULL); + + + if (strcmp(value, onValue) == 0) { + mePtr->entryFlags |= ENTRY_SELECTED; + } + } + } else { + if (mePtr->namePtr != NULL) { + Tcl_ObjSetVar2(menuPtr->interp, mePtr->namePtr, NULL, + (mePtr->type == CHECK_BUTTON_ENTRY) + ? mePtr->offValuePtr + : Tcl_NewObj(), + TCL_GLOBAL_ONLY); + } + } + if (mePtr->namePtr != NULL) { + name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); + Tcl_TraceVar(menuPtr->interp, name, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, (ClientData) mePtr); + } + } return TCL_OK; } @@ -1610,13 +1836,78 @@ ConfigureMenuEntry(mePtr, argc, argv, flags) /* *---------------------------------------------------------------------- * + * ConfigureMenuEntry -- + * + * This procedure is called to process an argv/argc list in order + * to configure (or reconfigure) one entry in a menu. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then the interp's result contains an error message. + * + * Side effects: + * Configuration information such as label and accelerator get + * set for mePtr; old resources get freed, if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureMenuEntry(mePtr, objc, objv) + register TkMenuEntry *mePtr; /* Information about menu entry; may + * or may not already have values for + * some fields. */ + int objc; /* Number of valid entries in argv. */ + Tcl_Obj *CONST objv[]; /* Arguments. */ +{ + TkMenu *menuPtr = mePtr->menuPtr; + Tk_SavedOptions errorStruct; + int result; + + /* + * If this entry is a check button or radio button, then remove + * its old trace procedure. + */ + + if ((mePtr->namePtr != NULL) + && ((mePtr->type == CHECK_BUTTON_ENTRY) + || (mePtr->type == RADIO_BUTTON_ENTRY))) { + char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); + Tcl_UntraceVar(menuPtr->interp, name, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, (ClientData) mePtr); + } + + result = TCL_OK; + if (menuPtr->tkwin != NULL) { + if (Tk_SetOptions(menuPtr->interp, (char *) mePtr, + mePtr->optionTable, objc, objv, menuPtr->tkwin, + &errorStruct, (int *) NULL) != TCL_OK) { + return TCL_ERROR; + } + result = PostProcessEntry(mePtr); + if (result != TCL_OK) { + Tk_RestoreSavedOptions(&errorStruct); + PostProcessEntry(mePtr); + } + Tk_FreeSavedOptions(&errorStruct); + } + + TkEventuallyRecomputeMenu(menuPtr); + + return result; +} + +/* + *---------------------------------------------------------------------- + * * ConfigureMenuCloneEntries -- * * Calls ConfigureMenuEntry for each menu in the clone chain. * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information such as label and accelerator get @@ -1626,22 +1917,21 @@ ConfigureMenuEntry(mePtr, argc, argv, flags) */ static int -ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags) +ConfigureMenuCloneEntries(interp, menuPtr, index, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ TkMenu *menuPtr; /* Information about whole menu. */ int index; /* Index of mePtr within menuPtr's * entries. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ - int flags; /* Additional flags to pass to - * Tk_ConfigureWidget. */ + int objc; /* Number of valid entries in argv. */ + Tcl_Obj *CONST objv[]; /* Arguments. */ { TkMenuEntry *mePtr; TkMenu *menuListPtr; - char *oldCascadeName = NULL, *newMenuName = NULL; - int cascadeEntryChanged; + int cascadeEntryChanged = 0; TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL; - + Tcl_Obj *oldCascadePtr = NULL; + char *newCascadeName; + /* * Cascades are kind of tricky here. This is special case #3 in the comment * at the top of this file. Basically, if a menu is the master menu of a @@ -1653,21 +1943,47 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags) mePtr = menuPtr->masterMenuPtr->entries[index]; if (mePtr->type == CASCADE_ENTRY) { - oldCascadeName = mePtr->name; + oldCascadePtr = mePtr->namePtr; + if (oldCascadePtr != NULL) { + Tcl_IncrRefCount(oldCascadePtr); + } } - if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) { + if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) { return TCL_ERROR; } - cascadeEntryChanged = (mePtr->type == CASCADE_ENTRY) - && (oldCascadeName != mePtr->name); + if (mePtr->type == CASCADE_ENTRY) { + char *oldCascadeName; + + if (mePtr->namePtr != NULL) { + newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL); + } else { + newCascadeName = NULL; + } + + if ((oldCascadePtr == NULL) && (mePtr->namePtr == NULL)) { + cascadeEntryChanged = 0; + } else if (((oldCascadePtr == NULL) && (mePtr->namePtr != NULL)) + || ((oldCascadePtr != NULL) + && (mePtr->namePtr == NULL))) { + cascadeEntryChanged = 1; + } else { + oldCascadeName = Tcl_GetStringFromObj(oldCascadePtr, + NULL); + cascadeEntryChanged = (strcmp(oldCascadeName, newCascadeName) + == 0); + } + if (oldCascadePtr != NULL) { + Tcl_DecrRefCount(oldCascadePtr); + } + } if (cascadeEntryChanged) { - newMenuName = mePtr->name; - if (newMenuName != NULL) { + if (mePtr->namePtr != NULL) { + newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL); cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp, - mePtr->name); + newCascadeName); } } @@ -1677,9 +1993,9 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags) mePtr = menuListPtr->entries[index]; - if (cascadeEntryChanged && (mePtr->name != NULL)) { - oldCascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp, - mePtr->name); + if (cascadeEntryChanged && (mePtr->namePtr != NULL)) { + oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp, + mePtr->namePtr); if ((oldCascadeMenuRefPtr != NULL) && (oldCascadeMenuRefPtr->menuPtr != NULL)) { @@ -1687,25 +2003,36 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags) } } - if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) { + if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) { return TCL_ERROR; } - if (cascadeEntryChanged && (newMenuName != NULL)) { + if (cascadeEntryChanged && (mePtr->namePtr != NULL)) { if (cascadeMenuRefPtr->menuPtr != NULL) { - char *newArgV[2]; - char *newCloneName; - - newCloneName = TkNewMenuName(menuPtr->interp, - Tk_PathName(menuListPtr->tkwin), + Tcl_Obj *newObjv[2]; + Tcl_Obj *newCloneNamePtr; + Tcl_Obj *pathNamePtr = Tcl_NewStringObj( + Tk_PathName(menuListPtr->tkwin), -1); + Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1); + Tcl_Obj *menuObjPtr = Tcl_NewStringObj("-menu", -1); + + Tcl_IncrRefCount(pathNamePtr); + newCloneNamePtr = TkNewMenuName(menuPtr->interp, + pathNamePtr, cascadeMenuRefPtr->menuPtr); - CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneName, - "normal"); - - newArgV[0] = "-menu"; - newArgV[1] = newCloneName; - ConfigureMenuEntry(mePtr, 2, newArgV, flags); - ckfree(newCloneName); + Tcl_IncrRefCount(newCloneNamePtr); + Tcl_IncrRefCount(normalPtr); + CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneNamePtr, + normalPtr); + + newObjv[0] = menuObjPtr; + newObjv[1] = newCloneNamePtr; + Tcl_IncrRefCount(menuObjPtr); + ConfigureMenuEntry(mePtr, 2, newObjv); + Tcl_DecrRefCount(newCloneNamePtr); + Tcl_DecrRefCount(pathNamePtr); + Tcl_DecrRefCount(normalPtr); + Tcl_DecrRefCount(menuObjPtr); } } } @@ -1724,7 +2051,7 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags) * A standard Tcl result. If all went well, then *indexPtr is * filled in with the entry index corresponding to string * (ranges from -1 to the number of entries in the menu minus - * one). Otherwise an error message is left in interp->result. + * one). Otherwise an error message is left in the interp's result. * * Side effects: * None. @@ -1733,38 +2060,39 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags) */ int -TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr) +TkGetMenuIndex(interp, menuPtr, objPtr, lastOK, indexPtr) Tcl_Interp *interp; /* For error messages. */ TkMenu *menuPtr; /* Menu for which the index is being * specified. */ - char *string; /* Specification of an entry in menu. See + Tcl_Obj *objPtr; /* Specification of an entry in menu. See * manual entry for valid .*/ int lastOK; /* Non-zero means its OK to return index * just *after* last entry. */ - int *indexPtr; /* Where to store converted relief. */ + int *indexPtr; /* Where to store converted index. */ { int i; + char *string = Tcl_GetStringFromObj(objPtr, NULL); if ((string[0] == 'a') && (strcmp(string, "active") == 0)) { *indexPtr = menuPtr->active; - return TCL_OK; + goto success; } if (((string[0] == 'l') && (strcmp(string, "last") == 0)) || ((string[0] == 'e') && (strcmp(string, "end") == 0))) { *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1); - return TCL_OK; + goto success; } if ((string[0] == 'n') && (strcmp(string, "none") == 0)) { *indexPtr = -1; - return TCL_OK; + goto success; } if (string[0] == '@') { if (GetIndexFromCoords(interp, menuPtr, string, indexPtr) == TCL_OK) { - return TCL_OK; + goto success; } } @@ -1780,25 +2108,29 @@ TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr) i = -1; } *indexPtr = i; - return TCL_OK; + goto success; } Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); } for (i = 0; i < menuPtr->numEntries; i++) { - char *label; - - label = menuPtr->entries[i]->label; + Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr; + char *label = (labelPtr == NULL) ? NULL + : Tcl_GetStringFromObj(labelPtr, NULL); + if ((label != NULL) - && (Tcl_StringMatch(menuPtr->entries[i]->label, string))) { + && (Tcl_StringMatch(label, string))) { *indexPtr = i; - return TCL_OK; + goto success; } } Tcl_AppendResult(interp, "bad menu entry index \"", string, "\"", (char *) NULL); return TCL_ERROR; + +success: + return TCL_OK; } /* @@ -1834,7 +2166,6 @@ MenuCmdDeletedProc(clientData) */ if (tkwin != NULL) { - menuPtr->tkwin = NULL; Tk_DestroyWindow(tkwin); } } @@ -1890,41 +2221,49 @@ MenuNewEntry(menuPtr, index, type) mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry)); menuPtr->entries[index] = mePtr; mePtr->type = type; + mePtr->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type]; mePtr->menuPtr = menuPtr; - mePtr->label = NULL; + mePtr->labelPtr = NULL; mePtr->labelLength = 0; mePtr->underline = -1; - mePtr->bitmap = None; - mePtr->imageString = NULL; + mePtr->bitmapPtr = NULL; + mePtr->imagePtr = NULL; mePtr->image = NULL; - mePtr->selectImageString = NULL; + mePtr->selectImagePtr = NULL; mePtr->selectImage = NULL; - mePtr->accel = NULL; + mePtr->accelPtr = NULL; mePtr->accelLength = 0; - mePtr->state = tkNormalUid; - mePtr->border = NULL; - mePtr->fg = NULL; - mePtr->activeBorder = NULL; - mePtr->activeFg = NULL; - mePtr->tkfont = NULL; - mePtr->indicatorOn = 1; - mePtr->indicatorFg = NULL; + mePtr->state = ENTRY_DISABLED; + mePtr->borderPtr = NULL; + mePtr->fgPtr = NULL; + mePtr->activeBorderPtr = NULL; + mePtr->activeFgPtr = NULL; + mePtr->fontPtr = NULL; + mePtr->indicatorOn = 0; + mePtr->indicatorFgPtr = NULL; mePtr->columnBreak = 0; mePtr->hideMargin = 0; - mePtr->command = NULL; - mePtr->name = NULL; + mePtr->commandPtr = NULL; + mePtr->namePtr = NULL; mePtr->childMenuRefPtr = NULL; - mePtr->onValue = NULL; - mePtr->offValue = NULL; + mePtr->onValuePtr = NULL; + mePtr->offValuePtr = NULL; mePtr->entryFlags = 0; mePtr->index = index; mePtr->nextCascadePtr = NULL; + if (Tk_InitOptions(menuPtr->interp, (char *) mePtr, + mePtr->optionTable, menuPtr->tkwin) != TCL_OK) { + ckfree((char *) mePtr); + return NULL; + } TkMenuInitializeEntryDrawingFields(mePtr); if (TkpMenuNewEntry(mePtr) != TCL_OK) { + Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, + menuPtr->tkwin); ckfree((char *) mePtr); return NULL; } - + return mePtr; } @@ -1946,25 +2285,24 @@ MenuNewEntry(menuPtr, index, type) */ static int -MenuAddOrInsert(interp, menuPtr, indexString, argc, argv) +MenuAddOrInsert(interp, menuPtr, indexPtr, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ TkMenu *menuPtr; /* Widget in which to create new * entry. */ - char *indexString; /* String describing index at which + Tcl_Obj *indexPtr; /* Object describing index at which * to insert. NULL means insert at * end. */ - int argc; /* Number of elements in argv. */ - char **argv; /* Arguments to command: first arg + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments to command: first arg * is type of entry, others are * config options. */ { - int c, type, index; - size_t length; + int type, index; TkMenuEntry *mePtr; TkMenu *menuListPtr; - if (indexString != NULL) { - if (TkGetMenuIndex(interp, menuPtr, indexString, 1, &index) + if (indexPtr != NULL) { + if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index) != TCL_OK) { return TCL_ERROR; } @@ -1972,11 +2310,12 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv) index = menuPtr->numEntries; } if (index < 0) { + char *indexString = Tcl_GetStringFromObj(indexPtr, NULL); Tcl_AppendResult(interp, "bad index \"", indexString, "\"", (char *) NULL); return TCL_ERROR; } - if (menuPtr->tearOff && (index == 0)) { + if (menuPtr->tearoff && (index == 0)) { index = 1; } @@ -1984,30 +2323,11 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv) * Figure out the type of the new entry. */ - c = argv[0][0]; - length = strlen(argv[0]); - if ((c == 'c') && (strncmp(argv[0], "cascade", length) == 0) - && (length >= 2)) { - type = CASCADE_ENTRY; - } else if ((c == 'c') && (strncmp(argv[0], "checkbutton", length) == 0) - && (length >= 2)) { - type = CHECK_BUTTON_ENTRY; - } else if ((c == 'c') && (strncmp(argv[0], "command", length) == 0) - && (length >= 2)) { - type = COMMAND_ENTRY; - } else if ((c == 'r') - && (strncmp(argv[0], "radiobutton", length) == 0)) { - type = RADIO_BUTTON_ENTRY; - } else if ((c == 's') - && (strncmp(argv[0], "separator", length) == 0)) { - type = SEPARATOR_ENTRY; - } else { - Tcl_AppendResult(interp, "bad menu entry type \"", - argv[0], "\": must be cascade, checkbutton, ", - "command, radiobutton, or separator", (char *) NULL); + if (Tcl_GetIndexFromObj(interp, objv[0], menuEntryTypeStrings, + "menu entry type", 0, &type) != TCL_OK) { return TCL_ERROR; } - + /* * Now we have to add an entry for every instance related to this menu. */ @@ -2019,9 +2339,9 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv) if (mePtr == NULL) { return TCL_ERROR; } - if (ConfigureMenuEntry(mePtr, argc-1, argv+1, 0) != TCL_OK) { + if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) { TkMenu *errorMenuPtr; - int i; + int i; for (errorMenuPtr = menuPtr->masterMenuPtr; errorMenuPtr != NULL; @@ -2054,28 +2374,40 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv) */ if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) { - if ((mePtr->name != NULL) && (mePtr->childMenuRefPtr != NULL) + if ((mePtr->namePtr != NULL) + && (mePtr->childMenuRefPtr != NULL) && (mePtr->childMenuRefPtr->menuPtr != NULL)) { TkMenu *cascadeMenuPtr = mePtr->childMenuRefPtr->menuPtr->masterMenuPtr; - char *newCascadeName; - char *newArgv[2]; + Tcl_Obj *newCascadePtr; + Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1); + Tcl_Obj *windowNamePtr = + Tcl_NewStringObj(Tk_PathName(menuListPtr->tkwin), -1); + Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1); + Tcl_Obj *newObjv[2]; TkMenuReferences *menuRefPtr; - - newCascadeName = TkNewMenuName(menuListPtr->interp, - Tk_PathName(menuListPtr->tkwin), - cascadeMenuPtr); - CloneMenu(cascadeMenuPtr, newCascadeName, "normal"); + + Tcl_IncrRefCount(windowNamePtr); + newCascadePtr = TkNewMenuName(menuListPtr->interp, + windowNamePtr, cascadeMenuPtr); + Tcl_IncrRefCount(newCascadePtr); + Tcl_IncrRefCount(normalPtr); + CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr); - menuRefPtr = TkFindMenuReferences(menuListPtr->interp, - newCascadeName); + menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp, + newCascadePtr); if (menuRefPtr == NULL) { panic("CloneMenu failed inside of MenuAddOrInsert."); } - newArgv[0] = "-menu"; - newArgv[1] = newCascadeName; - ConfigureMenuEntry(mePtr, 2, newArgv, 0); - ckfree(newCascadeName); + newObjv[0] = menuNamePtr; + newObjv[1] = newCascadePtr; + Tcl_IncrRefCount(menuNamePtr); + Tcl_IncrRefCount(newCascadePtr); + ConfigureMenuEntry(mePtr, 2, newObjv); + Tcl_DecrRefCount(newCascadePtr); + Tcl_DecrRefCount(menuNamePtr); + Tcl_DecrRefCount(windowNamePtr); + Tcl_DecrRefCount(normalPtr); } } } @@ -2112,6 +2444,8 @@ MenuVarProc(clientData, interp, name1, name2, flags) TkMenuEntry *mePtr = (TkMenuEntry *) clientData; TkMenu *menuPtr; char *value; + char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); + char *onValue; menuPtr = mePtr->menuPtr; @@ -2123,7 +2457,7 @@ MenuVarProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_UNSETS) { mePtr->entryFlags &= ~ENTRY_SELECTED; if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_TraceVar(interp, mePtr->name, + Tcl_TraceVar(interp, name, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuVarProc, clientData); } @@ -2137,17 +2471,22 @@ MenuVarProc(clientData, interp, name1, name2, flags) * the menu entry. */ - value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY); + value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY); if (value == NULL) { value = ""; } - if (strcmp(value, mePtr->onValue) == 0) { - if (mePtr->entryFlags & ENTRY_SELECTED) { + if (mePtr->onValuePtr != NULL) { + onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, NULL); + if (strcmp(value, onValue) == 0) { + if (mePtr->entryFlags & ENTRY_SELECTED) { + return (char *) NULL; + } + mePtr->entryFlags |= ENTRY_SELECTED; + } else if (mePtr->entryFlags & ENTRY_SELECTED) { + mePtr->entryFlags &= ~ENTRY_SELECTED; + } else { return (char *) NULL; } - mePtr->entryFlags |= ENTRY_SELECTED; - } else if (mePtr->entryFlags & ENTRY_SELECTED) { - mePtr->entryFlags &= ~ENTRY_SELECTED; } else { return (char *) NULL; } @@ -2193,15 +2532,15 @@ TkActivateMenuEntry(menuPtr, index) * might already have been changed to disabled). */ - if (mePtr->state == tkActiveUid) { - mePtr->state = tkNormalUid; + if (mePtr->state == ENTRY_ACTIVE) { + mePtr->state = ENTRY_NORMAL; } TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]); } menuPtr->active = index; if (index >= 0) { mePtr = menuPtr->entries[index]; - mePtr->state = tkActiveUid; + mePtr->state = ENTRY_ACTIVE; TkEventuallyRedrawMenu(menuPtr, mePtr); } return result; @@ -2237,9 +2576,13 @@ TkPostCommand(menuPtr) * the menu's geometry if needed. */ - if (menuPtr->postCommand != NULL) { - result = TkCopyAndGlobalEval(menuPtr->interp, - menuPtr->postCommand); + if (menuPtr->postCommandPtr != NULL) { + Tcl_Obj *postCommandPtr = menuPtr->postCommandPtr; + + Tcl_IncrRefCount(postCommandPtr); + result = Tcl_EvalObjEx(menuPtr->interp, postCommandPtr, + TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(postCommandPtr); if (result != TCL_OK) { return result; } @@ -2269,64 +2612,53 @@ TkPostCommand(menuPtr) */ static int -CloneMenu(menuPtr, newMenuName, newMenuTypeString) +CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr) TkMenu *menuPtr; /* The menu we are going to clone */ - char *newMenuName; /* The name to give the new menu */ - char *newMenuTypeString; /* What kind of menu is this, a normal menu + Tcl_Obj *newMenuNamePtr; /* The name to give the new menu */ + Tcl_Obj *newMenuTypePtr; /* What kind of menu is this, a normal menu * a menubar, or a tearoff? */ { int returnResult; - int menuType; - size_t length; + int menuType, i; TkMenuReferences *menuRefPtr; - Tcl_Obj *commandObjPtr; + Tcl_Obj *menuDupCommandArray[4]; - if (newMenuTypeString == NULL) { + if (newMenuTypePtr == NULL) { menuType = MASTER_MENU; } else { - length = strlen(newMenuTypeString); - if (strncmp(newMenuTypeString, "normal", length) == 0) { - menuType = MASTER_MENU; - } else if (strncmp(newMenuTypeString, "tearoff", length) == 0) { - menuType = TEAROFF_MENU; - } else if (strncmp(newMenuTypeString, "menubar", length) == 0) { - menuType = MENUBAR; - } else { - Tcl_AppendResult(menuPtr->interp, - "bad menu type - must be normal, tearoff, or menubar", - (char *) NULL); - return TCL_ERROR; - } + if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr, + menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) { + return TCL_ERROR; + } } - commandObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, - Tcl_NewStringObj("tkMenuDup", -1)); - Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, - Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1)); - Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, - Tcl_NewStringObj(newMenuName, -1)); - if ((newMenuTypeString == NULL) || (newMenuTypeString[0] == '\0')) { - Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, - Tcl_NewStringObj("normal", -1)); + menuDupCommandArray[0] = Tcl_NewStringObj("tkMenuDup", -1); + menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); + menuDupCommandArray[2] = newMenuNamePtr; + if (newMenuTypePtr == NULL) { + menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1); } else { - Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, - Tcl_NewStringObj(newMenuTypeString, -1)); + menuDupCommandArray[3] = newMenuTypePtr; + } + for (i = 0; i < 4; i++) { + Tcl_IncrRefCount(menuDupCommandArray[i]); } - Tcl_IncrRefCount(commandObjPtr); Tcl_Preserve((ClientData) menuPtr); - returnResult = Tcl_EvalObj(menuPtr->interp, commandObjPtr); - Tcl_DecrRefCount(commandObjPtr); + returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0); + for (i = 0; i < 4; i++) { + Tcl_DecrRefCount(menuDupCommandArray[i]); + } /* * Make sure the tcl command actually created the clone. */ if ((returnResult == TCL_OK) && - ((menuRefPtr = TkFindMenuReferences(menuPtr->interp, newMenuName)) - != (TkMenuReferences *) NULL) + ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp, + newMenuNamePtr)) != (TkMenuReferences *) NULL) && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) { TkMenu *newMenuPtr = menuRefPtr->menuPtr; + Tcl_Obj *newObjv[3]; char *newArgv[3]; int i, numElements; @@ -2359,8 +2691,8 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString) if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, newMenuPtr->interp, 2, newArgv) == TCL_OK) { char *windowName; - Tcl_Obj *bindingsPtr = - Tcl_NewStringObj(newMenuPtr->interp->result, -1); + Tcl_Obj *bindingsPtr = + Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp)); Tcl_Obj *elementPtr; Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements); @@ -2372,11 +2704,12 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString) == 0) { Tcl_Obj *newElementPtr = Tcl_NewStringObj( Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1); + Tcl_IncrRefCount(newElementPtr); Tcl_ListObjReplace(menuPtr->interp, bindingsPtr, i + 1, 0, 1, &newElementPtr); newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL); - Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, - menuPtr->interp, 3, newArgv); + Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, + menuPtr->interp, 3, newArgv); break; } } @@ -2389,30 +2722,35 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString) */ for (i = 0; i < menuPtr->numEntries; i++) { - char *newCascadeName; TkMenuReferences *cascadeRefPtr; TkMenu *oldCascadePtr; if ((menuPtr->entries[i]->type == CASCADE_ENTRY) - && (menuPtr->entries[i]->name != NULL)) { + && (menuPtr->entries[i]->namePtr != NULL)) { cascadeRefPtr = - TkFindMenuReferences(menuPtr->interp, - menuPtr->entries[i]->name); + TkFindMenuReferencesObj(menuPtr->interp, + menuPtr->entries[i]->namePtr); if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) { - char *nameString; + Tcl_Obj *windowNamePtr = + Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin), + -1); + Tcl_Obj *newCascadePtr; oldCascadePtr = cascadeRefPtr->menuPtr; - nameString = Tk_PathName(newMenuPtr->tkwin); - newCascadeName = TkNewMenuName(menuPtr->interp, - nameString, oldCascadePtr); - CloneMenu(oldCascadePtr, newCascadeName, NULL); - - newArgv[0] = "-menu"; - newArgv[1] = newCascadeName; - ConfigureMenuEntry(newMenuPtr->entries[i], 2, newArgv, - TK_CONFIG_ARGV_ONLY); - ckfree(newCascadeName); + Tcl_IncrRefCount(windowNamePtr); + newCascadePtr = TkNewMenuName(menuPtr->interp, + windowNamePtr, oldCascadePtr); + Tcl_IncrRefCount(newCascadePtr); + CloneMenu(oldCascadePtr, newCascadePtr, NULL); + + newObjv[0] = Tcl_NewStringObj("-menu", -1); + newObjv[1] = newCascadePtr; + Tcl_IncrRefCount(newObjv[0]); + ConfigureMenuEntry(newMenuPtr->entries[i], 2, newObjv); + Tcl_DecrRefCount(newObjv[0]); + Tcl_DecrRefCount(newCascadePtr); + Tcl_DecrRefCount(windowNamePtr); } } } @@ -2442,22 +2780,24 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString) */ static int -MenuDoYPosition(interp, menuPtr, arg) +MenuDoYPosition(interp, menuPtr, objPtr) Tcl_Interp *interp; TkMenu *menuPtr; - char *arg; + Tcl_Obj *objPtr; { int index; TkRecomputeMenu(menuPtr); - if (TkGetMenuIndex(interp, menuPtr, arg, 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) { goto error; } + Tcl_ResetResult(interp); if (index < 0) { - interp->result = "0"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } else { - sprintf(interp->result, "%d", menuPtr->entries[index]->y); + Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y)); } + return TCL_OK; error: @@ -2507,7 +2847,8 @@ GetIndexFromCoords(interp, menuPtr, string, indexPtr) goto error; } } else { - x = menuPtr->borderWidth; + Tk_GetPixelsFromObj(interp, menuPtr->tkwin, + menuPtr->borderWidthPtr, &x); } for (i = 0; i < menuPtr->numEntries; i++) { @@ -2583,65 +2924,66 @@ RecursivelyDeleteMenu(menuPtr) *---------------------------------------------------------------------- */ -char * -TkNewMenuName(interp, parentName, menuPtr) +Tcl_Obj * +TkNewMenuName(interp, parentPtr, menuPtr) Tcl_Interp *interp; /* The interp the new name has to live in.*/ - char *parentName; /* The prefix path of the new name. */ + Tcl_Obj *parentPtr; /* The prefix path of the new name. */ TkMenu *menuPtr; /* The menu we are cloning. */ { - Tcl_DString resultDString; - Tcl_DString childDString; + Tcl_Obj *resultPtr = NULL; /* Initialization needed only to prevent + * compiler warning. */ + Tcl_Obj *childPtr; char *destString; - int offset, i; - int doDot = parentName[strlen(parentName) - 1] != '.'; + int i; + int doDot; Tcl_CmdInfo cmdInfo; - char *returnString; Tcl_HashTable *nameTablePtr = NULL; TkWindow *winPtr = (TkWindow *) menuPtr->tkwin; + char *parentName = Tcl_GetStringFromObj(parentPtr, NULL); + if (winPtr->mainPtr != NULL) { nameTablePtr = &(winPtr->mainPtr->nameTable); } - - Tcl_DStringInit(&childDString); - Tcl_DStringAppend(&childDString, Tk_PathName(menuPtr->tkwin), -1); - for (destString = Tcl_DStringValue(&childDString); + + doDot = parentName[strlen(parentName) - 1] != '.'; + + childPtr = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); + for (destString = Tcl_GetStringFromObj(childPtr, NULL); *destString != '\0'; destString++) { if (*destString == '.') { *destString = '#'; } } - offset = 0; - for (i = 0; ; i++) { if (i == 0) { - Tcl_DStringInit(&resultDString); - Tcl_DStringAppend(&resultDString, parentName, -1); + resultPtr = Tcl_DuplicateObj(parentPtr); if (doDot) { - Tcl_DStringAppend(&resultDString, ".", -1); + Tcl_AppendToObj(resultPtr, ".", -1); } - Tcl_DStringAppend(&resultDString, - Tcl_DStringValue(&childDString), -1); - destString = Tcl_DStringValue(&resultDString); + Tcl_AppendObjToObj(resultPtr, childPtr); } else { - if (i == 1) { - offset = Tcl_DStringLength(&resultDString); - Tcl_DStringSetLength(&resultDString, offset + 10); - destString = Tcl_DStringValue(&resultDString); - } - sprintf(destString + offset, "%d", i); + Tcl_Obj *intPtr; + + Tcl_DecrRefCount(resultPtr); + resultPtr = Tcl_DuplicateObj(parentPtr); + if (doDot) { + Tcl_AppendToObj(resultPtr, ".", -1); + } + Tcl_AppendObjToObj(resultPtr, childPtr); + intPtr = Tcl_NewIntObj(i); + Tcl_AppendObjToObj(resultPtr, intPtr); + Tcl_DecrRefCount(intPtr); } + destString = Tcl_GetStringFromObj(resultPtr, NULL); if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0) && ((nameTablePtr == NULL) || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) { break; } } - returnString = ckalloc(strlen(destString) + 1); - strcpy(returnString, destString); - Tcl_DStringFree(&resultDString); - Tcl_DStringFree(&childDString); - return returnString; + Tcl_DecrRefCount(childPtr); + return resultPtr; } /* @@ -2756,32 +3098,45 @@ TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName) menuPtr = menuRefPtr->menuPtr; if (menuPtr != NULL) { - char *cloneMenuName; + Tcl_Obj *cloneMenuPtr; TkMenuReferences *cloneMenuRefPtr; - char *newArgv[4]; + Tcl_Obj *newObjv[4]; + Tcl_Obj *windowNamePtr = Tcl_NewStringObj(Tk_PathName(tkwin), + -1); + Tcl_Obj *menubarPtr = Tcl_NewStringObj("menubar", -1); /* * Clone the menu and all of the cascades underneath it. */ - cloneMenuName = TkNewMenuName(interp, Tk_PathName(tkwin), + Tcl_IncrRefCount(windowNamePtr); + cloneMenuPtr = TkNewMenuName(interp, windowNamePtr, menuPtr); - CloneMenu(menuPtr, cloneMenuName, "menubar"); + Tcl_IncrRefCount(cloneMenuPtr); + Tcl_IncrRefCount(menubarPtr); + CloneMenu(menuPtr, cloneMenuPtr, menubarPtr); - cloneMenuRefPtr = TkFindMenuReferences(interp, cloneMenuName); + cloneMenuRefPtr = TkFindMenuReferencesObj(interp, cloneMenuPtr); if ((cloneMenuRefPtr != NULL) && (cloneMenuRefPtr->menuPtr != NULL)) { + Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1); + Tcl_Obj *nullPtr = Tcl_NewObj(); cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin; menuBarPtr = cloneMenuRefPtr->menuPtr; - newArgv[0] = "-cursor"; - newArgv[1] = ""; + newObjv[0] = cursorPtr; + newObjv[1] = nullPtr; + Tcl_IncrRefCount(cursorPtr); + Tcl_IncrRefCount(nullPtr); ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr, - 2, newArgv, TK_CONFIG_ARGV_ONLY); + 2, newObjv); + Tcl_DecrRefCount(cursorPtr); + Tcl_DecrRefCount(nullPtr); } TkpSetWindowMenuBar(tkwin, menuBarPtr); - - ckfree(cloneMenuName); + Tcl_DecrRefCount(cloneMenuPtr); + Tcl_DecrRefCount(menubarPtr); + Tcl_DecrRefCount(windowNamePtr); } else { TkpSetWindowMenuBar(tkwin, NULL); } @@ -2948,6 +3303,35 @@ TkFindMenuReferences(interp, pathName) /* *---------------------------------------------------------------------- * + * TkFindMenuReferencesObj -- + * + * Given a pathname, gives back a pointer to the TkMenuReferences + * structure. + * + * Results: + * Returns a pointer to a menu reference structure. Should not + * be freed by calller; when a field of the reference is cleared, + * TkFreeMenuReferences should be called. Returns NULL if no reference + * with this pathname exists. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +TkMenuReferences * +TkFindMenuReferencesObj(interp, objPtr) + Tcl_Interp *interp; /* The interp the menu is living in. */ + Tcl_Obj *objPtr; /* The path of the menu widget */ +{ + char *pathName = Tcl_GetStringFromObj(objPtr, NULL); + return TkFindMenuReferences(interp, pathName); +} + +/* + *---------------------------------------------------------------------- + * * TkFreeMenuReferences -- * * This is called after one of the fields in a menu reference @@ -3050,8 +3434,19 @@ DeleteMenuCloneEntries(menuPtr, first, last) void TkMenuInit() { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + if (!menusInitialized) { - TkpMenuInit(); - menusInitialized = 1; + Tcl_MutexLock(&menuMutex); + if (!menusInitialized) { + TkpMenuInit(); + menusInitialized = 1; + } + Tcl_MutexUnlock(&menuMutex); + } + if (!tsdPtr->menusInitialized) { + TkpMenuThreadInit(); + tsdPtr->menusInitialized = 1; } } diff --git a/generic/tkMenu.h b/generic/tkMenu.h index c6fd3fe..9ec63f4 100644 --- a/generic/tkMenu.h +++ b/generic/tkMenu.h @@ -3,12 +3,12 @@ * * Declarations shared among all of the files that implement menu widgets. * - * Copyright (c) 1996-1997 by Sun Microsystems, Inc. + * Copyright (c) 1996-1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMenu.h,v 1.4 1998/09/14 18:23:14 stanton Exp $ + * RCS: @(#) $Id: tkMenu.h,v 1.5 1999/04/16 01:51:19 stanton Exp $ */ #ifndef _TKMENU @@ -47,66 +47,72 @@ typedef struct TkMenuEntry { int type; /* Type of menu entry; see below for * valid types. */ struct TkMenu *menuPtr; /* Menu with which this entry is associated. */ - char *label; /* Main text label displayed in entry (NULL - * if no label). Malloc'ed. */ + Tk_OptionTable optionTable; /* Option table for this menu entry. */ + Tcl_Obj *labelPtr; /* Main text label displayed in entry (NULL + * if no label). */ int labelLength; /* Number of non-NULL characters in label. */ - Tk_Uid state; /* State of button for display purposes: + int state; /* State of button for display purposes: * normal, active, or disabled. */ - int underline; /* Index of character to underline. */ - Pixmap bitmap; /* Bitmap to display in menu entry, or None. + int underline; /* Value of -underline option: specifies index + * of character to underline (<0 means don't + * underline anything). */ + Tcl_Obj *underlinePtr; /* Index of character to underline. */ + Tcl_Obj *bitmapPtr; /* Bitmap to display in menu entry, or None. * If not None then label is ignored. */ - char *imageString; /* Name of image to display (malloc'ed), or + Tcl_Obj *imagePtr; /* Name of image to display, or * NULL. If non-NULL, bitmap, text, and * textVarName are ignored. */ Tk_Image image; /* Image to display in menu entry, or NULL if * none. */ - char *selectImageString; /* Name of image to display when selected - * (malloc'ed), or NULL. */ + Tcl_Obj *selectImagePtr; /* Name of image to display when selected, or + * NULL. */ Tk_Image selectImage; /* Image to display in entry when selected, * or NULL if none. Ignored if image is * NULL. */ - char *accel; /* Accelerator string displayed at right + Tcl_Obj *accelPtr; /* Accelerator string displayed at right * of menu entry. NULL means no such * accelerator. Malloc'ed. */ int accelLength; /* Number of non-NULL characters in * accelerator. */ int indicatorOn; /* True means draw indicator, false means - * don't draw it. */ + * don't draw it. This field is ignored unless + * the entry is a radio or check button. */ /* * Display attributes */ - Tk_3DBorder border; /* Structure used to draw background for + Tcl_Obj *borderPtr; /* Structure used to draw background for * entry. NULL means use overall border * for menu. */ - XColor *fg; /* Foreground color to use for entry. NULL + Tcl_Obj *fgPtr; /* Foreground color to use for entry. NULL * means use foreground color from menu. */ - Tk_3DBorder activeBorder; /* Used to draw background and border when + Tcl_Obj *activeBorderPtr; /* Used to draw background and border when * element is active. NULL means use * activeBorder from menu. */ - XColor *activeFg; /* Foreground color to use when entry is + Tcl_Obj *activeFgPtr; /* Foreground color to use when entry is * active. NULL means use active foreground * from menu. */ - XColor *indicatorFg; /* Color for indicators in radio and check + Tcl_Obj *indicatorFgPtr; /* Color for indicators in radio and check * button entries. NULL means use indicatorFg * GC from menu. */ - Tk_Font tkfont; /* Text font for menu entries. NULL means + Tcl_Obj *fontPtr; /* Text font for menu entries. NULL means * use overall font for menu. */ int columnBreak; /* If this is 0, this item appears below * the item in front of it. If this is - * 1, this item starts a new column. */ + * 1, this item starts a new column. This + * field is always 0 for tearoff and separator + * entries. */ int hideMargin; /* If this is 0, then the item has enough - * margin to accomodate a standard check - * mark and a default right margin. If this - * is 1, then the item has no such margins. - * and checkbuttons and radiobuttons with - * this set will have a rectangle drawn - * in the indicator around the item if - * the item is checked. - * This is useful palette menus.*/ + * margin to accomodate a standard check mark + * and a default right margin. If this is 1, + * then the item has no such margins. and + * checkbuttons and radiobuttons with this set + * will have a rectangle drawn in the indicator + * around the item if the item is checked. This + * is useful for palette menus. This field is + * ignored for separators and tearoffs. */ int indicatorSpace; /* The width of the indicator space for this - * entry. - */ + * entry. */ int labelWidth; /* Number of pixels to allow for displaying * labels in menu entries. */ @@ -114,15 +120,15 @@ typedef struct TkMenuEntry { * Information used to implement this entry's action: */ - char *command; /* Command to invoke when entry is invoked. + Tcl_Obj *commandPtr; /* Command to invoke when entry is invoked. * Malloc'ed. */ - char *name; /* Name of variable (for check buttons and + Tcl_Obj *namePtr; /* Name of variable (for check buttons and * radio buttons) or menu (for cascade * entries). Malloc'ed.*/ - char *onValue; /* Value to store in variable when selected + Tcl_Obj *onValuePtr; /* Value to store in variable when selected * (only for radio and check buttons). * Malloc'ed. */ - char *offValue; /* Value to store in variable when not + Tcl_Obj *offValuePtr; /* Value to store in variable when not * selected (only for check buttons). * Malloc'ed. */ @@ -179,7 +185,7 @@ typedef struct TkMenuEntry { * does not yet exist. */ TkMenuPlatformEntryData platformEntryData; /* The data for the specific type of menu. - * Depends on platform and menu type what + * Depends on platform and menu type what * kind of options are in this structure. */ } TkMenuEntry; @@ -191,9 +197,9 @@ typedef struct TkMenuEntry { * button and that it should be drawn in * the "selected" state. * ENTRY_NEEDS_REDISPLAY: Non-zero means the entry should be redisplayed. - * ENTRY_LAST_COLUMN: Used by the drawing code. If the entry is in the - * last column, the space to its right needs to - * be filled. + * ENTRY_LAST_COLUMN: Used by the drawing code. If the entry is in + * the last column, the space to its right needs + * to be filled. * ENTRY_PLATFORM_FLAG1 - 4 These flags are reserved for use by the * platform-dependent implementation of menus * and should not be used by anything else. @@ -211,25 +217,22 @@ typedef struct TkMenuEntry { * Types defined for MenuEntries: */ -#define COMMAND_ENTRY 0 -#define SEPARATOR_ENTRY 1 -#define CHECK_BUTTON_ENTRY 2 -#define RADIO_BUTTON_ENTRY 3 -#define CASCADE_ENTRY 4 -#define TEAROFF_ENTRY 5 +#define CASCADE_ENTRY 0 +#define CHECK_BUTTON_ENTRY 1 +#define COMMAND_ENTRY 2 +#define RADIO_BUTTON_ENTRY 3 +#define SEPARATOR_ENTRY 4 +#define TEAROFF_ENTRY 5 /* - * Mask bits for above types: + * Menu states */ -#define COMMAND_MASK TK_CONFIG_USER_BIT -#define SEPARATOR_MASK (TK_CONFIG_USER_BIT << 1) -#define CHECK_BUTTON_MASK (TK_CONFIG_USER_BIT << 2) -#define RADIO_BUTTON_MASK (TK_CONFIG_USER_BIT << 3) -#define CASCADE_MASK (TK_CONFIG_USER_BIT << 4) -#define TEAROFF_MASK (TK_CONFIG_USER_BIT << 5) -#define ALL_MASK (COMMAND_MASK | SEPARATOR_MASK \ - | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK | CASCADE_MASK | TEAROFF_MASK) +EXTERN char *tkMenuStateStrings[]; + +#define ENTRY_ACTIVE 0 +#define ENTRY_NORMAL 1 +#define ENTRY_DISABLED 2 /* * A data structure of the following type is kept for each @@ -253,7 +256,7 @@ typedef struct TkMenu { * nothing active. */ int menuType; /* MASTER_MENU, TEAROFF_MENU, or MENUBAR. * See below for definitions. */ - char *menuTypeName; /* Used to control whether created tkwin + Tcl_Obj *menuTypePtr; /* Used to control whether created tkwin * is a toplevel or not. "normal", "menubar", * or "toplevel" */ @@ -261,20 +264,21 @@ typedef struct TkMenu { * Information used when displaying widget: */ - Tk_3DBorder border; /* Structure used to draw 3-D + Tcl_Obj *borderPtr; /* Structure used to draw 3-D * border and background for menu. */ - int borderWidth; /* Width of border around whole menu. */ - Tk_3DBorder activeBorder; /* Used to draw background and border for + Tcl_Obj *borderWidthPtr; /* Width of border around whole menu. */ + Tcl_Obj *activeBorderPtr; /* Used to draw background and border for * active element (if any). */ - int activeBorderWidth; /* Width of border around active element. */ - int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */ - Tk_Font tkfont; /* Text font for menu entries. */ - XColor *fg; /* Foreground color for entries. */ - XColor *disabledFg; /* Foreground color when disabled. NULL + Tcl_Obj *activeBorderWidthPtr; + /* Width of border around active element. */ + Tcl_Obj *reliefPtr; /* 3-d effect: TK_RELIEF_RAISED, etc. */ + Tcl_Obj *fontPtr; /* Text font for menu entries. */ + Tcl_Obj *fgPtr; /* Foreground color for entries. */ + Tcl_Obj *disabledFgPtr; /* Foreground color when disabled. NULL * means use normalFg with a 50% stipple * instead. */ - XColor *activeFg; /* Foreground color for active entry. */ - XColor *indicatorFg; /* Color for indicators in radio and check + Tcl_Obj *activeFgPtr; /* Foreground color for active entry. */ + Tcl_Obj *indicatorFgPtr; /* Color for indicators in radio and check * button entries. */ Pixmap gray; /* Bitmap for drawing disabled entries in * a stippled fashion. None means not @@ -305,7 +309,7 @@ typedef struct TkMenu { * Miscellaneous information: */ - int tearOff; /* 1 means this menu can be torn off. On some + int tearoff; /* 1 means this menu can be torn off. On some * platforms, the user can drag an outline * of the menu by just dragging outside of * the menu, and the tearoff is created where @@ -313,17 +317,17 @@ typedef struct TkMenu { * indicator (such as a dashed stripe) is * drawn, and when the menu is selected, the * tearoff is created. */ - char *title; /* The title to use when this menu is torn + Tcl_Obj *titlePtr; /* The title to use when this menu is torn * off. If this is NULL, a default scheme * will be used to generate a title for * tearoff. */ - char *tearOffCommand; /* If non-NULL, points to a command to + Tcl_Obj *tearoffCommandPtr; /* If non-NULL, points to a command to * run whenever the menu is torn-off. */ - char *takeFocus; /* Value of -takefocus option; not used in + Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in * the C code, but used by keyboard traversal * scripts. Malloc'ed, but may be NULL. */ - Tk_Cursor cursor; /* Current cursor for window, or None. */ - char *postCommand; /* Used to detect cycles in cascade hierarchy + Tcl_Obj *cursorPtr; /* Current cursor for window, or None. */ + Tcl_Obj *postCommandPtr; /* Used to detect cycles in cascade hierarchy * trees when preprocessing postcommands * on some platforms. See PostMenu for * more details. */ @@ -341,6 +345,9 @@ 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. */ Tk_Window parentTopLevelPtr;/* If this menu is a menubar, this is the * toplevel that owns the menu. Only applicable * for menubar clones. @@ -360,6 +367,13 @@ typedef struct TkMenu { * Depends on platform and menu type what * kind of options are in this structure. */ + Tk_OptionSpec *extensionPtr; + /* Needed by the configuration package for + * this widget to be extended. */ + Tk_SavedOptions *errorStructPtr; + /* We actually have to allocate these because + * multiple menus get changed during one + * ConfigureMenu call. */ } TkMenu; /* @@ -407,6 +421,16 @@ 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 @@ -453,13 +477,6 @@ typedef struct TkMenuReferences { #define DECORATION_BORDER_WIDTH 2 /* - * Configuration specs. Needed for platform-specific default initializations. - */ - -EXTERN Tk_ConfigSpec tkMenuEntryConfigSpecs[]; -EXTERN Tk_ConfigSpec tkMenuConfigSpecs[]; - -/* * Menu-related procedures that are shared among Tk modules but not exported * to the outside world: */ @@ -470,21 +487,26 @@ EXTERN void TkBindMenu _ANSI_ARGS_(( Tk_Window tkwin, TkMenu *menuPtr)); EXTERN TkMenuReferences * TkCreateMenuReferences _ANSI_ARGS_((Tcl_Interp *interp, - char *pathName)); + char *name)); EXTERN void TkDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr)); -EXTERN void TkEventuallyRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr)); +EXTERN void TkEventuallyRecomputeMenu _ANSI_ARGS_(( + TkMenu *menuPtr)); EXTERN void TkEventuallyRedrawMenu _ANSI_ARGS_(( TkMenu *menuPtr, TkMenuEntry *mePtr)); EXTERN TkMenuReferences * TkFindMenuReferences _ANSI_ARGS_((Tcl_Interp *interp, - char *pathName)); + char *name)); +EXTERN TkMenuReferences * + TkFindMenuReferencesObj _ANSI_ARGS_(( + Tcl_Interp *interp, Tcl_Obj *namePtr)); EXTERN void TkFreeMenuReferences _ANSI_ARGS_(( TkMenuReferences *menuRefPtr)); EXTERN Tcl_HashTable * TkGetMenuHashTable _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int TkGetMenuIndex _ANSI_ARGS_((Tcl_Interp *interp, - TkMenu *menuPtr, char *string, int lastOK, + TkMenu *menuPtr, Tcl_Obj *objPtr, int lastOK, int *indexPtr)); -EXTERN void TkMenuInitializeDrawingFields _ANSI_ARGS_((TkMenu *menuPtr)); +EXTERN void TkMenuInitializeDrawingFields _ANSI_ARGS_(( + TkMenu *menuPtr)); EXTERN void TkMenuInitializeEntryDrawingFields _ANSI_ARGS_(( TkMenuEntry *mePtr)); EXTERN int TkInvokeMenu _ANSI_ARGS_((Tcl_Interp *interp, @@ -506,8 +528,8 @@ EXTERN void TkMenuSelectImageProc _ANSI_ARGS_ ((ClientData clientData, int x, int y, int width, int height, int imgWidth, int imgHeight)); -EXTERN char * TkNewMenuName _ANSI_ARGS_((Tcl_Interp *interp, - char *parentName, TkMenu *menuPtr)); +EXTERN Tcl_Obj * TkNewMenuName _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *parentNamePtr, TkMenu *menuPtr)); EXTERN int TkPostCommand _ANSI_ARGS_((TkMenu *menuPtr)); EXTERN int TkPostSubmenu _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr, TkMenuEntry *mePtr)); @@ -521,7 +543,8 @@ EXTERN void TkRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr)); * common code. */ -EXTERN void TkpComputeMenubarGeometry _ANSI_ARGS_((TkMenu *menuPtr)); +EXTERN void TkpComputeMenubarGeometry _ANSI_ARGS_(( + TkMenu *menuPtr)); EXTERN void TkpComputeStandardMenuGeometry _ANSI_ARGS_ ((TkMenu *menuPtr)); EXTERN int TkpConfigureMenuEntry diff --git a/generic/tkMenuDraw.c b/generic/tkMenuDraw.c index c08e902..42cdf43 100644 --- a/generic/tkMenuDraw.c +++ b/generic/tkMenuDraw.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMenuDraw.c,v 1.2 1998/09/14 18:23:14 stanton Exp $ + * RCS: @(#) $Id: tkMenuDraw.c,v 1.3 1999/04/16 01:51:19 stanton Exp $ */ #include "tkMenu.h" @@ -31,7 +31,7 @@ static void DisplayMenu _ANSI_ARGS_((ClientData clientData)); * TkMenuInitializeDrawingFields -- * * Fills in drawing fields of a new menu. Called when new menu is - * created by Tk_MenuCmd. + * created by MenuCmd. * * Results: * None. @@ -188,6 +188,9 @@ TkMenuConfigureDrawOptions(menuPtr) XGCValues gcValues; GC newGC; unsigned long mask; + Tk_3DBorder border, activeBorder; + Tk_Font tkfont; + XColor *fg, *activeFg, *indicatorFg; /* * A few options need special processing, such as setting the @@ -195,11 +198,14 @@ TkMenuConfigureDrawOptions(menuPtr) * defaults that couldn't be specified to Tk_ConfigureWidget. */ - Tk_SetBackgroundFromBorder(menuPtr->tkwin, menuPtr->border); + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); + Tk_SetBackgroundFromBorder(menuPtr->tkwin, border); - gcValues.font = Tk_FontId(menuPtr->tkfont); - gcValues.foreground = menuPtr->fg->pixel; - gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel; + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + gcValues.font = Tk_FontId(tkfont); + fg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->fgPtr); + gcValues.foreground = fg->pixel; + gcValues.background = Tk_3DBorderColor(border)->pixel; newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont, &gcValues); if (menuPtr->textGC != None) { @@ -207,17 +213,21 @@ TkMenuConfigureDrawOptions(menuPtr) } menuPtr->textGC = newGC; - gcValues.font = Tk_FontId(menuPtr->tkfont); - gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel; - if (menuPtr->disabledFg != NULL) { - gcValues.foreground = menuPtr->disabledFg->pixel; + gcValues.font = Tk_FontId(tkfont); + gcValues.background = Tk_3DBorderColor(border)->pixel; + if (menuPtr->disabledFgPtr != NULL) { + XColor *disabledFg; + + disabledFg = Tk_GetColorFromObj(menuPtr->tkwin, + menuPtr->disabledFgPtr); + gcValues.foreground = disabledFg->pixel; mask = GCForeground|GCBackground|GCFont; } else { gcValues.foreground = gcValues.background; mask = GCForeground; if (menuPtr->gray == None) { menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin, - Tk_GetUid("gray50")); + "gray50"); } if (menuPtr->gray != None) { gcValues.fill_style = FillStippled; @@ -231,10 +241,10 @@ TkMenuConfigureDrawOptions(menuPtr) } menuPtr->disabledGC = newGC; - gcValues.foreground = Tk_3DBorderColor(menuPtr->border)->pixel; + gcValues.foreground = Tk_3DBorderColor(border)->pixel; if (menuPtr->gray == None) { menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin, - Tk_GetUid("gray50")); + "gray50"); } if (menuPtr->gray != None) { gcValues.fill_style = FillStippled; @@ -247,10 +257,12 @@ TkMenuConfigureDrawOptions(menuPtr) } menuPtr->disabledImageGC = newGC; - gcValues.font = Tk_FontId(menuPtr->tkfont); - gcValues.foreground = menuPtr->activeFg->pixel; - gcValues.background = - Tk_3DBorderColor(menuPtr->activeBorder)->pixel; + gcValues.font = Tk_FontId(tkfont); + activeFg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->activeFgPtr); + gcValues.foreground = activeFg->pixel; + activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + menuPtr->activeBorderPtr); + gcValues.background = Tk_3DBorderColor(activeBorder)->pixel; newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont, &gcValues); if (menuPtr->activeGC != None) { @@ -258,8 +270,10 @@ TkMenuConfigureDrawOptions(menuPtr) } menuPtr->activeGC = newGC; - gcValues.foreground = menuPtr->indicatorFg->pixel; - gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel; + indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin, + menuPtr->indicatorFgPtr); + gcValues.foreground = indicatorFg->pixel; + gcValues.background = Tk_3DBorderColor(border)->pixel; newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont, &gcValues); if (menuPtr->indicatorGC != None) { @@ -297,9 +311,10 @@ TkMenuConfigureEntryDrawOptions(mePtr, index) Tk_Font tkfont; TkMenu *menuPtr = mePtr->menuPtr; - tkfont = (mePtr->tkfont == NULL) ? menuPtr->tkfont : mePtr->tkfont; + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, + (mePtr->fontPtr != NULL) ? mePtr->fontPtr : menuPtr->fontPtr); - if (mePtr->state == tkActiveUid) { + if (mePtr->state == ENTRY_ACTIVE) { if (index != menuPtr->active) { TkActivateMenuEntry(menuPtr, index); } @@ -307,30 +322,24 @@ TkMenuConfigureEntryDrawOptions(mePtr, index) if (index == menuPtr->active) { TkActivateMenuEntry(menuPtr, -1); } - if ((mePtr->state != tkNormalUid) - && (mePtr->state != tkDisabledUid)) { - Tcl_AppendResult(menuPtr->interp, "bad state value \"", - mePtr->state, - "\": must be normal, active, or disabled", (char *) NULL); - mePtr->state = tkNormalUid; - return TCL_ERROR; - } } - if ((mePtr->tkfont != NULL) - || (mePtr->border != NULL) - || (mePtr->fg != NULL) - || (mePtr->activeBorder != NULL) - || (mePtr->activeFg != NULL) - || (mePtr->indicatorFg != NULL)) { - gcValues.foreground = (mePtr->fg != NULL) - ? mePtr->fg->pixel - : menuPtr->fg->pixel; - gcValues.background = Tk_3DBorderColor( - (mePtr->border != NULL) - ? mePtr->border - : menuPtr->border) - ->pixel; + if ((mePtr->fontPtr != NULL) + || (mePtr->borderPtr != NULL) + || (mePtr->fgPtr != NULL) + || (mePtr->activeBorderPtr != NULL) + || (mePtr->activeFgPtr != NULL) + || (mePtr->indicatorFgPtr != NULL)) { + XColor *fg, *indicatorFg, *activeFg; + Tk_3DBorder border, activeBorder; + + fg = Tk_GetColorFromObj(menuPtr->tkwin, (mePtr->fgPtr != NULL) + ? mePtr->fgPtr : menuPtr->fgPtr); + gcValues.foreground = fg->pixel; + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->borderPtr != NULL) ? mePtr->borderPtr + : menuPtr->borderPtr); + gcValues.background = Tk_3DBorderColor(border)->pixel; gcValues.font = Tk_FontId(tkfont); @@ -345,17 +354,20 @@ TkMenuConfigureEntryDrawOptions(mePtr, index) GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues); - if (mePtr->indicatorFg != NULL) { - gcValues.foreground = mePtr->indicatorFg->pixel; - } else if (menuPtr->indicatorFg != NULL) { - gcValues.foreground = menuPtr->indicatorFg->pixel; - } + indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin, + (mePtr->indicatorFgPtr != NULL) ? mePtr->indicatorFgPtr + : menuPtr->indicatorFgPtr); + gcValues.foreground = indicatorFg->pixel; newIndicatorGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCGraphicsExposures, &gcValues); - if ((menuPtr->disabledFg != NULL) || (mePtr->image != NULL)) { - gcValues.foreground = menuPtr->disabledFg->pixel; + if ((menuPtr->disabledFgPtr != NULL) || (mePtr->image != NULL)) { + XColor *disabledFg; + + disabledFg = Tk_GetColorFromObj(menuPtr->tkwin, + menuPtr->disabledFgPtr); + gcValues.foreground = disabledFg->pixel; mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures; } else { gcValues.foreground = gcValues.background; @@ -365,13 +377,15 @@ TkMenuConfigureEntryDrawOptions(mePtr, index) } newDisabledGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues); - gcValues.foreground = (mePtr->activeFg != NULL) - ? mePtr->activeFg->pixel - : menuPtr->activeFg->pixel; - gcValues.background = Tk_3DBorderColor( - (mePtr->activeBorder != NULL) - ? mePtr->activeBorder - : menuPtr->activeBorder)->pixel; + activeFg = Tk_GetColorFromObj(menuPtr->tkwin, + (mePtr->activeFgPtr != NULL) ? mePtr->activeFgPtr + : menuPtr->activeFgPtr); + activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->activeBorderPtr != NULL) ? mePtr->activeBorderPtr + : menuPtr->activeBorderPtr); + + gcValues.foreground = activeFg->pixel; + gcValues.background = Tk_3DBorderColor(activeBorder)->pixel; newActiveGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues); @@ -475,7 +489,7 @@ TkRecomputeMenu(menuPtr) void TkEventuallyRedrawMenu(menuPtr, mePtr) register TkMenu *menuPtr; /* Information about menu to redraw. */ - register TkMenuEntry *mePtr; /* Entry to redraw. NULL means redraw + register TkMenuEntry *mePtr;/* Entry to redraw. NULL means redraw * all the entries in the menu. */ { int i; @@ -616,21 +630,30 @@ DisplayMenu(clientData) register TkMenuEntry *mePtr; register Tk_Window tkwin = menuPtr->tkwin; int index, strictMotif; - Tk_Font tkfont = menuPtr->tkfont; + Tk_Font tkfont; Tk_FontMetrics menuMetrics; int width; + int borderWidth; + Tk_3DBorder border; + int activeBorderWidth; + int relief; + menuPtr->menuFlags &= ~REDRAW_PENDING; if ((menuPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { return; } + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); + if (menuPtr->menuType == MENUBAR) { - Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border, - menuPtr->borderWidth, menuPtr->borderWidth, - Tk_Width(tkwin) - 2 * menuPtr->borderWidth, - Tk_Height(tkwin) - 2 * menuPtr->borderWidth, 0, - TK_RELIEF_FLAT); + Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, borderWidth, + borderWidth, Tk_Width(tkwin) - 2 * borderWidth, + Tk_Height(tkwin) - 2 * borderWidth, 0, TK_RELIEF_FLAT); } strictMotif = Tk_StrictMotif(menuPtr->tkwin); @@ -640,7 +663,8 @@ DisplayMenu(clientData) * all of the time. */ - Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics); + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(tkfont, &menuMetrics); /* * Loop through all of the entries, drawing them one at a time. @@ -660,22 +684,22 @@ DisplayMenu(clientData) } else { if (mePtr->entryFlags & ENTRY_LAST_COLUMN) { width = Tk_Width(menuPtr->tkwin) - mePtr->x - - menuPtr->activeBorderWidth; + - activeBorderWidth; } else { - width = mePtr->width + menuPtr->borderWidth; + width = mePtr->width + borderWidth; } } TkpDrawMenuEntry(mePtr, Tk_WindowId(menuPtr->tkwin), tkfont, &menuMetrics, mePtr->x, mePtr->y, width, mePtr->height, strictMotif, 1); - if ((index > 0) && (menuPtr->menuType != MENUBAR) + if ((index > 0) && (menuPtr->menuType != MENUBAR) && mePtr->columnBreak) { mePtr = menuPtr->entries[index - 1]; - Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border, + Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, mePtr->x, mePtr->y + mePtr->height, mePtr->width, - Tk_Height(tkwin) - mePtr->y - mePtr->height - - menuPtr->activeBorderWidth, 0, + Tk_Height(tkwin) - mePtr->y - mePtr->height - + activeBorderWidth, 0, TK_RELIEF_FLAT); } } @@ -684,28 +708,29 @@ DisplayMenu(clientData) int x, y, height; if (menuPtr->numEntries == 0) { - x = y = menuPtr->borderWidth; - width = Tk_Width(tkwin) - 2 * menuPtr->activeBorderWidth; - height = Tk_Height(tkwin) - 2 * menuPtr->activeBorderWidth; + x = y = borderWidth; + width = Tk_Width(tkwin) - 2 * activeBorderWidth; + height = Tk_Height(tkwin) - 2 * activeBorderWidth; } else { mePtr = menuPtr->entries[menuPtr->numEntries - 1]; Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), - menuPtr->border, mePtr->x, mePtr->y + mePtr->height, - mePtr->width, Tk_Height(tkwin) - mePtr->y - mePtr->height - - menuPtr->activeBorderWidth, 0, + border, mePtr->x, mePtr->y + mePtr->height, mePtr->width, + Tk_Height(tkwin) - mePtr->y - mePtr->height + - activeBorderWidth, 0, TK_RELIEF_FLAT); x = mePtr->x + mePtr->width; y = mePtr->y + mePtr->height; - width = Tk_Width(tkwin) - x - menuPtr->activeBorderWidth; - height = Tk_Height(tkwin) - y - menuPtr->activeBorderWidth; + width = Tk_Width(tkwin) - x - activeBorderWidth; + height = Tk_Height(tkwin) - y - activeBorderWidth; } - Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border, x, y, + Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, x, y, width, height, 0, TK_RELIEF_FLAT); } + Tk_GetReliefFromObj(NULL, menuPtr->reliefPtr, &relief); Tk_Draw3DRectangle(menuPtr->tkwin, Tk_WindowId(tkwin), - menuPtr->border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), - menuPtr->borderWidth, menuPtr->relief); + border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), borderWidth, + relief); } /* @@ -739,11 +764,12 @@ TkMenuEventProc(clientData, eventPtr) TkEventuallyRecomputeMenu(menuPtr); TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL); } else if (eventPtr->type == ActivateNotify) { - if (menuPtr->menuType == TEAROFF_MENU) { - TkpSetMainMenubar(menuPtr->interp, menuPtr->tkwin, NULL); - } + if (menuPtr->menuType == TEAROFF_MENU) { + TkpSetMainMenubar(menuPtr->interp, menuPtr->tkwin, NULL); + } } else if (eventPtr->type == DestroyNotify) { if (menuPtr->tkwin != NULL) { + TkDestroyMenu(menuPtr); menuPtr->tkwin = NULL; Tcl_DeleteCommandFromToken(menuPtr->interp, menuPtr->widgetCmd); } @@ -753,7 +779,7 @@ TkMenuEventProc(clientData, eventPtr) if (menuPtr->menuFlags & RESIZE_PENDING) { Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr); } - TkDestroyMenu(menuPtr); + Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC); } } @@ -921,7 +947,6 @@ TkPostSubmenu(interp, menuPtr, mePtr) * posted. NULL means make sure that * no submenu is posted. */ { - char string[30]; int result, x, y; if (mePtr == menuPtr->postedCascade) { @@ -929,6 +954,8 @@ TkPostSubmenu(interp, menuPtr, mePtr) } if (menuPtr->postedCascade != NULL) { + char *name = Tcl_GetStringFromObj(menuPtr->postedCascade->namePtr, + NULL); /* * Note: when unposting a submenu, we have to redraw the entire @@ -948,17 +975,15 @@ TkPostSubmenu(interp, menuPtr, mePtr) */ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL); - result = Tcl_VarEval(interp, menuPtr->postedCascade->name, - " unpost", (char *) NULL); + result = Tcl_VarEval(interp, name, " unpost", (char *) NULL); menuPtr->postedCascade = NULL; if (result != TCL_OK) { return result; } } - if ((mePtr != NULL) && (mePtr->name != NULL) + if ((mePtr != NULL) && (mePtr->namePtr != NULL) && Tk_IsMapped(menuPtr->tkwin)) { - /* * Position the cascade with its upper left corner slightly * below and to the left of the upper right corner of the @@ -967,10 +992,13 @@ TkPostSubmenu(interp, menuPtr, mePtr) * The menu has to redrawn so that the entry can change relief. */ + char string[TCL_INTEGER_SPACE * 2]; + char *name; + + name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); Tk_GetRootCoords(menuPtr->tkwin, &x, &y); AdjustMenuCoords(menuPtr, mePtr, &x, &y, string); - result = Tcl_VarEval(interp, mePtr->name, " post ", string, - (char *) NULL); + result = Tcl_VarEval(interp, name, " post ", string, (char *) NULL); if (result != TCL_OK) { return result; } @@ -1009,10 +1037,15 @@ AdjustMenuCoords(menuPtr, mePtr, xPtr, yPtr, string) *xPtr += mePtr->x; *yPtr += mePtr->y + mePtr->height; } else { - *xPtr += Tk_Width(menuPtr->tkwin) - menuPtr->borderWidth - - menuPtr->activeBorderWidth - 2; - *yPtr += mePtr->y - + menuPtr->activeBorderWidth + 2; + int borderWidth, activeBorderWidth; + + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); + *xPtr += Tk_Width(menuPtr->tkwin) - borderWidth - activeBorderWidth + - 2; + *yPtr += mePtr->y + activeBorderWidth + 2; } sprintf(string, "%d %d", *xPtr, *yPtr); } diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index da6d901..b9f0ddf 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMenubutton.c,v 1.2 1998/09/14 18:23:14 stanton Exp $ + * RCS: @(#) $Id: tkMenubutton.c,v 1.3 1999/04/16 01:51:19 stanton Exp $ */ #include "tkMenubutton.h" @@ -18,117 +18,140 @@ #include "default.h" /* - * Uids internal to menubuttons. + * The following table defines the legal values for the -direction + * option. It is used together with the "enum direction" declaration + * in tkMenubutton.h. */ -static Tk_Uid aboveUid = NULL; -static Tk_Uid belowUid = NULL; -static Tk_Uid leftUid = NULL; -static Tk_Uid rightUid = NULL; -static Tk_Uid flushUid = NULL; +static char *directionStrings[] = { + "above", "below", "flush", "left", "right", (char *) NULL +}; + +/* + * The following table defines the legal values for the -state option. + * It is used together with the "enum state" declaration in tkMenubutton.h. + */ + +static char *stateStrings[] = { + "active", "disabled", "normal", (char *) NULL +}; /* * Information used for parsing configuration specs: */ -static Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_MENUBUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkMenuButton, activeBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_MENUBUTTON_ACTIVE_BG_MONO, Tk_Offset(TkMenuButton, activeBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", - DEF_MENUBUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkMenuButton, activeFg), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background", - DEF_MENUBUTTON_ACTIVE_FG_MONO, Tk_Offset(TkMenuButton, activeFg), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", - DEF_MENUBUTTON_ANCHOR, Tk_Offset(TkMenuButton, anchor), 0}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_MENUBUTTON_BG_COLOR, Tk_Offset(TkMenuButton, normalBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_MENUBUTTON_BG_MONO, Tk_Offset(TkMenuButton, normalBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap", - DEF_MENUBUTTON_BITMAP, Tk_Offset(TkMenuButton, bitmap), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_MENUBUTTON_BORDER_WIDTH, Tk_Offset(TkMenuButton, borderWidth), 0}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_MENUBUTTON_CURSOR, Tk_Offset(TkMenuButton, cursor), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_UID, "-direction", "direction", "Direction", - DEF_MENUBUTTON_DIRECTION, Tk_Offset(TkMenuButton, direction), - 0}, - {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", +static Tk_OptionSpec optionSpecs[] = { + {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", + DEF_MENUBUTTON_ACTIVE_BG_COLOR, -1, + Tk_Offset(TkMenuButton, activeBorder), 0, + (ClientData) DEF_MENUBUTTON_ACTIVE_BG_MONO, 0}, + {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background", + DEF_MENUBUTTON_ACTIVE_FG_COLOR, -1, + Tk_Offset(TkMenuButton, activeFg), + 0, (ClientData) 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}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", + DEF_MENUBUTTON_BITMAP, -1, Tk_Offset(TkMenuButton, bitmap), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_MENUBUTTON_BORDER_WIDTH, -1, + Tk_Offset(TkMenuButton, borderWidth), 0, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_MENUBUTTON_CURSOR, -1, Tk_Offset(TkMenuButton, cursor), + 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}, + {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_COLOR, - Tk_Offset(TkMenuButton, disabledFg), - TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground", - "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_MONO, - Tk_Offset(TkMenuButton, disabledFg), - TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_FONT, "-font", "font", "Font", - DEF_MENUBUTTON_FONT, Tk_Offset(TkMenuButton, tkfont), 0}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_MENUBUTTON_FG, Tk_Offset(TkMenuButton, normalFg), 0}, - {TK_CONFIG_STRING, "-height", "height", "Height", - DEF_MENUBUTTON_HEIGHT, Tk_Offset(TkMenuButton, heightString), 0}, - {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", - "HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG, - Tk_Offset(TkMenuButton, highlightBgColorPtr), 0}, - {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_MENUBUTTON_HIGHLIGHT, Tk_Offset(TkMenuButton, highlightColorPtr), - 0}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", + -1, Tk_Offset(TkMenuButton, disabledFg), TK_OPTION_NULL_OK, + (ClientData) DEF_MENUBUTTON_DISABLED_FG_MONO, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + {TK_OPTION_FONT, "-font", "font", "Font", + DEF_MENUBUTTON_FONT, -1, Tk_Offset(TkMenuButton, tkfont), 0, 0, 0}, + {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", + DEF_MENUBUTTON_FG, -1, Tk_Offset(TkMenuButton, normalFg), 0, 0, 0}, + {TK_OPTION_STRING, "-height", "height", "Height", + DEF_MENUBUTTON_HEIGHT, -1, Tk_Offset(TkMenuButton, heightString), + 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR, + -1, Tk_Offset(TkMenuButton, highlightBgColorPtr), 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_MENUBUTTON_HIGHLIGHT, -1, + Tk_Offset(TkMenuButton, highlightColorPtr), 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", DEF_MENUBUTTON_HIGHLIGHT_WIDTH, - Tk_Offset(TkMenuButton, highlightWidth), 0}, - {TK_CONFIG_STRING, "-image", "image", "Image", - DEF_MENUBUTTON_IMAGE, Tk_Offset(TkMenuButton, imageString), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn", - DEF_MENUBUTTON_INDICATOR, Tk_Offset(TkMenuButton, indicatorOn), 0}, - {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", - DEF_MENUBUTTON_JUSTIFY, Tk_Offset(TkMenuButton, justify), 0}, - {TK_CONFIG_STRING, "-menu", "menu", "Menu", - DEF_MENUBUTTON_MENU, Tk_Offset(TkMenuButton, menuName), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", - DEF_MENUBUTTON_PADX, Tk_Offset(TkMenuButton, padX), 0}, - {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", - DEF_MENUBUTTON_PADY, Tk_Offset(TkMenuButton, padY), 0}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_MENUBUTTON_RELIEF, Tk_Offset(TkMenuButton, relief), 0}, - {TK_CONFIG_UID, "-state", "state", "State", - DEF_MENUBUTTON_STATE, Tk_Offset(TkMenuButton, state), 0}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_MENUBUTTON_TAKE_FOCUS, Tk_Offset(TkMenuButton, takeFocus), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-text", "text", "Text", - DEF_MENUBUTTON_TEXT, Tk_Offset(TkMenuButton, text), 0}, - {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", - DEF_MENUBUTTON_TEXT_VARIABLE, Tk_Offset(TkMenuButton, textVarName), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_INT, "-underline", "underline", "Underline", - DEF_MENUBUTTON_UNDERLINE, Tk_Offset(TkMenuButton, underline), 0}, - {TK_CONFIG_STRING, "-width", "width", "Width", - DEF_MENUBUTTON_WIDTH, Tk_Offset(TkMenuButton, widthString), 0}, - {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength", - DEF_MENUBUTTON_WRAP_LENGTH, Tk_Offset(TkMenuButton, wrapLength), 0}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + -1, Tk_Offset(TkMenuButton, highlightWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-image", "image", "Image", + DEF_MENUBUTTON_IMAGE, -1, Tk_Offset(TkMenuButton, imageString), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn", + DEF_MENUBUTTON_INDICATOR, -1, Tk_Offset(TkMenuButton, indicatorOn), + 0, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkMenuButton, justify), 0, 0, 0}, + {TK_OPTION_STRING, "-menu", "menu", "Menu", + DEF_MENUBUTTON_MENU, -1, Tk_Offset(TkMenuButton, menuName), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_MENUBUTTON_PADX, -1, Tk_Offset(TkMenuButton, padX), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", "padY", "Pad", + DEF_MENUBUTTON_PADY, -1, Tk_Offset(TkMenuButton, padY), + 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_MENUBUTTON_RELIEF, -1, Tk_Offset(TkMenuButton, relief), + 0, 0, 0}, + {TK_OPTION_STRING_TABLE, "-state", "state", "State", + DEF_MENUBUTTON_STATE, -1, Tk_Offset(TkMenuButton, state), + 0, (ClientData) stateStrings, 0}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_MENUBUTTON_TAKE_FOCUS, -1, + Tk_Offset(TkMenuButton, takeFocus), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-text", "text", "Text", + DEF_MENUBUTTON_TEXT, -1, Tk_Offset(TkMenuButton, text), 0, 0, 0}, + {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", + DEF_MENUBUTTON_TEXT_VARIABLE, -1, + Tk_Offset(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INT, "-underline", "underline", "Underline", + DEF_MENUBUTTON_UNDERLINE, -1, Tk_Offset(TkMenuButton, underline), + 0, 0, 0}, + {TK_OPTION_STRING, "-width", "width", "Width", + DEF_MENUBUTTON_WIDTH, -1, Tk_Offset(TkMenuButton, widthString), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", + DEF_MENUBUTTON_WRAP_LENGTH, -1, Tk_Offset(TkMenuButton, wrapLength), + 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0} }; /* + * The following tables define the menubutton widget commands and map the + * indexes into the string tables into a single enumerated type used + * to dispatch the scale widget command. + */ + +static char *commandNames[] = { + "cget", "configure", (char *) NULL +}; + +enum command { + COMMAND_CGET, COMMAND_CONFIGURE, +}; + +/* * Forward declarations for procedures defined later in this file: */ @@ -142,17 +165,18 @@ static void MenuButtonImageProc _ANSI_ARGS_((ClientData clientData, static char * MenuButtonTextVarProc _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)); -static int MenuButtonWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +static int MenuButtonWidgetObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); static int ConfigureMenuButton _ANSI_ARGS_((Tcl_Interp *interp, - TkMenuButton *mbPtr, int argc, char **argv, - int flags)); + TkMenuButton *mbPtr, int objc, + Tcl_Obj *CONST objv[])); static void DestroyMenuButton _ANSI_ARGS_((char *memPtr)); /* *-------------------------------------------------------------- * - * Tk_MenubuttonCmd -- + * Tk_MenubuttonObjCmd -- * * This procedure is invoked to process the "button", "label", * "radiobutton", and "checkbutton" Tcl commands. See the @@ -168,20 +192,38 @@ static void DestroyMenuButton _ANSI_ARGS_((char *memPtr)); */ int -Tk_MenubuttonCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_MenubuttonObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to + * option table. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { register TkMenuButton *mbPtr; - Tk_Window tkwin = (Tk_Window) clientData; - Tk_Window new; + Tk_OptionTable optionTable; + Tk_Window tkwin; + + optionTable = (Tk_OptionTable) clientData; + if (optionTable == NULL) { + Tcl_CmdInfo info; + char *name; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + /* + * We haven't created the option table for this widget class + * yet. Do it now and save the table as the clientData for + * the command, so we'll have access to it in future + * invocations of the command. + */ + + optionTable = Tk_CreateOptionTable(interp, optionSpecs); + name = Tcl_GetString(objv[0]); + Tcl_GetCommandInfo(interp, name, &info); + info.objClientData = (ClientData) optionTable; + Tcl_SetCommandInfo(interp, name, &info); + } + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } @@ -189,25 +231,28 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv) * Create the new window. */ - new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL); - if (new == NULL) { + tkwin = Tk_CreateWindowFromPath(interp, + Tk_MainWindow(interp), Tcl_GetString(objv[1]), (char *) NULL); + if (tkwin == NULL) { return TCL_ERROR; } - Tk_SetClass(new, "Menubutton"); - mbPtr = TkpCreateMenuButton(new); + Tk_SetClass(tkwin, "Menubutton"); + mbPtr = TkpCreateMenuButton(tkwin); - TkSetClassProcs(new, &tkpMenubuttonClass, (ClientData) mbPtr); + TkSetClassProcs(tkwin, &tkpMenubuttonClass, (ClientData) mbPtr); /* * Initialize the data structure for the button. */ - mbPtr->tkwin = new; - mbPtr->display = Tk_Display (new); + mbPtr->tkwin = tkwin; + mbPtr->display = Tk_Display (tkwin); mbPtr->interp = interp; - mbPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(mbPtr->tkwin), - MenuButtonWidgetCmd, (ClientData) mbPtr, MenuButtonCmdDeletedProc); + mbPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd, + (ClientData) mbPtr, MenuButtonCmdDeletedProc); + mbPtr->optionTable = optionTable; mbPtr->menuName = NULL; mbPtr->text = NULL; mbPtr->underline = -1; @@ -215,7 +260,7 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv) mbPtr->bitmap = None; mbPtr->imageString = NULL; mbPtr->image = NULL; - mbPtr->state = tkNormalUid; + mbPtr->state = STATE_NORMAL; mbPtr->normalBorder = NULL; mbPtr->activeBorder = NULL; mbPtr->borderWidth = 0; @@ -247,34 +292,35 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv) mbPtr->indicatorOn = 0; mbPtr->indicatorWidth = 0; mbPtr->indicatorHeight = 0; + mbPtr->direction = DIRECTION_FLUSH; mbPtr->cursor = None; mbPtr->takeFocus = NULL; mbPtr->flags = 0; - if (aboveUid == NULL) { - aboveUid = Tk_GetUid("above"); - belowUid = Tk_GetUid("below"); - leftUid = Tk_GetUid("left"); - rightUid = Tk_GetUid("right"); - flushUid = Tk_GetUid("flush"); - } - mbPtr->direction = flushUid; Tk_CreateEventHandler(mbPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, MenuButtonEventProc, (ClientData) mbPtr); - if (ConfigureMenuButton(interp, mbPtr, argc-2, argv+2, 0) != TCL_OK) { + + if (Tk_InitOptions(interp, (char *) mbPtr, optionTable, tkwin) + != TCL_OK) { Tk_DestroyWindow(mbPtr->tkwin); return TCL_ERROR; } - interp->result = Tk_PathName(mbPtr->tkwin); + if (ConfigureMenuButton(interp, mbPtr, objc-2, objv+2) != TCL_OK) { + Tk_DestroyWindow(mbPtr->tkwin); + return TCL_ERROR; + } + + Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(mbPtr->tkwin), + -1); return TCL_OK; } /* *-------------------------------------------------------------- * - * MenuButtonWidgetCmd -- + * MenuButtonWidgetObjCmd -- * * This procedure is invoked to process the Tcl command * that corresponds to a widget managed by this module. @@ -290,56 +336,68 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv) */ static int -MenuButtonWidgetCmd(clientData, interp, argc, argv) +MenuButtonWidgetObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about button widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { register TkMenuButton *mbPtr = (TkMenuButton *) clientData; - int result; - size_t length; - int c; + int result, index; + Tcl_Obj *objPtr; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg ...?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } + result = Tcl_GetIndexFromObj(interp, objv[1], + commandNames, "option", 0, &index); + if (result != TCL_OK) { + return result; + } Tcl_Preserve((ClientData) mbPtr); - c = argv[1][0]; - length = strlen(argv[1]); - 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\"", - (char *) NULL); - result = TCL_ERROR; - } else { - result = Tk_ConfigureValue(interp, mbPtr->tkwin, configSpecs, - (char *) mbPtr, argv[2], 0); + + switch (index) { + case COMMAND_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); + goto error; + } + + objPtr = Tk_GetOptionValue(interp, (char *) mbPtr, + mbPtr->optionTable, objv[2], mbPtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } + break; } - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs, - (char *) mbPtr, (char *) NULL, 0); - } else if (argc == 3) { - result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs, - (char *) mbPtr, argv[2], 0); - } else { - result = ConfigureMenuButton(interp, mbPtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); + + case COMMAND_CONFIGURE: { + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) mbPtr, + mbPtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + mbPtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } + } else { + result = ConfigureMenuButton(interp, mbPtr, objc-2, + objv+2); + } + break; } - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be cget or configure", - (char *) NULL); - result = TCL_ERROR; } Tcl_Release((ClientData) mbPtr); return result; + + error: + Tcl_Release((ClientData) mbPtr); + return TCL_ERROR; } /* @@ -348,9 +406,9 @@ MenuButtonWidgetCmd(clientData, interp, argc, argv) * DestroyMenuButton -- * * This procedure is invoked to recycle all of the resources - * associated with a button widget. It is invoked as a + * associated with a menubutton widget. It is invoked as a * when-idle handler in order to make sure that there is no - * other use of the button pending at the time of the deletion. + * other use of the menubutton pending at the time of the deletion. * * Results: * None. @@ -366,6 +424,11 @@ DestroyMenuButton(memPtr) char *memPtr; /* Info about button widget. */ { register TkMenuButton *mbPtr = (TkMenuButton *) memPtr; + TkpDestroyMenuButton(mbPtr); + + if (mbPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr); + } /* * Free up all the stuff that requires special handling, then @@ -373,6 +436,7 @@ DestroyMenuButton(memPtr) * stuff. */ + Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd); if (mbPtr->textVarName != NULL) { Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, @@ -387,15 +451,19 @@ DestroyMenuButton(memPtr) if (mbPtr->activeTextGC != None) { Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC); } + if (mbPtr->disabledGC != None) { + Tk_FreeGC(mbPtr->display, mbPtr->disabledGC); + } if (mbPtr->gray != None) { Tk_FreeBitmap(mbPtr->display, mbPtr->gray); } - if (mbPtr->disabledGC != None) { - Tk_FreeGC(mbPtr->display, mbPtr->disabledGC); + if (mbPtr->textLayout != NULL) { + Tk_FreeTextLayout(mbPtr->textLayout); } - Tk_FreeTextLayout(mbPtr->textLayout); - Tk_FreeOptions(configSpecs, (char *) mbPtr, mbPtr->display, 0); - ckfree((char *) mbPtr); + Tk_FreeConfigOptions((char *) mbPtr, mbPtr->optionTable, + mbPtr->tkwin); + mbPtr->tkwin = NULL; + Tcl_EventuallyFree((ClientData) mbPtr, TCL_DYNAMIC); } /* @@ -409,7 +477,7 @@ DestroyMenuButton(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as text string, colors, font, @@ -420,147 +488,174 @@ DestroyMenuButton(memPtr) */ static int -ConfigureMenuButton(interp, mbPtr, argc, argv, flags) +ConfigureMenuButton(interp, mbPtr, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ - register TkMenuButton *mbPtr; /* Information about widget; may or may - * not already have values for some fields. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ - int flags; /* Flags to pass to Tk_ConfigureWidget. */ + register TkMenuButton *mbPtr; + /* 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. */ { - int result; + Tk_SavedOptions savedOptions; + Tcl_Obj *errorResult = NULL; + int error; Tk_Image image; /* - * Eliminate any existing trace on variables monitored by the menubutton. + * Eliminate any existing trace on variables monitored by the + * menubutton. */ if (mbPtr->textVarName != NULL) { - Tcl_UntraceVar(interp, mbPtr->textVarName, + Tcl_UntraceVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, (ClientData) mbPtr); } - result = Tk_ConfigureWidget(interp, mbPtr->tkwin, configSpecs, - argc, argv, (char *) mbPtr, flags); - if (result != TCL_OK) { - return TCL_ERROR; - } - /* - * A few options need special processing, such as setting the - * background from a 3-D border, or filling in complicated - * defaults that couldn't be specified to Tk_ConfigureWidget. + * The following loop is potentially executed twice. During the + * first pass configuration options get set to their new values. + * If there is an error in this pass, we execute a second pass + * to restore all the options to their previous values. */ - if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) { - Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder); - } else { - Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder); - if ((mbPtr->state != tkNormalUid) && (mbPtr->state != tkActiveUid) - && (mbPtr->state != tkDisabledUid)) { - Tcl_AppendResult(interp, "bad state value \"", mbPtr->state, - "\": must be normal, active, or disabled", (char *) NULL); - mbPtr->state = tkNormalUid; - return TCL_ERROR; + for (error = 0; error <= 1; error++) { + if (!error) { + /* + * First pass: set options to new values. + */ + + if (Tk_SetOptions(interp, (char *) mbPtr, + mbPtr->optionTable, objc, objv, + mbPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { + continue; + } + } else { + /* + * Second pass: restore options to old values. + */ + + errorResult = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(errorResult); + Tk_RestoreSavedOptions(&savedOptions); } - } - if ((mbPtr->direction != aboveUid) && (mbPtr->direction != belowUid) - && (mbPtr->direction != leftUid) && (mbPtr->direction != rightUid) - && (mbPtr->direction != flushUid)) { - Tcl_AppendResult(interp, "bad direction value \"", mbPtr->direction, - "\": must be above, below, left, right, or flush", - (char *) NULL); - mbPtr->direction = belowUid; - return TCL_ERROR; - } - - if (mbPtr->highlightWidth < 0) { - mbPtr->highlightWidth = 0; - } + /* + * A few options need special processing, such as setting the + * background from a 3-D border, or filling in complicated + * defaults that couldn't be specified to Tk_SetOptions. + */ - if (mbPtr->padX < 0) { - mbPtr->padX = 0; - } - if (mbPtr->padY < 0) { - mbPtr->padY = 0; - } + if ((mbPtr->state == STATE_ACTIVE) + && !Tk_StrictMotif(mbPtr->tkwin)) { + Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder); + } else { + Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder); + } - /* - * Get the image for the widget, if there is one. Allocate the - * new image before freeing the old one, so that the reference - * count doesn't go to zero and cause image data to be discarded. - */ + if (mbPtr->highlightWidth < 0) { + mbPtr->highlightWidth = 0; + } - if (mbPtr->imageString != NULL) { - image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin, - mbPtr->imageString, MenuButtonImageProc, (ClientData) mbPtr); - if (image == NULL) { - return TCL_ERROR; + if (mbPtr->padX < 0) { + mbPtr->padX = 0; + } + if (mbPtr->padY < 0) { + mbPtr->padY = 0; } - } else { - image = NULL; - } - if (mbPtr->image != NULL) { - Tk_FreeImage(mbPtr->image); - } - mbPtr->image = image; - if ((mbPtr->image == NULL) && (mbPtr->bitmap == None) - && (mbPtr->textVarName != NULL)) { /* - * The menubutton displays a variable. Set up a trace to watch - * for any changes in it. + * Get the image for the widget, if there is one. Allocate the + * new image before freeing the old one, so that the reference + * count doesn't go to zero and cause image data to be discarded. */ - char *value; + if (mbPtr->imageString != NULL) { + image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin, + mbPtr->imageString, MenuButtonImageProc, + (ClientData) mbPtr); + if (image == NULL) { + return TCL_ERROR; + } + } else { + image = NULL; + } + if (mbPtr->image != NULL) { + Tk_FreeImage(mbPtr->image); + } + mbPtr->image = image; - value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY); - if (value == NULL) { - Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, - TCL_GLOBAL_ONLY); + /* + * Recompute the geometry for the button. + */ + + if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) { + if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString, + &mbPtr->width) != TCL_OK) { + widthError: + Tcl_AddErrorInfo(interp, "\n (processing -width option)"); + continue; + } + if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString, + &mbPtr->height) != TCL_OK) { + heightError: + Tcl_AddErrorInfo(interp, "\n (processing -height option)"); + continue; + } } else { - if (mbPtr->text != NULL) { - ckfree(mbPtr->text); + if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width) + != TCL_OK) { + goto widthError; + } + if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height) + != TCL_OK) { + goto heightError; } - mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); - strcpy(mbPtr->text, value); } - Tcl_TraceVar(interp, mbPtr->textVarName, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuButtonTextVarProc, (ClientData) mbPtr); + break; } - /* - * Recompute the geometry for the button. - */ + if (!error) { + Tk_FreeSavedOptions(&savedOptions); + } - if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) { - if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString, - &mbPtr->width) != TCL_OK) { - widthError: - Tcl_AddErrorInfo(interp, "\n (processing -width option)"); - return TCL_ERROR; - } - if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString, - &mbPtr->height) != TCL_OK) { - heightError: - Tcl_AddErrorInfo(interp, "\n (processing -height option)"); - return TCL_ERROR; - } - } else { - if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width) - != TCL_OK) { - goto widthError; - } - if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height) - != TCL_OK) { - goto heightError; - } + if ((mbPtr->image == NULL) && (mbPtr->bitmap == None) + && (mbPtr->textVarName != NULL)) { + + /* + * The menubutton displays the value of a variable. + * Set up a trace to watch for any changes in it, create + * the variable if it doesn't exist, and fetch its + * current value. + */ + + char *value; + + value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY); + if (value == NULL) { + Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, + TCL_GLOBAL_ONLY); + } else { + if (mbPtr->text != NULL) { + ckfree(mbPtr->text); + } + mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); + strcpy(mbPtr->text, value); + } + Tcl_TraceVar(interp, mbPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuButtonTextVarProc, (ClientData) mbPtr); } + TkMenuButtonWorldChanged((ClientData) mbPtr); - return TCL_OK; + if (error) { + Tcl_SetObjResult(interp, errorResult); + Tcl_DecrRefCount(errorResult); + return TCL_ERROR; + } else { + return TCL_OK; + } } /* @@ -690,15 +785,7 @@ MenuButtonEventProc(clientData, eventPtr) goto redraw; } else if (eventPtr->type == DestroyNotify) { - TkpDestroyMenuButton(mbPtr); - if (mbPtr->tkwin != NULL) { - mbPtr->tkwin = NULL; - Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd); - } - if (mbPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr); - } - Tcl_EventuallyFree((ClientData) mbPtr, DestroyMenuButton); + DestroyMenuButton((char *) mbPtr); } else if (eventPtr->type == FocusIn) { if (eventPtr->xfocus.detail != NotifyInferior) { mbPtr->flags |= GOT_FOCUS; @@ -756,7 +843,6 @@ MenuButtonCmdDeletedProc(clientData) */ if (tkwin != NULL) { - mbPtr->tkwin = NULL; Tk_DestroyWindow(tkwin); } } diff --git a/generic/tkMenubutton.h b/generic/tkMenubutton.h index b032274..eb7e030 100644 --- a/generic/tkMenubutton.h +++ b/generic/tkMenubutton.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMenubutton.h,v 1.4 1998/09/14 18:23:15 stanton Exp $ + * RCS: @(#) $Id: tkMenubutton.h,v 1.5 1999/04/16 01:51:19 stanton Exp $ */ #ifndef _TKMENUBUTTON @@ -25,6 +25,23 @@ #endif /* + * Legal values for the "orient" field of TkMenubutton records. + */ + +enum direction { + DIRECTION_ABOVE, DIRECTION_BELOW, DIRECTION_FLUSH, + DIRECTION_LEFT, DIRECTION_RIGHT +}; + +/* + * Legal values for the "state" field of TkMenubutton records. + */ + +enum state { + STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL +}; + +/* * A data structure of the following type is kept for each * widget managed by this file: */ @@ -39,6 +56,8 @@ typedef struct { * freed up even after tkwin has gone away. */ Tcl_Interp *interp; /* Interpreter associated with menubutton. */ Tcl_Command widgetCmd; /* Token for menubutton's widget command. */ + Tk_OptionTable optionTable; /* Table that defines configuration options + * available for this widget. */ char *menuName; /* Name of menu associated with widget. * Malloc-ed. */ @@ -65,7 +84,7 @@ typedef struct { * Information used when displaying widget: */ - Tk_Uid state; /* State of button for display purposes: + enum state state; /* State of button for display purposes: * normal, active, or disabled. */ Tk_3DBorder normalBorder; /* Structure used to draw 3-D * border and background when window @@ -143,7 +162,7 @@ typedef struct { * Miscellaneous information: */ - Tk_Uid direction; /* Direction for where to pop the menu. + enum direction direction; /* Direction for where to pop the menu. * Valid directions are "above", "below", * "left", "right", and "flush". "flush" * means that the upper left corner of the diff --git a/generic/tkMessage.c b/generic/tkMessage.c index d12c0a3..3f7a4e7 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -6,12 +6,12 @@ * in a window according to a particular aspect ratio. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMessage.c,v 1.2 1998/09/14 18:23:15 stanton Exp $ + * RCS: @(#) $Id: tkMessage.c,v 1.3 1999/04/16 01:51:20 stanton Exp $ */ #include "tkPort.h" @@ -40,7 +40,7 @@ typedef struct { char *string; /* String displayed in message. */ int numChars; /* Number of characters in string, not - * including terminating NULL character. */ + * including terminating NULL. */ char *textVarName; /* Name of variable (malloc'ed) or NULL. * If non-NULL, message displays the contents * of this variable. */ @@ -274,7 +274,7 @@ Tk_MessageCmd(clientData, interp, argc, argv) goto error; } - interp->result = Tk_PathName(msgPtr->tkwin); + Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC); return TCL_OK; error: @@ -401,7 +401,7 @@ DestroyMessage(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as text string, colors, font, @@ -465,7 +465,7 @@ ConfigureMessage(interp, msgPtr, argc, argv, flags) * that couldn't be specified to Tk_ConfigureWidget. */ - msgPtr->numChars = strlen(msgPtr->string); + msgPtr->numChars = Tcl_NumUtfChars(msgPtr->string, -1); Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border); @@ -834,8 +834,8 @@ MessageTextVarProc(clientData, interp, name1, name2, flags) if (msgPtr->string != NULL) { ckfree(msgPtr->string); } - msgPtr->numChars = strlen(value); - msgPtr->string = (char *) ckalloc((unsigned) (msgPtr->numChars + 1)); + msgPtr->numChars = Tcl_NumUtfChars(value, -1); + msgPtr->string = (char *) ckalloc((unsigned) (strlen(value) + 1)); strcpy(msgPtr->string, value); ComputeMessageGeometry(msgPtr); diff --git a/generic/tkObj.c b/generic/tkObj.c new file mode 100644 index 0000000..ff2684c --- /dev/null +++ b/generic/tkObj.c @@ -0,0 +1,659 @@ +/* + * tkObj.c -- + * + * This file contains procedures that implement the common Tk object + * types + * + * Copyright (c) 1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkObj.c,v 1.2 1999/04/16 01:51:20 stanton Exp $ + */ + +#include "tkInt.h" + +/* + * The following structure is the internal representation for pixel objects. + */ + +typedef struct PixelRep { + double value; + int units; + Tk_Window tkwin; + int returnValue; +} PixelRep; + +#define SIMPLE_PIXELREP(objPtr) \ + ((objPtr)->internalRep.twoPtrValue.ptr2 == 0) + +#define SET_SIMPLEPIXEL(objPtr, intval) \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval); \ + (objPtr)->internalRep.twoPtrValue.ptr2 = 0 + +#define GET_SIMPLEPIXEL(objPtr) \ + ((int) (objPtr)->internalRep.twoPtrValue.ptr1) + +#define SET_COMPLEXPIXEL(objPtr, repPtr) \ + (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \ + (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr + +#define GET_COMPLEXPIXEL(objPtr) \ + ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2) + + +/* + * The following structure is the internal representation for mm objects. + */ + +typedef struct MMRep { + double value; + int units; + Tk_Window tkwin; + double returnValue; +} MMRep; + +/* + * Prototypes for procedures defined later in this file: + */ + +static void DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr)); +static void DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr)); +static void FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); +static int SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static int SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static int SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); + +/* + * The following structure defines the implementation of the "pixel" + * Tcl object, used for measuring distances. The pixel object remembers + * its initial display-independant settings. + */ + +static Tcl_ObjType pixelObjType = { + "pixel", /* name */ + FreePixelInternalRep, /* freeIntRepProc */ + DupPixelInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetPixelFromAny /* setFromAnyProc */ +}; + +/* + * The following structure defines the implementation of the "pixel" + * Tcl object, used for measuring distances. The pixel object remembers + * its initial display-independant settings. + */ + +static Tcl_ObjType mmObjType = { + "mm", /* name */ + FreeMMInternalRep, /* freeIntRepProc */ + DupMMInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetMMFromAny /* setFromAnyProc */ +}; + +/* + * The following structure defines the implementation of the "window" + * Tcl object. + */ + +static Tcl_ObjType windowObjType = { + "window", /* name */ + (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ + (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetWindowFromAny /* setFromAnyProc */ +}; + + + +/* + *---------------------------------------------------------------------- + * + * Tk_GetPixelsFromObj -- + * + * Attempt to return a pixel value from the Tcl object "objPtr". If the + * object is not already a pixel value, an attempt will be made to convert + * it to one. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already a pixel, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tk_Window tkwin; + Tcl_Obj *objPtr; /* The object from which to get pixels. */ + int *intPtr; /* Place to store resulting pixels. */ +{ + int result; + double d; + PixelRep *pixelPtr; + static double bias[] = { + 1.0, 10.0, 25.4, 25.4 / 72.0 + }; + + if (objPtr->typePtr != &pixelObjType) { + result = SetPixelFromAny(interp, objPtr); + if (result != TCL_OK) { + return result; + } + } + + if (SIMPLE_PIXELREP(objPtr)) { + *intPtr = GET_SIMPLEPIXEL(objPtr); + } else { + pixelPtr = GET_COMPLEXPIXEL(objPtr); + if (pixelPtr->tkwin != tkwin) { + d = pixelPtr->value; + if (pixelPtr->units >= 0) { + d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin)); + d /= WidthMMOfScreen(Tk_Screen(tkwin)); + } + if (d < 0) { + pixelPtr->returnValue = (int) (d - 0.5); + } else { + pixelPtr->returnValue = (int) (d + 0.5); + } + pixelPtr->tkwin = tkwin; + } + *intPtr = pixelPtr->returnValue; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FreePixelInternalRep -- + * + * Deallocate the storage associated with a pixel object's internal + * representation. + * + * Results: + * None. + * + * Side effects: + * Frees objPtr's internal representation and sets objPtr's + * internalRep to NULL. + * + *---------------------------------------------------------------------- + */ + +static void +FreePixelInternalRep(objPtr) + Tcl_Obj *objPtr; /* Pixel object with internal rep to free. */ +{ + PixelRep *pixelPtr; + + if (!SIMPLE_PIXELREP(objPtr)) { + pixelPtr = GET_COMPLEXPIXEL(objPtr); + ckfree((char *) pixelPtr); + } + SET_SIMPLEPIXEL(objPtr, 0); +} + +/* + *---------------------------------------------------------------------- + * + * DupPixelInternalRep -- + * + * Initialize the internal representation of a pixel Tcl_Obj to a + * copy of the internal representation of an existing pixel object. + * + * Results: + * None. + * + * Side effects: + * copyPtr's internal rep is set to the pixel corresponding to + * srcPtr's internal rep. + * + *---------------------------------------------------------------------- + */ + +static void +DupPixelInternalRep(srcPtr, copyPtr) + register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ + register Tcl_Obj *copyPtr; /* Object with internal rep to set. */ +{ + PixelRep *oldPtr, *newPtr; + + copyPtr->typePtr = srcPtr->typePtr; + + if (SIMPLE_PIXELREP(srcPtr)) { + SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr)); + } else { + oldPtr = GET_COMPLEXPIXEL(srcPtr); + newPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); + newPtr->value = oldPtr->value; + newPtr->units = oldPtr->units; + newPtr->tkwin = oldPtr->tkwin; + newPtr->returnValue = oldPtr->returnValue; + SET_COMPLEXPIXEL(copyPtr, newPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * SetPixelFromAny -- + * + * Attempt to generate a pixel internal form for the Tcl object + * "objPtr". + * + * Results: + * The return value is a standard Tcl result. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * If no error occurs, a pixel representation of the object is + * stored internally and the type of "objPtr" is set to pixel. + * + *---------------------------------------------------------------------- + */ + +static int +SetPixelFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + char *string, *rest; + double d; + int i, units; + PixelRep *pixelPtr; + + string = Tcl_GetStringFromObj(objPtr, NULL); + + d = strtod(string, &rest); + if (rest == string) { + /* + * Must copy string before resetting the result in case a caller + * is trying to convert the interpreter's result to pixels. + */ + + char buf[100]; + + error: + sprintf(buf, "bad screen distance \"%.50s\"", string); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, buf, NULL); + return TCL_ERROR; + } + while ((*rest != '\0') && isspace(UCHAR(*rest))) { + rest++; + } + switch (*rest) { + case '\0': + units = -1; + break; + + case 'm': + units = 0; + break; + + case 'c': + units = 1; + break; + + case 'i': + units = 2; + break; + + case 'p': + units = 3; + break; + + default: + goto error; + } + + /* + * Free the old internalRep before setting the new one. + */ + + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + + objPtr->typePtr = &pixelObjType; + + i = (int) d; + if ((units < 0) && (i == d)) { + SET_SIMPLEPIXEL(objPtr, i); + } else { + pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); + pixelPtr->value = d; + pixelPtr->units = units; + pixelPtr->tkwin = NULL; + pixelPtr->returnValue = i; + SET_COMPLEXPIXEL(objPtr, pixelPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_GetMMFromObj -- + * + * Attempt to return an mm value from the Tcl object "objPtr". If the + * object is not already an mm value, an attempt will be made to convert + * it to one. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already a pixel, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tk_Window tkwin; + Tcl_Obj *objPtr; /* The object from which to get mms. */ + double *doublePtr; /* Place to store resulting millimeters. */ +{ + int result; + double d; + MMRep *mmPtr; + static double bias[] = { + 10.0, 25.4, 1.0, 25.4 / 72.0 + }; + + if (objPtr->typePtr != &mmObjType) { + result = SetMMFromAny(interp, objPtr); + if (result != TCL_OK) { + return result; + } + } + + mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; + if (mmPtr->tkwin != tkwin) { + d = mmPtr->value; + if (mmPtr->units == -1) { + d /= WidthOfScreen(Tk_Screen(tkwin)); + d *= WidthMMOfScreen(Tk_Screen(tkwin)); + } else { + d *= bias[mmPtr->units]; + } + mmPtr->tkwin = tkwin; + mmPtr->returnValue = d; + } + *doublePtr = mmPtr->returnValue; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FreeMMInternalRep -- + * + * Deallocate the storage associated with a mm object's internal + * representation. + * + * Results: + * None. + * + * Side effects: + * Frees objPtr's internal representation and sets objPtr's + * internalRep to NULL. + * + *---------------------------------------------------------------------- + */ + +static void +FreeMMInternalRep(objPtr) + Tcl_Obj *objPtr; /* MM object with internal rep to free. */ +{ + ckfree((char *) objPtr->internalRep.otherValuePtr); + objPtr->internalRep.otherValuePtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * DupMMInternalRep -- + * + * Initialize the internal representation of a pixel Tcl_Obj to a + * copy of the internal representation of an existing pixel object. + * + * Results: + * None. + * + * Side effects: + * copyPtr's internal rep is set to the pixel corresponding to + * srcPtr's internal rep. + * + *---------------------------------------------------------------------- + */ + +static void +DupMMInternalRep(srcPtr, copyPtr) + register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ + register Tcl_Obj *copyPtr; /* Object with internal rep to set. */ +{ + MMRep *oldPtr, *newPtr; + + copyPtr->typePtr = srcPtr->typePtr; + oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr; + newPtr = (MMRep *) ckalloc(sizeof(MMRep)); + newPtr->value = oldPtr->value; + newPtr->units = oldPtr->units; + newPtr->tkwin = oldPtr->tkwin; + newPtr->returnValue = oldPtr->returnValue; + copyPtr->internalRep.otherValuePtr = (VOID *) newPtr; +} + +/* + *---------------------------------------------------------------------- + * + * SetMMFromAny -- + * + * Attempt to generate a mm internal form for the Tcl object + * "objPtr". + * + * Results: + * The return value is a standard Tcl result. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * If no error occurs, a mm representation of the object is + * stored internally and the type of "objPtr" is set to mm. + * + *---------------------------------------------------------------------- + */ + +static int +SetMMFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + char *string, *rest; + double d; + int units; + MMRep *mmPtr; + + string = Tcl_GetStringFromObj(objPtr, NULL); + + d = strtod(string, &rest); + if (rest == string) { + /* + * Must copy string before resetting the result in case a caller + * is trying to convert the interpreter's result to mms. + */ + + error: + Tcl_AppendResult(interp, "bad screen distance \"", string, + "\"", (char *) NULL); + return TCL_ERROR; + } + while ((*rest != '\0') && isspace(UCHAR(*rest))) { + rest++; + } + switch (*rest) { + case '\0': + units = -1; + break; + + case 'c': + units = 0; + break; + + case 'i': + units = 1; + break; + + case 'm': + units = 2; + break; + + case 'p': + units = 3; + break; + + default: + goto error; + } + + /* + * Free the old internalRep before setting the new one. + */ + + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + + objPtr->typePtr = &mmObjType; + + mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); + mmPtr->value = d; + mmPtr->units = units; + mmPtr->tkwin = NULL; + mmPtr->returnValue = d; + objPtr->internalRep.otherValuePtr = (VOID *) mmPtr; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TkGetWindowFromObj -- + * + * Attempt to return a Tk_Window from the Tcl object "objPtr". If the + * object is not already a Tk_Window, an attempt will be made to convert + * it to one. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already a Tk_Window, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +int +TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tk_Window tkwin; /* A token to get the main window from. */ + register Tcl_Obj *objPtr; /* The object from which to get boolean. */ + Tk_Window *windowPtr; /* Place to store resulting window. */ +{ + register int result; + Tk_Window lastWindow; + + result = SetWindowFromAny(interp, objPtr); + if (result != TCL_OK) { + return result; + } + + lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1; + if (tkwin != lastWindow) { + Tk_Window foundWindow = Tk_NameToWindow(interp, + Tcl_GetStringFromObj(objPtr, NULL), tkwin); + + if (foundWindow == NULL) { + return TCL_ERROR; + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin; + objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow; + } + *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2; + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * SetWindowFromAny -- + * + * Attempt to generate a Tk_Window internal form for the Tcl object + * "objPtr". + * + * Results: + * The return value is a standard Tcl result. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * If no error occurs, a standard window value is stored as "objPtr"s + * internal representation and the type of "objPtr" is set to Tk_Window. + * + *---------------------------------------------------------------------- + */ + +static int +SetWindowFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + + /* + * Free the old internalRep before setting the new one. + */ + + Tcl_GetStringFromObj(objPtr, NULL); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &windowObjType; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + + return TCL_OK; +} diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c new file mode 100644 index 0000000..4b783e6 --- /dev/null +++ b/generic/tkOldConfig.c @@ -0,0 +1,1000 @@ +/* + * tkOldConfig.c -- + * + * This file contains the Tk_ConfigureWidget procedure. THIS FILE + * IS HERE FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION + * PACKAGE SHOULD BE USED FOR NEW PROJECTS. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkOldConfig.c,v 1.2 1999/04/16 01:51:20 stanton Exp $ + */ + +#include "tkPort.h" +#include "tk.h" + +/* + * Values for "flags" field of Tk_ConfigSpec structures. Be sure + * to coordinate these values with those defined in tk.h + * (TK_CONFIG_COLOR_ONLY, etc.). There must not be overlap! + * + * INIT - Non-zero means (char *) things have been + * converted to Tk_Uid's. + */ + +#define INIT 0x20 + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int DoConfig _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, Tk_ConfigSpec *specPtr, + Tk_Uid value, int valueIsUid, char *widgRec)); +static Tk_ConfigSpec * FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp, + Tk_ConfigSpec *specs, char *argvName, + int needFlags, int hateFlags)); +static char * FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, Tk_ConfigSpec *specPtr, + char *widgRec)); +static char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, Tk_ConfigSpec *specPtr, + char *widgRec, char *buffer, + Tcl_FreeProc **freeProcPtr)); + +/* + *-------------------------------------------------------------- + * + * Tk_ConfigureWidget -- + * + * Process command-line options and database options to + * fill in fields of a widget record with resources and + * other parameters. + * + * Results: + * A standard Tcl return value. In case of an error, + * the interp's result will hold an error message. + * + * Side effects: + * The fields of widgRec get filled in with information + * from argc/argv and the option database. Old information + * in widgRec's fields gets recycled. + * + *-------------------------------------------------------------- + */ + +int +Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags) + 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. */ + int argc; /* Number of elements in argv. */ + 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 be present in config specs + * for them to be considered. Also, + * may have TK_CONFIG_ARGV_ONLY set. */ +{ + register Tk_ConfigSpec *specPtr; + Tk_Uid value; /* Value of option from database. */ + int needFlags; /* Specs must contain this set of flags + * or else they are not considered. */ + int hateFlags; /* If a spec contains any bits here, it's + * not considered. */ + + needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); + if (Tk_Depth(tkwin) <= 1) { + hateFlags = TK_CONFIG_COLOR_ONLY; + } else { + hateFlags = TK_CONFIG_MONO_ONLY; + } + + /* + * Pass one: scan through all the option specs, replacing strings + * with Tk_Uids (if this hasn't been done already) and clearing + * the TK_CONFIG_OPTION_SPECIFIED flags. + */ + + for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { + if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) { + if (specPtr->dbName != NULL) { + specPtr->dbName = Tk_GetUid(specPtr->dbName); + } + if (specPtr->dbClass != NULL) { + specPtr->dbClass = Tk_GetUid(specPtr->dbClass); + } + if (specPtr->defValue != NULL) { + specPtr->defValue = Tk_GetUid(specPtr->defValue); + } + } + specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED) + | INIT; + } + + /* + * Pass two: scan through all of the arguments, processing those + * that match entries in the specs. + */ + + for ( ; argc > 0; argc -= 2, argv += 2) { + specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags); + if (specPtr == NULL) { + return TCL_ERROR; + } + + /* + * Process the entry. + */ + + if (argc < 2) { + Tcl_AppendResult(interp, "value for \"", *argv, + "\" missing", (char *) NULL); + return TCL_ERROR; + } + if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) { + char msg[100]; + + sprintf(msg, "\n (processing \"%.40s\" option)", + specPtr->argvName); + Tcl_AddErrorInfo(interp, msg); + return TCL_ERROR; + } + specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED; + } + + /* + * Pass three: scan through all of the specs again; if no + * command-line argument matched a spec, then check for info + * in the option database. If there was nothing in the + * database, then use the default. + */ + + if (!(flags & TK_CONFIG_ARGV_ONLY)) { + for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { + if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED) + || (specPtr->argvName == NULL) + || (specPtr->type == TK_CONFIG_SYNONYM)) { + continue; + } + if (((specPtr->specFlags & needFlags) != needFlags) + || (specPtr->specFlags & hateFlags)) { + continue; + } + value = NULL; + if (specPtr->dbName != NULL) { + value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass); + } + 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); + return TCL_ERROR; + } + } else { + if (specPtr->defValue != NULL) { + value = Tk_GetUid(specPtr->defValue); + } else { + value = NULL; + } + if ((value != NULL) && !(specPtr->specFlags + & TK_CONFIG_DONT_SET_DEFAULT)) { + if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != + TCL_OK) { + char msg[200]; + + sprintf(msg, + "\n (%s \"%.50s\" in widget \"%.50s\")", + "default value for", + specPtr->dbName, Tk_PathName(tkwin)); + Tcl_AddErrorInfo(interp, msg); + return TCL_ERROR; + } + } + } + } + } + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * FindConfigSpec -- + * + * Search through a table of configuration specs, looking for + * one that matches a given argvName. + * + * Results: + * The return value is a pointer to the matching entry, or NULL + * if nothing matched. In that case an error message is left + * in the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static Tk_ConfigSpec * +FindConfigSpec(interp, specs, argvName, needFlags, hateFlags) + Tcl_Interp *interp; /* Used for reporting errors. */ + Tk_ConfigSpec *specs; /* Pointer to table of configuration + * specifications for a widget. */ + char *argvName; /* Name (suitable for use in a "config" + * command) identifying particular option. */ + int needFlags; /* Flags that must be present in matching + * entry. */ + int hateFlags; /* Flags that must NOT be present in + * matching entry. */ +{ + register Tk_ConfigSpec *specPtr; + register char c; /* First character of current argument. */ + Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */ + size_t length; + + c = argvName[1]; + length = strlen(argvName); + matchPtr = NULL; + for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { + if (specPtr->argvName == NULL) { + continue; + } + if ((specPtr->argvName[1] != c) + || (strncmp(specPtr->argvName, argvName, length) != 0)) { + continue; + } + if (((specPtr->specFlags & needFlags) != needFlags) + || (specPtr->specFlags & hateFlags)) { + continue; + } + if (specPtr->argvName[length] == 0) { + matchPtr = specPtr; + goto gotMatch; + } + if (matchPtr != NULL) { + Tcl_AppendResult(interp, "ambiguous option \"", argvName, + "\"", (char *) NULL); + return (Tk_ConfigSpec *) NULL; + } + matchPtr = specPtr; + } + + if (matchPtr == NULL) { + Tcl_AppendResult(interp, "unknown option \"", argvName, + "\"", (char *) NULL); + return (Tk_ConfigSpec *) NULL; + } + + /* + * Found a matching entry. If it's a synonym, then find the + * entry that it's a synonym for. + */ + + gotMatch: + specPtr = matchPtr; + 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, "\"", (char *) NULL); + return (Tk_ConfigSpec *) NULL; + } + if ((specPtr->dbName == matchPtr->dbName) + && (specPtr->type != TK_CONFIG_SYNONYM) + && ((specPtr->specFlags & needFlags) == needFlags) + && !(specPtr->specFlags & hateFlags)) { + break; + } + } + } + return specPtr; +} + +/* + *-------------------------------------------------------------- + * + * DoConfig -- + * + * This procedure applies a single configuration option + * to a widget record. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * WidgRec is modified as indicated by specPtr and value. + * The old value is recycled, if that is appropriate for + * the value type. + * + *-------------------------------------------------------------- + */ + +static int +DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Window tkwin; /* Window containing widget (needed to + * set up X resources). */ + Tk_ConfigSpec *specPtr; /* Specifier to apply. */ + char *value; /* Value to use to fill in widgRec. */ + int valueIsUid; /* Non-zero means value is a Tk_Uid; + * zero means it's an ordinary string. */ + char *widgRec; /* Record whose fields are to be + * modified. Values must be properly + * initialized. */ +{ + char *ptr; + Tk_Uid uid; + int nullValue; + + nullValue = 0; + if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) { + nullValue = 1; + } + + do { + ptr = widgRec + specPtr->offset; + switch (specPtr->type) { + case TK_CONFIG_BOOLEAN: + if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_INT: + if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_DOUBLE: + if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_STRING: { + char *old, *new; + + if (nullValue) { + new = NULL; + } else { + new = (char *) ckalloc((unsigned) (strlen(value) + 1)); + strcpy(new, value); + } + old = *((char **) ptr); + if (old != NULL) { + ckfree(old); + } + *((char **) ptr) = new; + break; + } + case TK_CONFIG_UID: + if (nullValue) { + *((Tk_Uid *) ptr) = NULL; + } else { + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + *((Tk_Uid *) ptr) = uid; + } + break; + case TK_CONFIG_COLOR: { + XColor *newPtr, *oldPtr; + + if (nullValue) { + newPtr = NULL; + } else { + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + newPtr = Tk_GetColor(interp, tkwin, uid); + if (newPtr == NULL) { + return TCL_ERROR; + } + } + oldPtr = *((XColor **) ptr); + if (oldPtr != NULL) { + Tk_FreeColor(oldPtr); + } + *((XColor **) ptr) = newPtr; + break; + } + case TK_CONFIG_FONT: { + Tk_Font new; + + if (nullValue) { + new = NULL; + } else { + new = Tk_GetFont(interp, tkwin, value); + if (new == NULL) { + return TCL_ERROR; + } + } + Tk_FreeFont(*((Tk_Font *) ptr)); + *((Tk_Font *) ptr) = new; + break; + } + case TK_CONFIG_BITMAP: { + Pixmap new, old; + + if (nullValue) { + new = None; + } else { + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + new = Tk_GetBitmap(interp, tkwin, uid); + if (new == None) { + return TCL_ERROR; + } + } + old = *((Pixmap *) ptr); + if (old != None) { + Tk_FreeBitmap(Tk_Display(tkwin), old); + } + *((Pixmap *) ptr) = new; + break; + } + case TK_CONFIG_BORDER: { + Tk_3DBorder new, old; + + if (nullValue) { + new = NULL; + } else { + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + new = Tk_Get3DBorder(interp, tkwin, uid); + if (new == NULL) { + return TCL_ERROR; + } + } + old = *((Tk_3DBorder *) ptr); + if (old != NULL) { + Tk_Free3DBorder(old); + } + *((Tk_3DBorder *) ptr) = new; + break; + } + case TK_CONFIG_RELIEF: + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_CURSOR: + case TK_CONFIG_ACTIVE_CURSOR: { + Tk_Cursor new, old; + + if (nullValue) { + new = None; + } else { + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + new = Tk_GetCursor(interp, tkwin, uid); + if (new == None) { + return TCL_ERROR; + } + } + old = *((Tk_Cursor *) ptr); + if (old != None) { + Tk_FreeCursor(Tk_Display(tkwin), old); + } + *((Tk_Cursor *) ptr) = new; + if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) { + Tk_DefineCursor(tkwin, new); + } + break; + } + case TK_CONFIG_JUSTIFY: + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_ANCHOR: + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_CAP_STYLE: + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_JOIN_STYLE: + uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); + if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_PIXELS: + if (Tk_GetPixels(interp, tkwin, value, (int *) ptr) + != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_MM: + if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr) + != TCL_OK) { + return TCL_ERROR; + } + break; + case TK_CONFIG_WINDOW: { + Tk_Window tkwin2; + + if (nullValue) { + tkwin2 = NULL; + } else { + tkwin2 = Tk_NameToWindow(interp, value, tkwin); + if (tkwin2 == NULL) { + return TCL_ERROR; + } + } + *((Tk_Window *) ptr) = tkwin2; + break; + } + case TK_CONFIG_CUSTOM: + 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); + return TCL_ERROR; + } + } + specPtr++; + } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END)); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_ConfigureInfo -- + * + * Return information about the configuration options + * for a window, and their current values. + * + * Results: + * Always returns TCL_OK. The interp's result will be modified + * hold a description of either a single configuration option + * available for "widgRec" via "specs", or all the configuration + * options available. In the "all" case, the result will + * available for "widgRec" via "specs". The result will + * be a list, each of whose entries describes one option. + * Each entry will itself be a list containing the option's + * name for use on command lines, database name, database + * class, default value, and current value (empty string + * if none). For options that are synonyms, the list will + * contain only two values: name and synonym name. If the + * "name" argument is non-NULL, then the only information + * returned is that for the named argument (i.e. the corresponding + * entry in the overall list is returned). + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Window tkwin; /* Window corresponding to widgRec. */ + Tk_ConfigSpec *specs; /* Describes legal options. */ + char *widgRec; /* Record whose fields contain current + * values for options. */ + 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; + int needFlags, hateFlags; + char *list; + char *leader = "{"; + + needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); + if (Tk_Depth(tkwin) <= 1) { + hateFlags = TK_CONFIG_COLOR_ONLY; + } else { + hateFlags = TK_CONFIG_MONO_ONLY; + } + + /* + * If information is only wanted for a single configuration + * spec, then handle that one spec specially. + */ + + Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); + if (argvName != NULL) { + specPtr = FindConfigSpec(interp, specs, argvName, needFlags, + hateFlags); + if (specPtr == NULL) { + return TCL_ERROR; + } + Tcl_SetResult(interp, + FormatConfigInfo(interp, tkwin, specPtr, widgRec), + TCL_DYNAMIC); + return TCL_OK; + } + + /* + * Loop through all the specs, creating a big list with all + * their information. + */ + + for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { + if ((argvName != NULL) && (specPtr->argvName != argvName)) { + continue; + } + if (((specPtr->specFlags & needFlags) != needFlags) + || (specPtr->specFlags & hateFlags)) { + continue; + } + if (specPtr->argvName == NULL) { + continue; + } + list = FormatConfigInfo(interp, tkwin, specPtr, widgRec); + Tcl_AppendResult(interp, leader, list, "}", (char *) NULL); + ckfree(list); + leader = " {"; + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * FormatConfigInfo -- + * + * Create a valid Tcl list holding the configuration information + * for a single configuration option. + * + * Results: + * A Tcl list, dynamically allocated. The caller is expected to + * arrange for this list to be freed eventually. + * + * Side effects: + * Memory is allocated. + * + *-------------------------------------------------------------- + */ + +static char * +FormatConfigInfo(interp, tkwin, specPtr, widgRec) + Tcl_Interp *interp; /* Interpreter to use for things + * like floating-point precision. */ + Tk_Window tkwin; /* Window corresponding to widget. */ + register Tk_ConfigSpec *specPtr; /* Pointer to information describing + * option. */ + char *widgRec; /* Pointer to record holding current + * values of info for widget. */ +{ + char *argv[6], *result; + char buffer[200]; + Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL; + + argv[0] = specPtr->argvName; + argv[1] = specPtr->dbName; + argv[2] = specPtr->dbClass; + argv[3] = specPtr->defValue; + if (specPtr->type == TK_CONFIG_SYNONYM) { + return Tcl_Merge(2, argv); + } + argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, + &freeProc); + if (argv[1] == NULL) { + argv[1] = ""; + } + if (argv[2] == NULL) { + argv[2] = ""; + } + if (argv[3] == NULL) { + argv[3] = ""; + } + if (argv[4] == NULL) { + argv[4] = ""; + } + result = Tcl_Merge(5, argv); + if (freeProc != NULL) { + if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { + ckfree(argv[4]); + } else { + (*freeProc)(argv[4]); + } + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * FormatConfigValue -- + * + * This procedure formats the current value of a configuration + * option. + * + * Results: + * The return value is the formatted value of the option given + * by specPtr and widgRec. If the value is static, so that it + * need not be freed, *freeProcPtr will be set to NULL; otherwise + * *freeProcPtr will be set to the address of a procedure to + * free the result, and the caller must invoke this procedure + * when it is finished with the result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static char * +FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr) + Tcl_Interp *interp; /* Interpreter for use in real conversions. */ + Tk_Window tkwin; /* Window corresponding to widget. */ + 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. */ + char *buffer; /* Static buffer to use for small values. + * Must have at least 200 bytes of storage. */ + Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address + * of procedure to free the result, or NULL + * if result is static. */ +{ + char *ptr, *result; + + *freeProcPtr = NULL; + ptr = widgRec + specPtr->offset; + result = ""; + switch (specPtr->type) { + case TK_CONFIG_BOOLEAN: + if (*((int *) ptr) == 0) { + result = "0"; + } else { + result = "1"; + } + break; + case TK_CONFIG_INT: + sprintf(buffer, "%d", *((int *) ptr)); + result = buffer; + break; + case TK_CONFIG_DOUBLE: + Tcl_PrintDouble(interp, *((double *) ptr), buffer); + result = buffer; + break; + case TK_CONFIG_STRING: + result = (*(char **) ptr); + if (result == NULL) { + result = ""; + } + break; + case TK_CONFIG_UID: { + Tk_Uid uid = *((Tk_Uid *) ptr); + if (uid != NULL) { + result = uid; + } + break; + } + case TK_CONFIG_COLOR: { + XColor *colorPtr = *((XColor **) ptr); + if (colorPtr != NULL) { + result = Tk_NameOfColor(colorPtr); + } + break; + } + case TK_CONFIG_FONT: { + Tk_Font tkfont = *((Tk_Font *) ptr); + if (tkfont != NULL) { + result = Tk_NameOfFont(tkfont); + } + break; + } + case TK_CONFIG_BITMAP: { + Pixmap pixmap = *((Pixmap *) ptr); + if (pixmap != None) { + result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap); + } + break; + } + case TK_CONFIG_BORDER: { + Tk_3DBorder border = *((Tk_3DBorder *) ptr); + if (border != NULL) { + result = Tk_NameOf3DBorder(border); + } + break; + } + case TK_CONFIG_RELIEF: + result = Tk_NameOfRelief(*((int *) ptr)); + break; + case TK_CONFIG_CURSOR: + case TK_CONFIG_ACTIVE_CURSOR: { + Tk_Cursor cursor = *((Tk_Cursor *) ptr); + if (cursor != None) { + result = Tk_NameOfCursor(Tk_Display(tkwin), cursor); + } + break; + } + case TK_CONFIG_JUSTIFY: + result = Tk_NameOfJustify(*((Tk_Justify *) ptr)); + break; + case TK_CONFIG_ANCHOR: + result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr)); + break; + case TK_CONFIG_CAP_STYLE: + result = Tk_NameOfCapStyle(*((int *) ptr)); + break; + case TK_CONFIG_JOIN_STYLE: + result = Tk_NameOfJoinStyle(*((int *) ptr)); + break; + case TK_CONFIG_PIXELS: + sprintf(buffer, "%d", *((int *) ptr)); + result = buffer; + break; + case TK_CONFIG_MM: + Tcl_PrintDouble(interp, *((double *) ptr), buffer); + result = buffer; + break; + case TK_CONFIG_WINDOW: { + Tk_Window tkwin; + + tkwin = *((Tk_Window *) ptr); + if (tkwin != NULL) { + result = Tk_PathName(tkwin); + } + break; + } + case TK_CONFIG_CUSTOM: + result = (*specPtr->customPtr->printProc)( + specPtr->customPtr->clientData, tkwin, widgRec, + specPtr->offset, freeProcPtr); + break; + default: + result = "?? unknown type ??"; + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_ConfigureValue -- + * + * This procedure returns the current value of a configuration + * option for a widget. + * + * Results: + * The return value is a standard Tcl completion code (TCL_OK or + * TCL_ERROR). The interp's result will be set to hold either the value + * of the option given by argvName (if TCL_OK is returned) or + * an error message (if TCL_ERROR is returned). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags) + Tcl_Interp *interp; /* Interpreter for error reporting. */ + Tk_Window tkwin; /* Window corresponding to widgRec. */ + Tk_ConfigSpec *specs; /* Describes legal options. */ + char *widgRec; /* Record whose fields contain current + * values for options. */ + 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 considered. */ +{ + Tk_ConfigSpec *specPtr; + int needFlags, hateFlags; + + needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); + if (Tk_Depth(tkwin) <= 1) { + hateFlags = TK_CONFIG_COLOR_ONLY; + } else { + hateFlags = TK_CONFIG_MONO_ONLY; + } + specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags); + if (specPtr == NULL) { + return TCL_ERROR; + } + interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec, + interp->result, &interp->freeProc); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_FreeOptions -- + * + * Free up all resources associated with configuration options. + * + * Results: + * None. + * + * Side effects: + * Any resource in widgRec that is controlled by a configuration + * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate + * fashion. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +void +Tk_FreeOptions(specs, widgRec, display, needFlags) + Tk_ConfigSpec *specs; /* Describes legal options. */ + char *widgRec; /* Record whose fields contain current + * values for options. */ + Display *display; /* X display; needed for freeing some + * resources. */ + int needFlags; /* Used to specify additional flags + * that must be present in config specs + * for them to be considered. */ +{ + register Tk_ConfigSpec *specPtr; + char *ptr; + + for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { + if ((specPtr->specFlags & needFlags) != needFlags) { + continue; + } + ptr = widgRec + specPtr->offset; + switch (specPtr->type) { + case TK_CONFIG_STRING: + if (*((char **) ptr) != NULL) { + ckfree(*((char **) ptr)); + *((char **) ptr) = NULL; + } + break; + case TK_CONFIG_COLOR: + if (*((XColor **) ptr) != NULL) { + Tk_FreeColor(*((XColor **) ptr)); + *((XColor **) ptr) = NULL; + } + break; + case TK_CONFIG_FONT: + Tk_FreeFont(*((Tk_Font *) ptr)); + *((Tk_Font *) ptr) = NULL; + break; + case TK_CONFIG_BITMAP: + if (*((Pixmap *) ptr) != None) { + Tk_FreeBitmap(display, *((Pixmap *) ptr)); + *((Pixmap *) ptr) = None; + } + break; + case TK_CONFIG_BORDER: + if (*((Tk_3DBorder *) ptr) != NULL) { + Tk_Free3DBorder(*((Tk_3DBorder *) ptr)); + *((Tk_3DBorder *) ptr) = NULL; + } + break; + case TK_CONFIG_CURSOR: + case TK_CONFIG_ACTIVE_CURSOR: + if (*((Tk_Cursor *) ptr) != None) { + Tk_FreeCursor(display, *((Tk_Cursor *) ptr)); + *((Tk_Cursor *) ptr) = None; + } + } + } +} diff --git a/generic/tkOption.c b/generic/tkOption.c index 9b7e17d..689723e 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -6,12 +6,12 @@ * with windows either by name or by class or both. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkOption.c,v 1.2 1998/09/14 18:23:15 stanton Exp $ + * RCS: @(#) $Id: tkOption.c,v 1.3 1999/04/16 01:51:20 stanton Exp $ */ #include "tkPort.h" @@ -141,13 +141,6 @@ typedef struct ElArray { */ #define NUM_STACKS 8 -static ElArray *stacks[NUM_STACKS]; -static TkWindow *cachedWindow = NULL; /* Lowest-level window currently - * loaded in stacks at present. - * NULL means stacks have never - * been used, or have been - * invalidated because of a change - * to the database. */ /* * One of the following structures is used to keep track of each @@ -163,33 +156,41 @@ typedef struct StackLevel { * fields when popping out of a level. */ } StackLevel; -/* - * Information about all of the stack levels that are currently - * active. This array grows dynamically to become as large as needed. - */ +typedef struct ThreadSpecificData { + int initialized; /* 0 means the ThreadSpecific Data structure + * for the current thread needs to be + * initialized. */ + ElArray *stacks[NUM_STACKS]; + TkWindow *cachedWindow; + /* Lowest-level window currently + * loaded in stacks at present. + * NULL means stacks have never + * been used, or have been + * invalidated because of a change + * to the database. */ + /* + * Information about all of the stack levels that are currently + * active. This array grows dynamically to become as large as needed. + */ -static StackLevel *levels = NULL; - /* Array describing current stack. */ -static int numLevels = 0; /* Total space allocated. */ -static int curLevel = -1; /* Highest level currently in use. Note: + StackLevel *levels; /* Array describing current stack. */ + int numLevels; /* Total space allocated. */ + int curLevel; /* Highest level currently in use. Note: * curLevel is never 0! (I don't remember * why anymore...) */ + /* + * The variable below is a serial number for all options entered into + * the database so far. It increments on each addition to the option + * database. It is used in computing option priorities, so that the + * most recent entry wins when choosing between options at the same + * priority level. + */ -/* - * The variable below is a serial number for all options entered into - * the database so far. It increments on each addition to the option - * database. It is used in computing option priorities, so that the - * most recent entry wins when choosing between options at the same - * priority level. - */ - -static int serial = 0; - -/* - * Special "no match" Element to use as default for searches. - */ - -static Element defaultMatch; + int serial; + Element defaultMatch; /* Special "no match" Element to use as + * default for searches.*/ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations for procedures defined in this file: @@ -248,11 +249,13 @@ Tk_AddOption(tkwin, name, value, priority) int count, firstField, length; #define TMP_SIZE 100 char tmp[TMP_SIZE+1]; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->mainPtr->optionRootPtr == NULL) { OptionInit(winPtr->mainPtr); } - cachedWindow = NULL; /* Invalidate the cache. */ + tsdPtr->cachedWindow = NULL; /* Invalidate the cache. */ /* * Compute the priority for the new element, including both the @@ -265,8 +268,8 @@ Tk_AddOption(tkwin, name, value, priority) } else if (priority > TK_MAX_PRIO) { priority = TK_MAX_PRIO; } - newEl.priority = (priority << 24) + serial; - serial++; + newEl.priority = (priority << 24) + tsdPtr->serial; + tsdPtr->serial++; /* * Parse the option one field at a time. @@ -396,28 +399,30 @@ Tk_GetOption(tkwin, name, className) Tk_Uid nameId, classId; register Element *elPtr, *bestPtr; register int count; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Note: no need to call OptionInit here: it will be done by * the SetupStacks call below (squeeze out those nanoseconds). */ - if (tkwin != (Tk_Window) cachedWindow) { + if (tkwin != (Tk_Window) tsdPtr->cachedWindow) { SetupStacks((TkWindow *) tkwin, 1); } nameId = Tk_GetUid(name); - bestPtr = &defaultMatch; - for (elPtr = stacks[EXACT_LEAF_NAME]->els, - count = stacks[EXACT_LEAF_NAME]->numUsed; count > 0; + bestPtr = &tsdPtr->defaultMatch; + for (elPtr = tsdPtr->stacks[EXACT_LEAF_NAME]->els, + count = tsdPtr->stacks[EXACT_LEAF_NAME]->numUsed; count > 0; elPtr++, count--) { if ((elPtr->nameUid == nameId) && (elPtr->priority > bestPtr->priority)) { bestPtr = elPtr; } } - for (elPtr = stacks[WILDCARD_LEAF_NAME]->els, - count = stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0; + for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_NAME]->els, + count = tsdPtr->stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0; elPtr++, count--) { if ((elPtr->nameUid == nameId) && (elPtr->priority > bestPtr->priority)) { @@ -426,17 +431,17 @@ Tk_GetOption(tkwin, name, className) } if (className != NULL) { classId = Tk_GetUid(className); - for (elPtr = stacks[EXACT_LEAF_CLASS]->els, - count = stacks[EXACT_LEAF_CLASS]->numUsed; count > 0; + for (elPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]->els, + count = tsdPtr->stacks[EXACT_LEAF_CLASS]->numUsed; count > 0; elPtr++, count--) { if ((elPtr->nameUid == classId) && (elPtr->priority > bestPtr->priority)) { bestPtr = elPtr; } } - for (elPtr = stacks[WILDCARD_LEAF_CLASS]->els, - count = stacks[WILDCARD_LEAF_CLASS]->numUsed; count > 0; - elPtr++, count--) { + for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->els, + count = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->numUsed; + count > 0; elPtr++, count--) { if ((elPtr->nameUid == classId) && (elPtr->priority > bestPtr->priority)) { bestPtr = elPtr; @@ -474,6 +479,8 @@ Tk_OptionCmd(clientData, interp, argc, argv) Tk_Window tkwin = (Tk_Window) clientData; size_t length; char c; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -513,7 +520,7 @@ Tk_OptionCmd(clientData, interp, argc, argv) ClearOptionTree(mainPtr->optionRootPtr); mainPtr->optionRootPtr = NULL; } - cachedWindow = NULL; + tsdPtr->cachedWindow = NULL; return TCL_OK; } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { Tk_Window window; @@ -530,7 +537,7 @@ Tk_OptionCmd(clientData, interp, argc, argv) } value = Tk_GetOption(window, argv[3], argv[4]); if (value != NULL) { - interp->result = value; + Tcl_SetResult(interp, value, TCL_STATIC); } return TCL_OK; } else if ((c == 'r') && (strncmp(argv[1], "readfile", length) == 0)) { @@ -581,6 +588,9 @@ void TkOptionDeadWindow(winPtr) register TkWindow *winPtr; /* Window to be cleaned up. */ { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + /* * If this window is in the option stacks, then clear the stacks. */ @@ -588,11 +598,11 @@ TkOptionDeadWindow(winPtr) if (winPtr->optionLevel != -1) { int i; - for (i = 1; i <= curLevel; i++) { - levels[i].winPtr->optionLevel = -1; + for (i = 1; i <= tsdPtr->curLevel; i++) { + tsdPtr->levels[i].winPtr->optionLevel = -1; } - curLevel = -1; - cachedWindow = NULL; + tsdPtr->curLevel = -1; + tsdPtr->cachedWindow = NULL; } /* @@ -632,6 +642,8 @@ TkOptionClassChanged(winPtr) { int i, j, *basePtr; ElArray *arrayPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->optionLevel == -1) { return; @@ -642,22 +654,22 @@ TkOptionClassChanged(winPtr) * flush all of the levels above the matching one. */ - for (i = 1; i <= curLevel; i++) { - if (levels[i].winPtr == winPtr) { - for (j = i; j <= curLevel; j++) { - levels[j].winPtr->optionLevel = -1; + for (i = 1; i <= tsdPtr->curLevel; i++) { + if (tsdPtr->levels[i].winPtr == winPtr) { + for (j = i; j <= tsdPtr->curLevel; j++) { + tsdPtr->levels[j].winPtr->optionLevel = -1; } - curLevel = i-1; - basePtr = levels[i].bases; + tsdPtr->curLevel = i-1; + basePtr = tsdPtr->levels[i].bases; for (j = 0; j < NUM_STACKS; j++) { - arrayPtr = stacks[j]; + arrayPtr = tsdPtr->stacks[j]; arrayPtr->numUsed = basePtr[j]; arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed]; } - if (curLevel <= 0) { - cachedWindow = NULL; + if (tsdPtr->curLevel <= 0) { + tsdPtr->cachedWindow = NULL; } else { - cachedWindow = levels[curLevel].winPtr; + tsdPtr->cachedWindow = tsdPtr->levels[tsdPtr->curLevel].winPtr; } break; } @@ -674,7 +686,7 @@ TkOptionClassChanged(winPtr) * Results: * The return value is the integer priority level corresponding * to string, or -1 if string doesn't point to a valid priority level. - * In this case, an error message is left in interp->result. + * In this case, an error message is left in the interp's result. * * Side effects: * None. @@ -734,7 +746,7 @@ ParsePriority(interp, string) * Results: * The return value is a standard Tcl return code. In the case of * an error in parsing string, TCL_ERROR will be returned and an - * error message will be left in interp->result. The memory at + * error message will be left in the interp's result. The memory at * string is totally trashed by this procedure. If you care about * its contents, make a copy before calling here. * @@ -797,8 +809,10 @@ AddFromString(interp, tkwin, string, priority) dst = name = src; while (*src != ':') { if ((*src == '\0') || (*src == '\n')) { - sprintf(interp->result, "missing colon on line %d", - lineNum); + char buf[32 + TCL_INTEGER_SPACE]; + + sprintf(buf, "missing colon on line %d", lineNum); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } if ((src[0] == '\\') && (src[1] == '\n')) { @@ -830,7 +844,10 @@ AddFromString(interp, tkwin, string, priority) src++; } if (*src == '\0') { - sprintf(interp->result, "missing value on line %d", lineNum); + char buf[32 + TCL_INTEGER_SPACE]; + + sprintf(buf, "missing value on line %d", lineNum); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } @@ -842,8 +859,10 @@ AddFromString(interp, tkwin, string, priority) dst = value = src; while (*src != '\n') { if (*src == '\0') { - sprintf(interp->result, "missing newline on line %d", - lineNum); + char buf[32 + TCL_INTEGER_SPACE]; + + sprintf(buf, "missing newline on line %d", lineNum); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } if ((src[0] == '\\') && (src[1] == '\n')) { @@ -879,7 +898,7 @@ AddFromString(interp, tkwin, string, priority) * Results: * The return value is a standard Tcl return code. In the case of * an error in parsing string, TCL_ERROR will be returned and an - * error message will be left in interp->result. + * error message will be left in the interp's result. * * Side effects: * None. @@ -1062,6 +1081,8 @@ SetupStacks(winPtr, leaf) int level, i, *iPtr; register StackLevel *levelPtr; register ElArray *arrayPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * The following array defines the order in which the current @@ -1086,7 +1107,7 @@ SetupStacks(winPtr, leaf) if (winPtr->parentPtr != NULL) { level = winPtr->parentPtr->optionLevel; - if ((level == -1) || (cachedWindow == NULL)) { + if ((level == -1) || (tsdPtr->cachedWindow == NULL)) { SetupStacks(winPtr->parentPtr, 0); level = winPtr->parentPtr->optionLevel; } @@ -1100,19 +1121,19 @@ SetupStacks(winPtr, leaf) * mark those windows as no longer having cached information. */ - if (curLevel >= level) { - while (curLevel >= level) { - levels[curLevel].winPtr->optionLevel = -1; - curLevel--; + if (tsdPtr->curLevel >= level) { + while (tsdPtr->curLevel >= level) { + tsdPtr->levels[tsdPtr->curLevel].winPtr->optionLevel = -1; + tsdPtr->curLevel--; } - levelPtr = &levels[level]; + levelPtr = &tsdPtr->levels[level]; for (i = 0; i < NUM_STACKS; i++) { - arrayPtr = stacks[i]; + arrayPtr = tsdPtr->stacks[i]; arrayPtr->numUsed = levelPtr->bases[i]; arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed]; } } - curLevel = winPtr->optionLevel = level; + tsdPtr->curLevel = winPtr->optionLevel = level; /* * Step 3: if the root database information isn't loaded or @@ -1120,11 +1141,11 @@ SetupStacks(winPtr, leaf) * database root (this only happens if winPtr is a main window). */ - if ((curLevel == 1) - && ((cachedWindow == NULL) - || (cachedWindow->mainPtr != winPtr->mainPtr))) { + if ((tsdPtr->curLevel == 1) + && ((tsdPtr->cachedWindow == NULL) + || (tsdPtr->cachedWindow->mainPtr != winPtr->mainPtr))) { for (i = 0; i < NUM_STACKS; i++) { - arrayPtr = stacks[i]; + arrayPtr = tsdPtr->stacks[i]; arrayPtr->numUsed = 0; arrayPtr->nextToUse = arrayPtr->els; } @@ -1138,33 +1159,41 @@ SetupStacks(winPtr, leaf) * any more). */ - if (curLevel >= numLevels) { + if (tsdPtr->curLevel >= tsdPtr->numLevels) { StackLevel *newLevels; newLevels = (StackLevel *) ckalloc((unsigned) - (numLevels*2*sizeof(StackLevel))); - memcpy((VOID *) newLevels, (VOID *) levels, - (numLevels*sizeof(StackLevel))); - ckfree((char *) levels); - numLevels *= 2; - levels = newLevels; + (tsdPtr->numLevels*2*sizeof(StackLevel))); + memcpy((VOID *) newLevels, (VOID *) tsdPtr->levels, + (tsdPtr->numLevels*sizeof(StackLevel))); + ckfree((char *) tsdPtr->levels); + tsdPtr->numLevels *= 2; + tsdPtr->levels = newLevels; } - levelPtr = &levels[curLevel]; + levelPtr = &tsdPtr->levels[tsdPtr->curLevel]; levelPtr->winPtr = winPtr; - arrayPtr = stacks[EXACT_LEAF_NAME]; + arrayPtr = tsdPtr->stacks[EXACT_LEAF_NAME]; arrayPtr->numUsed = 0; arrayPtr->nextToUse = arrayPtr->els; - arrayPtr = stacks[EXACT_LEAF_CLASS]; + arrayPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]; arrayPtr->numUsed = 0; arrayPtr->nextToUse = arrayPtr->els; - levelPtr->bases[EXACT_LEAF_NAME] = stacks[EXACT_LEAF_NAME]->numUsed; - levelPtr->bases[EXACT_LEAF_CLASS] = stacks[EXACT_LEAF_CLASS]->numUsed; - levelPtr->bases[EXACT_NODE_NAME] = stacks[EXACT_NODE_NAME]->numUsed; - levelPtr->bases[EXACT_NODE_CLASS] = stacks[EXACT_NODE_CLASS]->numUsed; - levelPtr->bases[WILDCARD_LEAF_NAME] = stacks[WILDCARD_LEAF_NAME]->numUsed; - levelPtr->bases[WILDCARD_LEAF_CLASS] = stacks[WILDCARD_LEAF_CLASS]->numUsed; - levelPtr->bases[WILDCARD_NODE_NAME] = stacks[WILDCARD_NODE_NAME]->numUsed; - levelPtr->bases[WILDCARD_NODE_CLASS] = stacks[WILDCARD_NODE_CLASS]->numUsed; + levelPtr->bases[EXACT_LEAF_NAME] = tsdPtr->stacks[EXACT_LEAF_NAME] + ->numUsed; + levelPtr->bases[EXACT_LEAF_CLASS] = tsdPtr->stacks[EXACT_LEAF_CLASS] + ->numUsed; + levelPtr->bases[EXACT_NODE_NAME] = tsdPtr->stacks[EXACT_NODE_NAME] + ->numUsed; + levelPtr->bases[EXACT_NODE_CLASS] = tsdPtr->stacks[EXACT_NODE_CLASS] + ->numUsed; + levelPtr->bases[WILDCARD_LEAF_NAME] = tsdPtr->stacks[WILDCARD_LEAF_NAME] + ->numUsed; + levelPtr->bases[WILDCARD_LEAF_CLASS] = tsdPtr->stacks[WILDCARD_LEAF_CLASS] + ->numUsed; + levelPtr->bases[WILDCARD_NODE_NAME] = tsdPtr->stacks[WILDCARD_NODE_NAME] + ->numUsed; + levelPtr->bases[WILDCARD_NODE_CLASS] = tsdPtr->stacks[WILDCARD_NODE_CLASS] + ->numUsed; /* @@ -1184,7 +1213,7 @@ SetupStacks(winPtr, leaf) } else { id = winPtr->nameUid; } - elPtr = stacks[i]->els; + elPtr = tsdPtr->stacks[i]->els; count = levelPtr->bases[i]; /* @@ -1203,7 +1232,7 @@ SetupStacks(winPtr, leaf) ExtendStacks(elPtr->child.arrayPtr, leaf); } } - cachedWindow = winPtr; + tsdPtr->cachedWindow = winPtr; } /* @@ -1232,13 +1261,16 @@ ExtendStacks(arrayPtr, leaf) { register int count; register Element *elPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (elPtr = arrayPtr->els, count = arrayPtr->numUsed; count > 0; elPtr++, count--) { if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) { continue; } - stacks[elPtr->flags] = ExtendArray(stacks[elPtr->flags], elPtr); + tsdPtr->stacks[elPtr->flags] = ExtendArray( + tsdPtr->stacks[elPtr->flags], elPtr); } } @@ -1266,24 +1298,32 @@ OptionInit(mainPtr) { int i; Tcl_Interp *interp; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Element *defaultMatchPtr = &tsdPtr->defaultMatch; /* * First, once-only initialization. */ - - if (numLevels == 0) { - - numLevels = 5; - levels = (StackLevel *) ckalloc((unsigned) (5*sizeof(StackLevel))); + + if (tsdPtr->initialized == 0) { + tsdPtr->initialized = 1; + tsdPtr->cachedWindow = NULL; + tsdPtr->numLevels = 5; + tsdPtr->curLevel = -1; + tsdPtr->serial = 0; + + tsdPtr->levels = (StackLevel *) ckalloc((unsigned) + (5*sizeof(StackLevel))); for (i = 0; i < NUM_STACKS; i++) { - stacks[i] = NewArray(10); - levels[0].bases[i] = 0; + tsdPtr->stacks[i] = NewArray(10); + tsdPtr->levels[0].bases[i] = 0; } - defaultMatch.nameUid = NULL; - defaultMatch.child.valueUid = NULL; - defaultMatch.priority = -1; - defaultMatch.flags = 0; + defaultMatchPtr->nameUid = NULL; + defaultMatchPtr->child.valueUid = NULL; + defaultMatchPtr->priority = -1; + defaultMatchPtr->flags = 0; } /* diff --git a/generic/tkPack.c b/generic/tkPack.c index 380315a..20a8a23 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -5,12 +5,12 @@ * geometry manager for Tk. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkPack.c,v 1.2 1998/09/14 18:23:15 stanton Exp $ + * RCS: @(#) $Id: tkPack.c,v 1.3 1999/04/16 01:51:20 stanton Exp $ */ #include "tkPort.h" @@ -96,19 +96,6 @@ typedef struct Packer { #define DONT_PROPAGATE 32 /* - * Hash table used to map from Tk_Window tokens to corresponding - * Packer structures: - */ - -static Tcl_HashTable packerHashTable; - -/* - * Have statics in this module been initialized? - */ - -static int initialized = 0; - -/* * The following structure is the official type record for the * packer: */ @@ -281,7 +268,7 @@ Tk_PackCmd(clientData, interp, argc, argv) } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) { register Packer *slavePtr; Tk_Window slave; - char buffer[300]; + char buffer[64 + TCL_INTEGER_SPACE * 4]; static char *sideNames[] = {"top", "bottom", "left", "right"}; if (argc != 3) { @@ -342,9 +329,9 @@ Tk_PackCmd(clientData, interp, argc, argv) masterPtr = GetPacker(master); if (argc == 3) { if (masterPtr->flags & DONT_PROPAGATE) { - interp->result = "0"; + Tcl_SetResult(interp, "0", TCL_STATIC); } else { - interp->result = "1"; + Tcl_SetResult(interp, "1", TCL_STATIC); } return TCL_OK; } @@ -957,10 +944,11 @@ GetPacker(tkwin) register Packer *packPtr; Tcl_HashEntry *hPtr; int new; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - initialized = 1; - Tcl_InitHashTable(&packerHashTable, TCL_ONE_WORD_KEYS); + if (!dispPtr->packInit) { + dispPtr->packInit = 1; + Tcl_InitHashTable(&dispPtr->packerHashTable, TCL_ONE_WORD_KEYS); } /* @@ -968,7 +956,8 @@ GetPacker(tkwin) * then create a new one. */ - hPtr = Tcl_CreateHashEntry(&packerHashTable, (char *) tkwin, &new); + hPtr = Tcl_CreateHashEntry(&dispPtr->packerHashTable, (char *) tkwin, + &new); if (!new) { return (Packer *) Tcl_GetHashValue(hPtr); } @@ -1324,6 +1313,8 @@ PackStructureProc(clientData, eventPtr) XEvent *eventPtr; /* Describes what just happened. */ { register Packer *packPtr = (Packer *) clientData; + TkDisplay *dispPtr; + if (eventPtr->type == ConfigureNotify) { if ((packPtr->slavePtr != NULL) && !(packPtr->flags & REQUESTED_REPACK)) { @@ -1353,8 +1344,11 @@ PackStructureProc(clientData, eventPtr) nextPtr = slavePtr->nextPtr; slavePtr->nextPtr = NULL; } - Tcl_DeleteHashEntry(Tcl_FindHashEntry(&packerHashTable, - (char *) packPtr->tkwin)); + if (packPtr->tkwin != NULL) { + dispPtr = ((TkWindow *) packPtr->tkwin)->dispPtr; + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->packerHashTable, + (char *) packPtr->tkwin)); + } if (packPtr->flags & REQUESTED_REPACK) { Tcl_CancelIdleCall(ArrangePacking, (ClientData) packPtr); } @@ -1398,7 +1392,7 @@ PackStructureProc(clientData, eventPtr) * * Results: * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is - * returned and interp->result is set to contain an error message. + * returned and the interp's result is set to contain an error message. * * Side effects: * Slave windows get taken over by the packer. diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 4e3784d..6fa2e46 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -5,12 +5,12 @@ * for Tk based on absolute placement or "rubber-sheet" placement. * * Copyright (c) 1992-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkPlace.c,v 1.2 1998/09/14 18:23:15 stanton Exp $ + * RCS: @(#) $Id: tkPlace.c,v 1.3 1999/04/16 01:51:20 stanton Exp $ */ #include "tkPort.h" @@ -99,15 +99,6 @@ typedef struct Master { #define PARENT_RECONFIG_PENDING 1 /* - * The hash tables below both use Tk_Window tokens as keys. They map - * from Tk_Windows to Slave and Master structures for windows, if they - * exist. - */ - -static int initialized = 0; -static Tcl_HashTable masterTable; -static Tcl_HashTable slaveTable; -/* * The following structure is the official type record for the * placer: */ @@ -168,15 +159,18 @@ Tk_PlaceCmd(clientData, interp, argc, argv) Tcl_HashEntry *hPtr; size_t length; int c; + TkDisplay *dispPtr; + + dispPtr = ((TkWindow *) clientData)->dispPtr; /* * Initialize, if that hasn't been done yet. */ - if (!initialized) { - Tcl_InitHashTable(&masterTable, TCL_ONE_WORD_KEYS); - Tcl_InitHashTable(&slaveTable, TCL_ONE_WORD_KEYS); - initialized = 1; + if (!dispPtr->placeInit) { + Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS); + dispPtr->placeInit = 1; } if (argc < 3) { @@ -225,7 +219,7 @@ Tk_PlaceCmd(clientData, interp, argc, argv) argv[0], " forget pathName\"", (char *) NULL); return TCL_ERROR; } - hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin); + hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin); if (hPtr == NULL) { return TCL_OK; } @@ -243,14 +237,14 @@ Tk_PlaceCmd(clientData, interp, argc, argv) Tk_UnmapWindow(tkwin); ckfree((char *) slavePtr); } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) { - char buffer[50]; + char buffer[32 + TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " info pathName\"", (char *) NULL); return TCL_ERROR; } - hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin); + hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin); if (hPtr == NULL) { return TCL_OK; } @@ -306,7 +300,7 @@ Tk_PlaceCmd(clientData, interp, argc, argv) argv[0], " slaves pathName\"", (char *) NULL); return TCL_ERROR; } - hPtr = Tcl_FindHashEntry(&masterTable, (char *) tkwin); + hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin); if (hPtr != NULL) { Master *masterPtr; masterPtr = (Master *) Tcl_GetHashValue(hPtr); @@ -348,8 +342,9 @@ FindSlave(tkwin) Tcl_HashEntry *hPtr; register Slave *slavePtr; int new; + TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr; - hPtr = Tcl_CreateHashEntry(&slaveTable, (char *) tkwin, &new); + hPtr = Tcl_CreateHashEntry(&dispPtr->slaveTable, (char *) tkwin, &new); if (new) { slavePtr = (Slave *) ckalloc(sizeof(Slave)); slavePtr->tkwin = tkwin; @@ -441,8 +436,9 @@ FindMaster(tkwin) Tcl_HashEntry *hPtr; register Master *masterPtr; int new; + TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr; - hPtr = Tcl_CreateHashEntry(&masterTable, (char *) tkwin, &new); + hPtr = Tcl_CreateHashEntry(&dispPtr->masterTable, (char *) tkwin, &new); if (new) { masterPtr = (Master *) ckalloc(sizeof(Master)); masterPtr->tkwin = tkwin; @@ -467,7 +463,7 @@ FindMaster(tkwin) * * Results: * A standard Tcl result. If an error occurs then a message is - * left in interp->result. + * left in the interp's result. * * Side effects: * Information in slavePtr may change, and slavePtr's master is @@ -902,6 +898,7 @@ MasterStructureProc(clientData, eventPtr) { register Master *masterPtr = (Master *) clientData; register Slave *slavePtr, *nextPtr; + TkDisplay *dispPtr = ((TkWindow *) masterPtr->tkwin)->dispPtr; if (eventPtr->type == ConfigureNotify) { if ((masterPtr->slavePtr != NULL) @@ -916,7 +913,7 @@ MasterStructureProc(clientData, eventPtr) nextPtr = slavePtr->nextPtr; slavePtr->nextPtr = NULL; } - Tcl_DeleteHashEntry(Tcl_FindHashEntry(&masterTable, + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->masterTable, (char *) masterPtr->tkwin)); if (masterPtr->flags & PARENT_RECONFIG_PENDING) { Tcl_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr); @@ -971,10 +968,11 @@ SlaveStructureProc(clientData, eventPtr) XEvent *eventPtr; /* Describes what just happened. */ { register Slave *slavePtr = (Slave *) clientData; + TkDisplay * dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr; if (eventPtr->type == DestroyNotify) { UnlinkSlave(slavePtr); - Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable, + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) slavePtr->tkwin)); ckfree((char *) slavePtr); } @@ -1047,13 +1045,15 @@ PlaceLostSlaveProc(clientData, tkwin) Tk_Window tkwin; /* Tk's handle for the slave window. */ { register Slave *slavePtr = (Slave *) clientData; + TkDisplay * dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr; if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin); } Tk_UnmapWindow(tkwin); UnlinkSlave(slavePtr); - Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable, (char *) tkwin)); + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable, + (char *) tkwin)); Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc, (ClientData) slavePtr); ckfree((char *) slavePtr); diff --git a/generic/tkPlatDecls.h b/generic/tkPlatDecls.h index 37714d2..e0dd331 100644 --- a/generic/tkPlatDecls.h +++ b/generic/tkPlatDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkPlatDecls.h,v 1.2 1999/03/10 07:04:42 stanton Exp $ + * RCS: @(#) $Id: tkPlatDecls.h,v 1.3 1999/04/16 01:51:21 stanton Exp $ */ #ifndef _TKPLATDECLS @@ -121,74 +121,74 @@ extern TkPlatStubs *tkPlatStubsPtr; #ifdef __WIN32__ #ifndef Tk_AttachHWND -#define Tk_AttachHWND(tkwin, hwnd) \ - (tkPlatStubsPtr->tk_AttachHWND)(tkwin, hwnd) /* 0 */ +#define Tk_AttachHWND \ + (tkPlatStubsPtr->tk_AttachHWND) /* 0 */ #endif #ifndef Tk_GetHINSTANCE -#define Tk_GetHINSTANCE() \ - (tkPlatStubsPtr->tk_GetHINSTANCE)() /* 1 */ +#define Tk_GetHINSTANCE \ + (tkPlatStubsPtr->tk_GetHINSTANCE) /* 1 */ #endif #ifndef Tk_GetHWND -#define Tk_GetHWND(window) \ - (tkPlatStubsPtr->tk_GetHWND)(window) /* 2 */ +#define Tk_GetHWND \ + (tkPlatStubsPtr->tk_GetHWND) /* 2 */ #endif #ifndef Tk_HWNDToWindow -#define Tk_HWNDToWindow(hwnd) \ - (tkPlatStubsPtr->tk_HWNDToWindow)(hwnd) /* 3 */ +#define Tk_HWNDToWindow \ + (tkPlatStubsPtr->tk_HWNDToWindow) /* 3 */ #endif #ifndef Tk_PointerEvent -#define Tk_PointerEvent(hwnd, x, y) \ - (tkPlatStubsPtr->tk_PointerEvent)(hwnd, x, y) /* 4 */ +#define Tk_PointerEvent \ + (tkPlatStubsPtr->tk_PointerEvent) /* 4 */ #endif #ifndef Tk_TranslateWinEvent -#define Tk_TranslateWinEvent(hwnd, message, wParam, lParam, result) \ - (tkPlatStubsPtr->tk_TranslateWinEvent)(hwnd, message, wParam, lParam, result) /* 5 */ +#define Tk_TranslateWinEvent \ + (tkPlatStubsPtr->tk_TranslateWinEvent) /* 5 */ #endif #endif /* __WIN32__ */ #ifdef MAC_TCL #ifndef Tk_MacSetEmbedHandler -#define Tk_MacSetEmbedHandler(registerWinProcPtr, getPortProcPtr, containerExistProcPtr, getClipProc, getOffsetProc) \ - (tkPlatStubsPtr->tk_MacSetEmbedHandler)(registerWinProcPtr, getPortProcPtr, containerExistProcPtr, getClipProc, getOffsetProc) /* 0 */ +#define Tk_MacSetEmbedHandler \ + (tkPlatStubsPtr->tk_MacSetEmbedHandler) /* 0 */ #endif #ifndef Tk_MacTurnOffMenus -#define Tk_MacTurnOffMenus() \ - (tkPlatStubsPtr->tk_MacTurnOffMenus)() /* 1 */ +#define Tk_MacTurnOffMenus \ + (tkPlatStubsPtr->tk_MacTurnOffMenus) /* 1 */ #endif #ifndef Tk_MacTkOwnsCursor -#define Tk_MacTkOwnsCursor(tkOwnsIt) \ - (tkPlatStubsPtr->tk_MacTkOwnsCursor)(tkOwnsIt) /* 2 */ +#define Tk_MacTkOwnsCursor \ + (tkPlatStubsPtr->tk_MacTkOwnsCursor) /* 2 */ #endif #ifndef TkMacInitMenus -#define TkMacInitMenus(interp) \ - (tkPlatStubsPtr->tkMacInitMenus)(interp) /* 3 */ +#define TkMacInitMenus \ + (tkPlatStubsPtr->tkMacInitMenus) /* 3 */ #endif #ifndef TkMacInitAppleEvents -#define TkMacInitAppleEvents(interp) \ - (tkPlatStubsPtr->tkMacInitAppleEvents)(interp) /* 4 */ +#define TkMacInitAppleEvents \ + (tkPlatStubsPtr->tkMacInitAppleEvents) /* 4 */ #endif #ifndef TkMacConvertEvent -#define TkMacConvertEvent(eventPtr) \ - (tkPlatStubsPtr->tkMacConvertEvent)(eventPtr) /* 5 */ +#define TkMacConvertEvent \ + (tkPlatStubsPtr->tkMacConvertEvent) /* 5 */ #endif #ifndef TkMacConvertTkEvent -#define TkMacConvertTkEvent(eventPtr, window) \ - (tkPlatStubsPtr->tkMacConvertTkEvent)(eventPtr, window) /* 6 */ +#define TkMacConvertTkEvent \ + (tkPlatStubsPtr->tkMacConvertTkEvent) /* 6 */ #endif #ifndef TkGenWMConfigureEvent -#define TkGenWMConfigureEvent(tkwin, x, y, width, height, flags) \ - (tkPlatStubsPtr->tkGenWMConfigureEvent)(tkwin, x, y, width, height, flags) /* 7 */ +#define TkGenWMConfigureEvent \ + (tkPlatStubsPtr->tkGenWMConfigureEvent) /* 7 */ #endif #ifndef TkMacInvalClipRgns -#define TkMacInvalClipRgns(winPtr) \ - (tkPlatStubsPtr->tkMacInvalClipRgns)(winPtr) /* 8 */ +#define TkMacInvalClipRgns \ + (tkPlatStubsPtr->tkMacInvalClipRgns) /* 8 */ #endif #ifndef TkMacHaveAppearance -#define TkMacHaveAppearance() \ - (tkPlatStubsPtr->tkMacHaveAppearance)() /* 9 */ +#define TkMacHaveAppearance \ + (tkPlatStubsPtr->tkMacHaveAppearance) /* 9 */ #endif #ifndef TkMacGetDrawablePort -#define TkMacGetDrawablePort(drawable) \ - (tkPlatStubsPtr->tkMacGetDrawablePort)(drawable) /* 10 */ +#define TkMacGetDrawablePort \ + (tkPlatStubsPtr->tkMacGetDrawablePort) /* 10 */ #endif #endif /* MAC_TCL */ diff --git a/generic/tkPlatStubs.c b/generic/tkPlatStubs.c deleted file mode 100644 index f58d8ed..0000000 --- a/generic/tkPlatStubs.c +++ /dev/null @@ -1,186 +0,0 @@ -/* - * tkPlatStubs.c -- - * - * This file contains the wrapper functions for the platform independent - * unsupported Tk API. - * - * Copyright (c) 1998-1999 by Scriptics Corporation. - * All rights reserved. - * - * RCS: @(#) $Id: tkPlatStubs.c,v 1.2 1999/03/10 07:04:42 stanton Exp $ - */ - -#include "tk.h" - -#ifdef __WIN32__ -#include "tkWinInt.h" -#endif - -/* - * WARNING: This file is automatically generated by the tools/genStubs.tcl - * script. Any modifications to the function declarations below should be made - * in the generic/tk.decls script. - */ - -/* !BEGIN!: Do not edit below this line. */ - -/* - * Exported stub functions: - */ - -#ifdef __WIN32__ -/* Slot 0 */ -Window -Tk_AttachHWND(tkwin, hwnd) - Tk_Window tkwin; - HWND hwnd; -{ - return (tkPlatStubsPtr->tk_AttachHWND)(tkwin, hwnd); -} - -/* Slot 1 */ -HINSTANCE -Tk_GetHINSTANCE() -{ - return (tkPlatStubsPtr->tk_GetHINSTANCE)(); -} - -/* Slot 2 */ -HWND -Tk_GetHWND(window) - Window window; -{ - return (tkPlatStubsPtr->tk_GetHWND)(window); -} - -/* Slot 3 */ -Tk_Window -Tk_HWNDToWindow(hwnd) - HWND hwnd; -{ - return (tkPlatStubsPtr->tk_HWNDToWindow)(hwnd); -} - -/* Slot 4 */ -void -Tk_PointerEvent(hwnd, x, y) - HWND hwnd; - int x; - int y; -{ - (tkPlatStubsPtr->tk_PointerEvent)(hwnd, x, y); -} - -/* Slot 5 */ -int -Tk_TranslateWinEvent(hwnd, message, wParam, lParam, result) - HWND hwnd; - UINT message; - WPARAM wParam; - LPARAM lParam; - LRESULT * result; -{ - return (tkPlatStubsPtr->tk_TranslateWinEvent)(hwnd, message, wParam, lParam, result); -} - -#endif /* __WIN32__ */ -#ifdef MAC_TCL -/* Slot 0 */ -void -Tk_MacSetEmbedHandler(registerWinProcPtr, getPortProcPtr, containerExistProcPtr, getClipProc, getOffsetProc) - Tk_MacEmbedRegisterWinProc * registerWinProcPtr; - Tk_MacEmbedGetGrafPortProc * getPortProcPtr; - Tk_MacEmbedMakeContainerExistProc * containerExistProcPtr; - Tk_MacEmbedGetClipProc * getClipProc; - Tk_MacEmbedGetOffsetInParentProc * getOffsetProc; -{ - (tkPlatStubsPtr->tk_MacSetEmbedHandler)(registerWinProcPtr, getPortProcPtr, containerExistProcPtr, getClipProc, getOffsetProc); -} - -/* Slot 1 */ -void -Tk_MacTurnOffMenus() -{ - (tkPlatStubsPtr->tk_MacTurnOffMenus)(); -} - -/* Slot 2 */ -void -Tk_MacTkOwnsCursor(tkOwnsIt) - int tkOwnsIt; -{ - (tkPlatStubsPtr->tk_MacTkOwnsCursor)(tkOwnsIt); -} - -/* Slot 3 */ -void -TkMacInitMenus(interp) - Tcl_Interp * interp; -{ - (tkPlatStubsPtr->tkMacInitMenus)(interp); -} - -/* Slot 4 */ -void -TkMacInitAppleEvents(interp) - Tcl_Interp * interp; -{ - (tkPlatStubsPtr->tkMacInitAppleEvents)(interp); -} - -/* Slot 5 */ -int -TkMacConvertEvent(eventPtr) - EventRecord * eventPtr; -{ - return (tkPlatStubsPtr->tkMacConvertEvent)(eventPtr); -} - -/* Slot 6 */ -int -TkMacConvertTkEvent(eventPtr, window) - EventRecord * eventPtr; - Window window; -{ - return (tkPlatStubsPtr->tkMacConvertTkEvent)(eventPtr, window); -} - -/* Slot 7 */ -void -TkGenWMConfigureEvent(tkwin, x, y, width, height, flags) - Tk_Window tkwin; - int x; - int y; - int width; - int height; - int flags; -{ - (tkPlatStubsPtr->tkGenWMConfigureEvent)(tkwin, x, y, width, height, flags); -} - -/* Slot 8 */ -void -TkMacInvalClipRgns(winPtr) - TkWindow * winPtr; -{ - (tkPlatStubsPtr->tkMacInvalClipRgns)(winPtr); -} - -/* Slot 9 */ -int -TkMacHaveAppearance() -{ - return (tkPlatStubsPtr->tkMacHaveAppearance)(); -} - -/* Slot 10 */ -GWorldPtr -TkMacGetDrawablePort(drawable) - Drawable drawable; -{ - return (tkPlatStubsPtr->tkMacGetDrawablePort)(drawable); -} - -#endif /* MAC_TCL */ - -/* !END!: Do not edit above this line. */ diff --git a/generic/tkPointer.c b/generic/tkPointer.c index 4b18d0b..d14074d 100644 --- a/generic/tkPointer.c +++ b/generic/tkPointer.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkPointer.c,v 1.3 1999/03/10 07:04:43 stanton Exp $ + * RCS: @(#) $Id: tkPointer.c,v 1.4 1999/04/16 01:51:21 stanton Exp $ */ #include "tkInt.h" @@ -36,19 +36,18 @@ static unsigned int buttonMasks[] = { }; #define ButtonMask(b) (buttonMasks[(b)-Button1]) -/* - * Declarations of static variables used in the pointer module. - */ - -static TkWindow *cursorWinPtr = NULL; /* Window that is currently - * controlling the global cursor. */ -static TkWindow *grabWinPtr = NULL; /* Window that defines the top of the +typedef struct ThreadSpecificData { + TkWindow *grabWinPtr; /* Window that defines the top of the * grab tree in a global grab. */ -static XPoint lastPos = { 0, 0}; /* Last reported mouse position. */ -static int lastState = 0; /* Last known state flags. */ -static TkWindow *lastWinPtr = NULL; /* Last reported mouse window. */ -static TkWindow *restrictWinPtr = NULL; /* Window to which all mouse events + int lastState; /* Last known state flags. */ + XPoint lastPos; /* Last reported mouse position. */ + TkWindow *lastWinPtr; /* Last reported mouse window. */ + TkWindow *restrictWinPtr; /* Window to which all mouse events * will be reported. */ + TkWindow *cursorWinPtr; /* Window that is currently + * controlling the global cursor. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations of procedures used in this file. @@ -141,8 +140,12 @@ GenerateEnterLeave(winPtr, x, y, state) int state; /* State flags. */ { int crossed = 0; /* 1 if mouse crossed a window boundary */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TkWindow *restrictWinPtr = tsdPtr->restrictWinPtr; + TkWindow *lastWinPtr = tsdPtr->lastWinPtr; - if (winPtr != lastWinPtr) { + if (winPtr != tsdPtr->lastWinPtr) { if (restrictWinPtr) { int newPos, oldPos; @@ -200,7 +203,7 @@ GenerateEnterLeave(winPtr, x, y, state) crossed = 1; } } - lastWinPtr = winPtr; + tsdPtr->lastWinPtr = winPtr; } return crossed; @@ -230,11 +233,13 @@ Tk_UpdatePointer(tkwin, x, y, state) int x, y; /* Pointer location in root coords. */ int state; /* Modifier state mask. */ { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); TkWindow *winPtr = (TkWindow *)tkwin; TkWindow *targetWinPtr; XPoint pos; XEvent event; - int changes = (state ^ lastState) & ALL_BUTTONS; + int changes = (state ^ tsdPtr->lastState) & ALL_BUTTONS; int type, b, mask; pos.x = x; @@ -245,7 +250,8 @@ Tk_UpdatePointer(tkwin, x, y, state) * state since we haven't generated the button events yet. */ - lastState = (state & ~ALL_BUTTONS) | (lastState & ALL_BUTTONS); + tsdPtr->lastState = (state & ~ALL_BUTTONS) | (tsdPtr->lastState + & ALL_BUTTONS); /* * Generate Enter/Leave events. If the pointer has crossed window @@ -253,8 +259,8 @@ Tk_UpdatePointer(tkwin, x, y, state) * redundant motion events. */ - if (GenerateEnterLeave(winPtr, x, y, lastState)) { - lastPos = pos; + if (GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState)) { + tsdPtr->lastPos = pos; } /* @@ -273,30 +279,30 @@ Tk_UpdatePointer(tkwin, x, y, state) * if this is the first button down. */ - if (!restrictWinPtr) { - if (!grabWinPtr) { + if (!tsdPtr->restrictWinPtr) { + if (!tsdPtr->grabWinPtr) { /* * Mouse is not grabbed, so set a button grab. */ - restrictWinPtr = winPtr; - TkpSetCapture(restrictWinPtr); + tsdPtr->restrictWinPtr = winPtr; + TkpSetCapture(tsdPtr->restrictWinPtr); - } else if ((lastState & ALL_BUTTONS) == 0) { + } else if ((tsdPtr->lastState & ALL_BUTTONS) == 0) { /* * Mouse is in a non-button grab, so ensure * the button grab is inside the grab tree. */ - if (TkPositionInTree(winPtr, grabWinPtr) + if (TkPositionInTree(winPtr, tsdPtr->grabWinPtr) == TK_GRAB_IN_TREE) { - restrictWinPtr = winPtr; + tsdPtr->restrictWinPtr = winPtr; } else { - restrictWinPtr = grabWinPtr; + tsdPtr->restrictWinPtr = tsdPtr->grabWinPtr; } - TkpSetCapture(restrictWinPtr); + TkpSetCapture(tsdPtr->restrictWinPtr); } } @@ -309,8 +315,8 @@ Tk_UpdatePointer(tkwin, x, y, state) * aren't in a global grab. */ - if ((lastState & ALL_BUTTONS) == mask) { - if (!grabWinPtr) { + if ((tsdPtr->lastState & ALL_BUTTONS) == mask) { + if (!tsdPtr->grabWinPtr) { TkpSetCapture(NULL); } } @@ -321,16 +327,16 @@ Tk_UpdatePointer(tkwin, x, y, state) * the restrict window to the current mouse position. */ - if (restrictWinPtr) { - InitializeEvent(&event, restrictWinPtr, type, x, y, - lastState, b); + if (tsdPtr->restrictWinPtr) { + InitializeEvent(&event, tsdPtr->restrictWinPtr, type, x, y, + tsdPtr->lastState, b); Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); - lastState &= ~mask; - lastWinPtr = restrictWinPtr; - restrictWinPtr = NULL; + tsdPtr->lastState &= ~mask; + tsdPtr->lastWinPtr = tsdPtr->restrictWinPtr; + tsdPtr->restrictWinPtr = NULL; - GenerateEnterLeave(winPtr, x, y, lastState); - lastPos = pos; + GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState); + tsdPtr->lastPos = pos; continue; } } @@ -342,10 +348,10 @@ Tk_UpdatePointer(tkwin, x, y, state) * managed by Tk should be reported to the grab window. */ - if (restrictWinPtr) { - targetWinPtr = restrictWinPtr; - } else if (grabWinPtr && !winPtr) { - targetWinPtr = grabWinPtr; + if (tsdPtr->restrictWinPtr) { + targetWinPtr = tsdPtr->restrictWinPtr; + } else if (tsdPtr->grabWinPtr && !winPtr) { + targetWinPtr = tsdPtr->grabWinPtr; } else { targetWinPtr = winPtr; } @@ -356,7 +362,7 @@ Tk_UpdatePointer(tkwin, x, y, state) if (winPtr != NULL) { InitializeEvent(&event, targetWinPtr, type, x, y, - lastState, b); + tsdPtr->lastState, b); Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); } @@ -364,9 +370,9 @@ Tk_UpdatePointer(tkwin, x, y, state) * Update the state for the next iteration. */ - lastState = (type == ButtonPress) - ? (lastState | mask) : (lastState & ~mask); - lastPos = pos; + tsdPtr->lastState = (type == ButtonPress) + ? (tsdPtr->lastState | mask) : (tsdPtr->lastState & ~mask); + tsdPtr->lastPos = pos; } } @@ -374,11 +380,11 @@ Tk_UpdatePointer(tkwin, x, y, state) * Make sure the cursor window is up to date. */ - if (restrictWinPtr) { - targetWinPtr = restrictWinPtr; - } else if (grabWinPtr) { - targetWinPtr = (TkPositionInTree(winPtr, grabWinPtr) - == TK_GRAB_IN_TREE) ? winPtr : grabWinPtr; + if (tsdPtr->restrictWinPtr) { + targetWinPtr = tsdPtr->restrictWinPtr; + } else if (tsdPtr->grabWinPtr) { + targetWinPtr = (TkPositionInTree(winPtr, tsdPtr->grabWinPtr) + == TK_GRAB_IN_TREE) ? winPtr : tsdPtr->grabWinPtr; } else { targetWinPtr = winPtr; } @@ -389,19 +395,19 @@ Tk_UpdatePointer(tkwin, x, y, state) * generate a motion event. */ - if (lastPos.x != pos.x || lastPos.y != pos.y) { - if (restrictWinPtr) { - targetWinPtr = restrictWinPtr; - } else if (grabWinPtr && !winPtr) { - targetWinPtr = grabWinPtr; + if (tsdPtr->lastPos.x != pos.x || tsdPtr->lastPos.y != pos.y) { + if (tsdPtr->restrictWinPtr) { + targetWinPtr = tsdPtr->restrictWinPtr; + } else if (tsdPtr->grabWinPtr && !winPtr) { + targetWinPtr = tsdPtr->grabWinPtr; } if (targetWinPtr != NULL) { InitializeEvent(&event, targetWinPtr, MotionNotify, x, y, - lastState, NotifyNormal); + tsdPtr->lastState, NotifyNormal); Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); } - lastPos = pos; + tsdPtr->lastPos = pos; } } @@ -437,12 +443,16 @@ XGrabPointer(display, grab_window, owner_events, event_mask, pointer_mode, Cursor cursor; Time time; { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + display->request++; - grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window); - restrictWinPtr = NULL; - TkpSetCapture(grabWinPtr); - if (TkPositionInTree(lastWinPtr, grabWinPtr) != TK_GRAB_IN_TREE) { - UpdateCursor(grabWinPtr); + tsdPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window); + tsdPtr->restrictWinPtr = NULL; + TkpSetCapture(tsdPtr->grabWinPtr); + if (TkPositionInTree(tsdPtr->lastWinPtr, tsdPtr->grabWinPtr) + != TK_GRAB_IN_TREE) { + UpdateCursor(tsdPtr->grabWinPtr); } return GrabSuccess; } @@ -468,11 +478,14 @@ XUngrabPointer(display, time) Display* display; Time time; { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + display->request++; - grabWinPtr = NULL; - restrictWinPtr = NULL; + tsdPtr->grabWinPtr = NULL; + tsdPtr->restrictWinPtr = NULL; TkpSetCapture(NULL); - UpdateCursor(lastWinPtr); + UpdateCursor(tsdPtr->lastWinPtr); } /* @@ -495,16 +508,19 @@ void TkPointerDeadWindow(winPtr) TkWindow *winPtr; { - if (winPtr == lastWinPtr) { - lastWinPtr = NULL; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (winPtr == tsdPtr->lastWinPtr) { + tsdPtr->lastWinPtr = NULL; } - if (winPtr == grabWinPtr) { - grabWinPtr = NULL; + if (winPtr == tsdPtr->grabWinPtr) { + tsdPtr->grabWinPtr = NULL; } - if (winPtr == restrictWinPtr) { - restrictWinPtr = NULL; + if (winPtr == tsdPtr->restrictWinPtr) { + tsdPtr->restrictWinPtr = NULL; } - if (!(restrictWinPtr || grabWinPtr)) { + if (!(tsdPtr->restrictWinPtr || tsdPtr->grabWinPtr)) { TkpSetCapture(NULL); } } @@ -531,6 +547,8 @@ UpdateCursor(winPtr) TkWindow *winPtr; { Cursor cursor = None; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * A window inherits its cursor from its parent if it doesn't @@ -538,7 +556,7 @@ UpdateCursor(winPtr) * cursor. */ - cursorWinPtr = winPtr; + tsdPtr->cursorWinPtr = winPtr; while (winPtr != NULL) { if (winPtr->atts.cursor != None) { cursor = winPtr->atts.cursor; @@ -577,8 +595,10 @@ XDefineCursor(display, w, cursor) Cursor cursor; { TkWindow *winPtr = (TkWindow *)Tk_IdToWindow(display, w); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (cursorWinPtr == winPtr) { + if (tsdPtr->cursorWinPtr == winPtr) { UpdateCursor(winPtr); } display->request++; diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index beba5a0..70556b4 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.c @@ -5,12 +5,12 @@ * widgets. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkRectOval.c,v 1.2 1998/09/14 18:23:16 stanton Exp $ + * RCS: @(#) $Id: tkRectOval.c,v 1.3 1999/04/16 01:51:21 stanton Exp $ */ #include <stdio.h> @@ -157,7 +157,7 @@ Tk_ItemType tkOvalType = { * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in - * interp->result; in this case itemPtr is left uninitialized, + * the interp's result; in this case itemPtr is left uninitialized, * so it can be safely freed by the caller. * * Side effects: @@ -230,7 +230,7 @@ CreateRectOval(interp, canvas, itemPtr, argc, argv) * for details on what it does. * * Results: - * Returns TCL_OK or TCL_ERROR, and sets interp->result. + * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. @@ -273,9 +273,10 @@ RectOvalCoords(interp, canvas, itemPtr, argc, argv) } ComputeRectOvalBbox(canvas, rectOvalPtr); } else { - sprintf(interp->result, - "wrong # coordinates: expected 0 or 4, got %d", - argc); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; @@ -292,7 +293,7 @@ RectOvalCoords(interp, canvas, itemPtr, argc, argv) * * Results: * A standard Tcl result code. If an error occurs, then - * an error message is left in interp->result. + * an error message is left in the interp's result. * * Side effects: * Configuration information, such as colors and stipple @@ -942,7 +943,7 @@ TranslateRectOval(canvas, itemPtr, deltaX, deltaY) * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is - * left in interp->result, replacing whatever used to be there. + * left in the interp's result, replacing whatever used to be there. * If no error occurs, then Postscript for the rectangle is * appended to the result. * @@ -962,7 +963,7 @@ RectOvalToPostscript(interp, canvas, itemPtr, prepass) * collect font information; 0 means * final Postscript is being created. */ { - char pathCmd[500], string[100]; + char pathCmd[500]; RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; double y1, y2; @@ -1016,6 +1017,8 @@ RectOvalToPostscript(interp, canvas, itemPtr, prepass) */ if (rectOvalPtr->outlineColor != NULL) { + char string[32 + TCL_INTEGER_SPACE]; + Tcl_AppendResult(interp, pathCmd, (char *) NULL); sprintf(string, "%d setlinewidth", rectOvalPtr->width); Tcl_AppendResult(interp, string, diff --git a/generic/tkScale.c b/generic/tkScale.c index 8cdfc3c..74efdd8 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -12,12 +12,12 @@ * permission. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkScale.c,v 1.2 1998/09/14 18:23:16 stanton Exp $ + * RCS: @(#) $Id: tkScale.c,v 1.3 1999/04/16 01:51:21 stanton Exp $ */ #include "tkPort.h" @@ -26,96 +26,132 @@ #include "tclMath.h" #include "tkScale.h" -static Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_SCALE_ACTIVE_BG_COLOR, Tk_Offset(TkScale, activeBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", - DEF_SCALE_ACTIVE_BG_MONO, Tk_Offset(TkScale, activeBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_SCALE_BG_COLOR, Tk_Offset(TkScale, bgBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_SCALE_BG_MONO, Tk_Offset(TkScale, bgBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement", - DEF_SCALE_BIG_INCREMENT, Tk_Offset(TkScale, bigIncrement), 0}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_SCALE_BORDER_WIDTH, Tk_Offset(TkScale, borderWidth), 0}, - {TK_CONFIG_STRING, "-command", "command", "Command", - DEF_SCALE_COMMAND, Tk_Offset(TkScale, command), TK_CONFIG_NULL_OK}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_SCALE_CURSOR, Tk_Offset(TkScale, cursor), TK_CONFIG_NULL_OK}, - {TK_CONFIG_INT, "-digits", "digits", "Digits", - DEF_SCALE_DIGITS, Tk_Offset(TkScale, digits), 0}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_FONT, "-font", "font", "Font", - DEF_SCALE_FONT, Tk_Offset(TkScale, tkfont), - 0}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_SCALE_FG_COLOR, Tk_Offset(TkScale, textColorPtr), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_SCALE_FG_MONO, Tk_Offset(TkScale, textColorPtr), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_DOUBLE, "-from", "from", "From", - DEF_SCALE_FROM, Tk_Offset(TkScale, fromValue), 0}, - {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", - "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG, - Tk_Offset(TkScale, highlightBgColorPtr), 0}, - {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_SCALE_HIGHLIGHT, Tk_Offset(TkScale, highlightColorPtr), 0}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", - "HighlightThickness", - DEF_SCALE_HIGHLIGHT_WIDTH, Tk_Offset(TkScale, highlightWidth), 0}, - {TK_CONFIG_STRING, "-label", "label", "Label", - DEF_SCALE_LABEL, Tk_Offset(TkScale, label), TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-length", "length", "Length", - DEF_SCALE_LENGTH, Tk_Offset(TkScale, length), 0}, - {TK_CONFIG_UID, "-orient", "orient", "Orient", - DEF_SCALE_ORIENT, Tk_Offset(TkScale, orientUid), 0}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_SCALE_RELIEF, Tk_Offset(TkScale, relief), 0}, - {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay", - DEF_SCALE_REPEAT_DELAY, Tk_Offset(TkScale, repeatDelay), 0}, - {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval", - DEF_SCALE_REPEAT_INTERVAL, Tk_Offset(TkScale, repeatInterval), 0}, - {TK_CONFIG_DOUBLE, "-resolution", "resolution", "Resolution", - DEF_SCALE_RESOLUTION, Tk_Offset(TkScale, resolution), 0}, - {TK_CONFIG_BOOLEAN, "-showvalue", "showValue", "ShowValue", - DEF_SCALE_SHOW_VALUE, Tk_Offset(TkScale, showValue), 0}, - {TK_CONFIG_PIXELS, "-sliderlength", "sliderLength", "SliderLength", - DEF_SCALE_SLIDER_LENGTH, Tk_Offset(TkScale, sliderLength), 0}, - {TK_CONFIG_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief", - DEF_SCALE_SLIDER_RELIEF, Tk_Offset(TkScale, sliderRelief), - TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_UID, "-state", "state", "State", - DEF_SCALE_STATE, Tk_Offset(TkScale, state), 0}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocus), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_DOUBLE, "-tickinterval", "tickInterval", "TickInterval", - DEF_SCALE_TICK_INTERVAL, Tk_Offset(TkScale, tickInterval), 0}, - {TK_CONFIG_DOUBLE, "-to", "to", "To", - DEF_SCALE_TO, Tk_Offset(TkScale, toValue), 0}, - {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background", - DEF_SCALE_TROUGH_COLOR, Tk_Offset(TkScale, troughColorPtr), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background", - DEF_SCALE_TROUGH_MONO, Tk_Offset(TkScale, troughColorPtr), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_STRING, "-variable", "variable", "Variable", - DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varName), TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-width", "width", "Width", - DEF_SCALE_WIDTH, Tk_Offset(TkScale, width), 0}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +/* + * The following table defines the legal values for the -orient option. + * It is used together with the "enum orient" declaration in tkScale.h. + */ + +static char *orientStrings[] = { + "horizontal", "vertical", (char *) NULL +}; + +/* + * The following table defines the legal values for the -state option. + * It is used together with the "enum state" declaration in tkScale.h. + */ + +static char *stateStrings[] = { + "active", "disabled", "normal", (char *) NULL +}; + +static 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}, + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_SCALE_BG_COLOR, -1, Tk_Offset(TkScale, bgBorder), + 0, (ClientData) 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", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_SCALE_BORDER_WIDTH, -1, Tk_Offset(TkScale, borderWidth), + 0, 0, 0}, + {TK_OPTION_STRING, "-command", "command", "Command", + DEF_SCALE_COMMAND, Tk_Offset(TkScale, commandPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_SCALE_CURSOR, -1, Tk_Offset(TkScale, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_INT, "-digits", "digits", "Digits", + DEF_SCALE_DIGITS, -1, Tk_Offset(TkScale, digits), + 0, 0, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-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", + DEF_SCALE_FG_COLOR, -1, Tk_Offset(TkScale, textColorPtr), 0, + (ClientData) DEF_SCALE_FG_MONO, 0}, + {TK_OPTION_DOUBLE, "-from", "from", "From", DEF_SCALE_FROM, -1, + Tk_Offset(TkScale, fromValue), 0, 0, 0}, + {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG_COLOR, + -1, Tk_Offset(TkScale, highlightBorder), + 0, (ClientData) DEF_SCALE_HIGHLIGHT_BG_MONO, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_SCALE_HIGHLIGHT, -1, Tk_Offset(TkScale, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_SCALE_HIGHLIGHT_WIDTH, -1, + Tk_Offset(TkScale, highlightWidth), 0, 0, 0}, + {TK_OPTION_STRING, "-label", "label", "Label", + DEF_SCALE_LABEL, Tk_Offset(TkScale, labelPtr), -1, 0, 0, 0}, + {TK_OPTION_PIXELS, "-length", "length", "Length", + 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}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_SCALE_RELIEF, -1, Tk_Offset(TkScale, relief), 0, 0, 0}, + {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay", + DEF_SCALE_REPEAT_DELAY, -1, Tk_Offset(TkScale, repeatDelay), + 0, 0, 0}, + {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval", + DEF_SCALE_REPEAT_INTERVAL, -1, Tk_Offset(TkScale, repeatInterval), + 0, 0, 0}, + {TK_OPTION_DOUBLE, "-resolution", "resolution", "Resolution", + DEF_SCALE_RESOLUTION, -1, Tk_Offset(TkScale, resolution), + 0, 0, 0}, + {TK_OPTION_BOOLEAN, "-showvalue", "showValue", "ShowValue", + DEF_SCALE_SHOW_VALUE, -1, Tk_Offset(TkScale, showValue), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-sliderlength", "sliderLength", "SliderLength", + DEF_SCALE_SLIDER_LENGTH, -1, Tk_Offset(TkScale, sliderLength), + 0, 0, 0}, + {TK_OPTION_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief", + DEF_SCALE_SLIDER_RELIEF, -1, Tk_Offset(TkScale, sliderRelief), + 0, 0, 0}, + {TK_OPTION_STRING_TABLE, "-state", "state", "State", + DEF_SCALE_STATE, -1, Tk_Offset(TkScale, state), + 0, (ClientData) stateStrings, 0}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocusPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_DOUBLE, "-tickinterval", "tickInterval", "TickInterval", + DEF_SCALE_TICK_INTERVAL, -1, Tk_Offset(TkScale, tickInterval), + 0, 0, 0}, + {TK_OPTION_DOUBLE, "-to", "to", "To", + 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}, + {TK_OPTION_STRING, "-variable", "variable", "Variable", + DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varNamePtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-width", "width", "Width", + DEF_SCALE_WIDTH, -1, Tk_Offset(TkScale, width), 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, 0, 0} +}; + +/* + * The following tables define the scale widget commands and map the + * indexes into the string tables into a single enumerated type used + * to dispatch the scale widget command. + */ + +static char *commandNames[] = { + "cget", "configure", "coords", "get", "identify", "set", (char *) NULL +}; + +enum command { + COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_COORDS, COMMAND_GET, + COMMAND_IDENTIFY, COMMAND_SET }; /* @@ -125,8 +161,8 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputeFormat _ANSI_ARGS_((TkScale *scalePtr)); static void ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr)); static int ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp, - TkScale *scalePtr, int argc, char **argv, - int flags)); + TkScale *scalePtr, int objc, + Tcl_Obj *CONST objv[])); static void DestroyScale _ANSI_ARGS_((char *memPtr)); static void ScaleCmdDeletedProc _ANSI_ARGS_(( ClientData clientData)); @@ -135,8 +171,9 @@ static void ScaleEventProc _ANSI_ARGS_((ClientData clientData, static char * ScaleVarProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)); -static int ScaleWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +static int ScaleWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static void ScaleWorldChanged _ANSI_ARGS_(( ClientData instanceData)); @@ -155,7 +192,7 @@ static TkClassProcs scaleClass = { /* *-------------------------------------------------------------- * - * Tk_ScaleCmd -- + * Tk_ScaleObjCmd -- * * This procedure is invoked to process the "scale" Tcl * command. See the user documentation for details on what @@ -171,28 +208,48 @@ static TkClassProcs scaleClass = { */ int -Tk_ScaleCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window associated with - * interpreter. */ +Tk_ScaleObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { - Tk_Window tkwin = (Tk_Window) clientData; register TkScale *scalePtr; - Tk_Window new; + Tk_OptionTable optionTable; + Tk_Window tkwin; + + optionTable = (Tk_OptionTable) clientData; + if (optionTable == NULL) { + Tcl_CmdInfo info; + char *name; + + /* + * We haven't created the option table for this widget class + * yet. Do it now and save the table as the clientData for + * the command, so we'll have access to it in future + * invocations of the command. + */ - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + optionTable = Tk_CreateOptionTable(interp, optionSpecs); + name = Tcl_GetString(objv[0]); + Tcl_GetCommandInfo(interp, name, &info); + info.objClientData = (ClientData) optionTable; + Tcl_SetCommandInfo(interp, name, &info); + } + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } - new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL); - if (new == NULL) { + tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), + Tcl_GetString(objv[1]), (char *) NULL); + if (tkwin == NULL) { return TCL_ERROR; } - scalePtr = TkpCreateScale(new); + + Tk_SetClass(tkwin, "Scale"); + scalePtr = TkpCreateScale(tkwin); /* * Initialize fields that won't be initialized by ConfigureScale, @@ -200,29 +257,30 @@ Tk_ScaleCmd(clientData, interp, argc, argv) * (e.g. resource pointers). */ - scalePtr->tkwin = new; - scalePtr->display = Tk_Display(new); + scalePtr->tkwin = tkwin; + scalePtr->display = Tk_Display(tkwin); scalePtr->interp = interp; - scalePtr->widgetCmd = Tcl_CreateCommand(interp, - Tk_PathName(scalePtr->tkwin), ScaleWidgetCmd, + scalePtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd, (ClientData) scalePtr, ScaleCmdDeletedProc); - scalePtr->orientUid = NULL; - scalePtr->vertical = 0; + scalePtr->optionTable = optionTable; + scalePtr->orient = ORIENT_VERTICAL; scalePtr->width = 0; scalePtr->length = 0; - scalePtr->value = 0; - scalePtr->varName = NULL; - scalePtr->fromValue = 0; - scalePtr->toValue = 0; - scalePtr->tickInterval = 0; + scalePtr->value = 0.0; + scalePtr->varNamePtr = NULL; + scalePtr->fromValue = 0.0; + scalePtr->toValue = 0.0; + scalePtr->tickInterval = 0.0; scalePtr->resolution = 1; + scalePtr->digits = 0; scalePtr->bigIncrement = 0.0; - scalePtr->command = NULL; + scalePtr->commandPtr = NULL; scalePtr->repeatDelay = 0; scalePtr->repeatInterval = 0; - scalePtr->label = NULL; + scalePtr->labelPtr = NULL; scalePtr->labelLength = 0; - scalePtr->state = tkNormalUid; + scalePtr->state = STATE_NORMAL; scalePtr->borderWidth = 0; scalePtr->bgBorder = NULL; scalePtr->activeBorder = NULL; @@ -235,7 +293,7 @@ Tk_ScaleCmd(clientData, interp, argc, argv) scalePtr->textGC = None; scalePtr->relief = TK_RELIEF_FLAT; scalePtr->highlightWidth = 0; - scalePtr->highlightBgColorPtr = NULL; + scalePtr->highlightBorder = NULL; scalePtr->highlightColorPtr = NULL; scalePtr->inset = 0; scalePtr->sliderLength = 0; @@ -249,30 +307,32 @@ Tk_ScaleCmd(clientData, interp, argc, argv) scalePtr->vertTroughX = 0; scalePtr->vertLabelX = 0; scalePtr->cursor = None; - scalePtr->takeFocus = NULL; + scalePtr->takeFocusPtr = NULL; scalePtr->flags = NEVER_SET; - Tk_SetClass(scalePtr->tkwin, "Scale"); TkSetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr); Tk_CreateEventHandler(scalePtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, ScaleEventProc, (ClientData) scalePtr); - if (ConfigureScale(interp, scalePtr, argc-2, argv+2, 0) != TCL_OK) { - goto error; - } - interp->result = Tk_PathName(scalePtr->tkwin); + if (Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin) + != TCL_OK) { + Tk_DestroyWindow(scalePtr->tkwin); + return TCL_ERROR; + } + if (ConfigureScale(interp, scalePtr, objc - 2, objv + 2) != TCL_OK) { + Tk_DestroyWindow(scalePtr->tkwin); + return TCL_ERROR; + } + Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(scalePtr->tkwin), + -1); return TCL_OK; - - error: - Tk_DestroyWindow(scalePtr->tkwin); - return TCL_ERROR; } /* *-------------------------------------------------------------- * - * ScaleWidgetCmd -- + * ScaleWidgetObjCmd -- * * This procedure is invoked to process the Tcl command * that corresponds to a widget managed by this module. @@ -288,131 +348,152 @@ Tk_ScaleCmd(clientData, interp, argc, argv) */ static int -ScaleWidgetCmd(clientData, interp, argc, argv) +ScaleWidgetObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about scale * widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings. */ { - register TkScale *scalePtr = (TkScale *) clientData; - int result = TCL_OK; - size_t length; - int c; + TkScale *scalePtr = (TkScale *) clientData; + Tcl_Obj *objPtr; + int index, result; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg arg ...?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } + result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, + "option", 0, &index); + if (result != TCL_OK) { + return result; + } Tcl_Preserve((ClientData) scalePtr); - c = argv[1][0]; - length = strlen(argv[1]); - 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\"", - (char *) NULL); - goto error; - } - result = Tk_ConfigureValue(interp, scalePtr->tkwin, configSpecs, - (char *) scalePtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 3)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs, - (char *) scalePtr, (char *) NULL, 0); - } else if (argc == 3) { - result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs, - (char *) scalePtr, argv[2], 0); - } else { - result = ConfigureScale(interp, scalePtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); - } - } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0) - && (length >= 3)) { - int x, y ; - double value; - - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " coords ?value?\"", (char *) NULL); - goto error; - } - if (argc == 3) { - if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) { + + switch (index) { + case COMMAND_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); goto error; } - } else { - value = scalePtr->value; - } - if (scalePtr->vertical) { - x = scalePtr->vertTroughX + scalePtr->width/2 - + scalePtr->borderWidth; - y = TkpValueToPixel(scalePtr, value); - } else { - x = TkpValueToPixel(scalePtr, value); - y = scalePtr->horizTroughY + scalePtr->width/2 - + scalePtr->borderWidth; + objPtr = Tk_GetOptionValue(interp, (char *) scalePtr, + scalePtr->optionTable, objv[2], scalePtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } + break; } - sprintf(interp->result, "%d %d", x, y); - } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { - double value; - int x, y; - - if ((argc != 2) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get ?x y?\"", (char *) NULL); - goto error; + case COMMAND_CONFIGURE: { + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr, + scalePtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + scalePtr->tkwin); + if (objPtr == NULL) { + goto error; + } else { + Tcl_SetObjResult(interp, objPtr); + } + } else { + result = ConfigureScale(interp, scalePtr, objc-2, objv+2); + } + break; } - if (argc == 2) { - value = scalePtr->value; - } else { - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + case COMMAND_COORDS: { + int x, y ; + double value; + char buf[TCL_INTEGER_SPACE * 2]; + + if ((objc != 2) && (objc != 3)) { + Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?"); goto error; } - value = TkpPixelToValue(scalePtr, x, y); - } - sprintf(interp->result, scalePtr->format, value); - } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { - int x, y, thing; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " identify x y\"", (char *) NULL); - goto error; - } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { - goto error; - } - thing = TkpScaleElement(scalePtr, x,y); - switch (thing) { - case TROUGH1: interp->result = "trough1"; break; - case SLIDER: interp->result = "slider"; break; - case TROUGH2: interp->result = "trough2"; break; - } - } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { - double value; + if (objc == 3) { + if (Tcl_GetDoubleFromObj(interp, objv[2], &value) + != TCL_OK) { + goto error; + } + } else { + value = scalePtr->value; + } + if (scalePtr->orient == ORIENT_VERTICAL) { + x = scalePtr->vertTroughX + scalePtr->width/2 + + scalePtr->borderWidth; + y = TkpValueToPixel(scalePtr, value); + } else { + x = TkpValueToPixel(scalePtr, value); + y = scalePtr->horizTroughY + scalePtr->width/2 + + scalePtr->borderWidth; + } + sprintf(buf, "%d %d", x, y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + 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?"); + goto error; + } + if (objc == 2) { + value = scalePtr->value; + } else { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) + != TCL_OK)) { + goto error; + } + value = TkpPixelToValue(scalePtr, x, y); + } + sprintf(buf, scalePtr->format, value); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + break; + } + case COMMAND_IDENTIFY: { + int x, y, thing; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); + goto error; + } + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (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; + } + break; + } + case COMMAND_SET: { + double value; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " set value\"", (char *) NULL); - goto error; - } - if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) { - goto error; - } - if (scalePtr->state != tkDisabledUid) { - TkpSetScaleValue(scalePtr, value, 1, 1); - } - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be cget, configure, coords, get, identify, or set", - (char *) NULL); - goto error; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "set value"); + goto error; + } + if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) { + goto error; + } + if ((scalePtr->state != STATE_DISABLED)) { + TkpSetScaleValue(scalePtr, value, 1, 1); + } + break; + } } Tcl_Release((ClientData) scalePtr); return result; @@ -452,8 +533,8 @@ DestroyScale(memPtr) * stuff. */ - if (scalePtr->varName != NULL) { - Tcl_UntraceVar(scalePtr->interp, scalePtr->varName, + if (scalePtr->varNamePtr != NULL) { + Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ScaleVarProc, (ClientData) scalePtr); } @@ -466,7 +547,8 @@ DestroyScale(memPtr) if (scalePtr->textGC != None) { Tk_FreeGC(scalePtr->display, scalePtr->textGC); } - Tk_FreeOptions(configSpecs, (char *) scalePtr, scalePtr->display, 0); + Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable, + scalePtr->tkwin); TkpDestroyScale(scalePtr); } @@ -481,7 +563,7 @@ DestroyScale(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as colors, border width, @@ -492,118 +574,135 @@ DestroyScale(memPtr) */ static int -ConfigureScale(interp, scalePtr, argc, argv, flags) +ConfigureScale(interp, scalePtr, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ register TkScale *scalePtr; /* Information about widget; may or may * not already have values for some fields. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ - int flags; /* Flags to pass to Tk_ConfigureWidget. */ + int objc; /* Number of valid entries in objv. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ { - size_t length; + Tk_SavedOptions savedOptions; + Tcl_Obj *errorResult = NULL; + int error; + char *label; /* * Eliminate any existing trace on a variable monitored by the scale. */ - if (scalePtr->varName != NULL) { - Tcl_UntraceVar(interp, scalePtr->varName, + if (scalePtr->varNamePtr != NULL) { + Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ScaleVarProc, (ClientData) scalePtr); } - if (Tk_ConfigureWidget(interp, scalePtr->tkwin, configSpecs, - argc, argv, (char *) scalePtr, flags) != TCL_OK) { - return TCL_ERROR; - } + for (error = 0; error <= 1; error++) { + if (!error) { + /* + * First pass: set options to new values. + */ - /* - * If the scale is tied to the value of a variable, then set up - * a trace on the variable's value and set the scale's value from - * the value of the variable, if it exists. - */ + if (Tk_SetOptions(interp, (char *) scalePtr, + scalePtr->optionTable, objc, objv, + scalePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { + continue; + } + } else { + /* + * Second pass: restore options to old values. + */ - if (scalePtr->varName != NULL) { - char *stringValue, *end; - double value; + errorResult = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(errorResult); + Tk_RestoreSavedOptions(&savedOptions); + } + + /* + * If the scale is tied to the value of a variable, then set + * the scale's value from the value of the variable, if it exists. + */ + + if (scalePtr->varNamePtr != NULL) { + char *name; + double value; + Tcl_Obj *valuePtr; - stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY); - if (stringValue != NULL) { - value = strtod(stringValue, &end); - if ((end != stringValue) && (*end == 0)) { - scalePtr->value = TkRoundToResolution(scalePtr, value); + name = Tcl_GetString(scalePtr->varNamePtr); + valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY); + if (valuePtr != NULL) { + Tcl_GetDoubleFromObj(interp, valuePtr, &value); } + scalePtr->value = TkRoundToResolution(scalePtr, value); } - Tcl_TraceVar(interp, scalePtr->varName, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ScaleVarProc, (ClientData) scalePtr); - } - /* - * Several options need special processing, such as parsing the - * orientation and creating GCs. - */ + /* + * Several options need special processing, such as parsing the + * orientation and creating GCs. + */ - length = strlen(scalePtr->orientUid); - if (strncmp(scalePtr->orientUid, "vertical", length) == 0) { - scalePtr->vertical = 1; - } else if (strncmp(scalePtr->orientUid, "horizontal", length) == 0) { - scalePtr->vertical = 0; - } else { - Tcl_AppendResult(interp, "bad orientation \"", scalePtr->orientUid, - "\": must be vertical or horizontal", (char *) NULL); - return TCL_ERROR; - } + scalePtr->fromValue = TkRoundToResolution(scalePtr, + scalePtr->fromValue); + scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue); + scalePtr->tickInterval = TkRoundToResolution(scalePtr, + scalePtr->tickInterval); - scalePtr->fromValue = TkRoundToResolution(scalePtr, scalePtr->fromValue); - scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue); - scalePtr->tickInterval = TkRoundToResolution(scalePtr, - scalePtr->tickInterval); + /* + * Make sure that the tick interval has the right sign so that + * addition moves from fromValue to toValue. + */ - /* - * Make sure that the tick interval has the right sign so that - * addition moves from fromValue to toValue. - */ + if ((scalePtr->tickInterval < 0) + ^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) { + scalePtr->tickInterval = -scalePtr->tickInterval; + } - if ((scalePtr->tickInterval < 0) - ^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) { - scalePtr->tickInterval = -scalePtr->tickInterval; - } + /* + * Set the scale value to itself; all this does is to make sure + * that the scale's value is within the new acceptable range for + * the scale and reflect the value in the associated variable, + * if any. + */ - /* - * Set the scale value to itself; all this does is to make sure - * that the scale's value is within the new acceptable range for - * the scale and reflect the value in the associated variable, - * if any. - */ + ComputeFormat(scalePtr); + TkpSetScaleValue(scalePtr, scalePtr->value, 1, 1); - ComputeFormat(scalePtr); - TkpSetScaleValue(scalePtr, scalePtr->value, 1, 1); + if (scalePtr->labelPtr != NULL) { + label = Tcl_GetString(scalePtr->labelPtr); + scalePtr->labelLength = strlen(label); + } else { + scalePtr->labelLength = 0; + } - if (scalePtr->label != NULL) { - scalePtr->labelLength = strlen(scalePtr->label); - } else { - scalePtr->labelLength = 0; - } + Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder); - if ((scalePtr->state != tkNormalUid) - && (scalePtr->state != tkDisabledUid) - && (scalePtr->state != tkActiveUid)) { - Tcl_AppendResult(interp, "bad state value \"", scalePtr->state, - "\": must be normal, active, or disabled", (char *) NULL); - scalePtr->state = tkNormalUid; - return TCL_ERROR; + if (scalePtr->highlightWidth < 0) { + scalePtr->highlightWidth = 0; + } + scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth; + break; + } + if (!error) { + Tk_FreeSavedOptions(&savedOptions); } - Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder); + /* + * Reestablish the variable trace, if it is needed. + */ - if (scalePtr->highlightWidth < 0) { - scalePtr->highlightWidth = 0; + if (scalePtr->varNamePtr != NULL) { + Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ScaleVarProc, (ClientData) scalePtr); } - scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth; ScaleWorldChanged((ClientData) scalePtr); - return TCL_OK; + if (error) { + Tcl_SetObjResult(interp, errorResult); + Tcl_DecrRefCount(errorResult); + return TCL_ERROR; + } else { + return TCL_OK; + } } /* @@ -801,6 +900,7 @@ ComputeScaleGeometry(scalePtr) char valueString[PRINT_CHARS]; int tmp, valuePixels, x, y, extraSpace; Tk_FontMetrics fm; + char *label; /* * Horizontal scales are simpler than vertical ones because @@ -809,7 +909,7 @@ ComputeScaleGeometry(scalePtr) */ Tk_GetFontMetrics(scalePtr->tkfont, &fm); - if (!scalePtr->vertical) { + if (!scalePtr->orient == ORIENT_VERTICAL) { y = scalePtr->inset; extraSpace = 0; if (scalePtr->labelLength != 0) { @@ -881,8 +981,9 @@ ComputeScaleGeometry(scalePtr) scalePtr->vertLabelX = 0; } else { scalePtr->vertLabelX = x + fm.ascent/2; + label = Tcl_GetString(scalePtr->labelPtr); x = scalePtr->vertLabelX + fm.ascent/2 - + Tk_TextWidth(scalePtr->tkfont, scalePtr->label, + + Tk_TextWidth(scalePtr->tkfont, label, scalePtr->labelLength); } Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset, @@ -1089,8 +1190,12 @@ ScaleVarProc(clientData, interp, name1, name2, flags) int flags; /* Information about what happened. */ { register TkScale *scalePtr = (TkScale *) clientData; - char *stringValue, *end, *result; + char *resultStr, *name; double value; + Tcl_Obj *valuePtr; + int result; + + name = Tcl_GetString(scalePtr->varNamePtr); /* * If the variable is unset, then immediately recreate it unless @@ -1099,7 +1204,7 @@ ScaleVarProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_TraceVar(interp, scalePtr->varName, + Tcl_TraceVar(interp, name, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ScaleVarProc, clientData); scalePtr->flags |= NEVER_SET; @@ -1117,27 +1222,26 @@ ScaleVarProc(clientData, interp, name1, name2, flags) if (scalePtr->flags & SETTING_VAR) { return (char *) NULL; } - result = NULL; - stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY); - if (stringValue != NULL) { - value = strtod(stringValue, &end); - if ((end == stringValue) || (*end != 0)) { - result = "can't assign non-numeric value to scale variable"; - } else { - scalePtr->value = TkRoundToResolution(scalePtr, value); - } - - /* - * This code is a bit tricky because it sets the scale's value before - * calling TkpSetScaleValue. This way, TkpSetScaleValue won't bother - * to set the variable again or to invoke the -command. However, it - * also won't redisplay the scale, so we have to ask for that - * explicitly. - */ - - TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0); - TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER); + resultStr = NULL; + valuePtr = Tcl_GetVar2Ex(interp, name, NULL, + TCL_GLOBAL_ONLY); + result = Tcl_GetDoubleFromObj(interp, valuePtr, &value); + if (result != TCL_OK) { + resultStr = "can't assign non-numeric value to scale variable"; + } else { + scalePtr->value = TkRoundToResolution(scalePtr, value); + + /* + * This code is a bit tricky because it sets the scale's value before + * calling TkpSetScaleValue. This way, TkpSetScaleValue won't bother + * to set the variable again or to invoke the -command. However, it + * also won't redisplay the scale, so we have to ask for that + * explicitly. + */ + + TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0); + TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER); } - return result; + return resultStr; } diff --git a/generic/tkScale.h b/generic/tkScale.h index 7200fb2..af0ca43 100644 --- a/generic/tkScale.h +++ b/generic/tkScale.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkScale.h,v 1.4 1998/09/14 18:23:17 stanton Exp $ + * RCS: @(#) $Id: tkScale.h,v 1.5 1999/04/16 01:51:21 stanton Exp $ */ #ifndef _TKSCALE @@ -25,6 +25,22 @@ #endif /* + * Legal values for the "orient" field of TkScale records. + */ + +enum orient { + ORIENT_HORIZONTAL, ORIENT_VERTICAL +}; + +/* + * Legal values for the "state" field of TkScale records. + */ + +enum state { + STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL +}; + +/* * A data structure of the following type is kept for each scale * widget managed by this file: */ @@ -39,16 +55,16 @@ typedef struct TkScale { * freed even after tkwin has gone away. */ Tcl_Interp *interp; /* Interpreter associated with scale. */ Tcl_Command widgetCmd; /* Token for scale's widget command. */ - Tk_Uid orientUid; /* Orientation for window ("vertical" or - * "horizontal"). */ - int vertical; /* Non-zero means vertical orientation, - * zero means horizontal. */ + Tk_OptionTable optionTable; /* Table that defines configuration options + * available for this widget. */ + enum orient orient; /* Orientation for window (vertical or + * horizontal). */ int width; /* Desired narrow dimension of scale, * in pixels. */ int length; /* Desired long dimension of scale, * in pixels. */ - double value; /* Current value of scale. */ - char *varName; /* Name of variable (malloc'ed) or NULL. + double value; /* Current value of scale. */ + Tcl_Obj *varNamePtr; /* Name of variable or NULL. * If non-NULL, scale's value tracks * the contents of this variable and * vice versa. */ @@ -68,19 +84,19 @@ typedef struct TkScale { * digits and other information. */ double bigIncrement; /* Amount to use for large increments to * scale value. (0 means we pick a value). */ - char *command; /* Command prefix to use when invoking Tcl + Tcl_Obj *commandPtr; /* Command prefix to use when invoking Tcl * commands because the scale value changed. - * NULL means don't invoke commands. - * Malloc'ed. */ + * NULL means don't invoke commands. */ int repeatDelay; /* How long to wait before auto-repeating * on scrolling actions (in ms). */ int repeatInterval; /* Interval between autorepeats (in ms). */ - char *label; /* Label to display above or to right of + Tcl_Obj *labelPtr; /* Label to display above or to right of * scale; NULL means don't display a - * label. Malloc'ed. */ + * label. */ int labelLength; /* Number of non-NULL chars. in label. */ - Tk_Uid state; /* Normal or disabled. Value cannot be - * changed when scale is disabled. */ + enum state state; /* Values are active, normal, or disabled. + * Value of scale cannot be changed when + * disabled. */ /* * Information used when displaying widget: @@ -90,7 +106,8 @@ typedef struct TkScale { Tk_3DBorder bgBorder; /* Used for drawing slider and other * background areas. */ Tk_3DBorder activeBorder; /* For drawing the slider when active. */ - int sliderRelief; /* Is slider to be drawn raised, sunken, etc. */ + int sliderRelief; /* Is slider to be drawn raised, sunken, + * etc. */ XColor *troughColorPtr; /* Color for drawing trough. */ GC troughGC; /* For drawing trough. */ GC copyGC; /* Used for copying from pixmap onto screen. */ @@ -102,9 +119,10 @@ typedef struct TkScale { int highlightWidth; /* Width in pixels of highlight to draw * around widget when it has the focus. * <= 0 means don't draw a highlight. */ - XColor *highlightBgColorPtr; - /* Color for drawing traversal highlight - * area when highlight is off. */ + Tk_3DBorder highlightBorder;/* Value of -highlightbackground option: + * specifies background with which to draw 3-D + * default ring and focus highlight area when + * highlight is off. */ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */ int inset; /* Total width of all borders, including * traversal highlight and 3-D border. @@ -141,9 +159,9 @@ typedef struct TkScale { */ Tk_Cursor cursor; /* Current cursor for window, or None. */ - char *takeFocus; /* Value of -takefocus option; not used in + Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in * the C code, but used by keyboard traversal - * scripts. Malloc'ed, but may be NULL. */ + * scripts. May be NULL. */ int flags; /* Various flags; see below for * definitions. */ } TkScale; @@ -207,7 +225,7 @@ typedef struct TkScale { #define PRINT_CHARS 150 /* - * Declaration of procedures used in the implementation of the scrollbar + * Declaration of procedures used in the implementation of the scale * widget. */ diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 0b90160..e00581a 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkScrollbar.c,v 1.2 1998/09/14 18:23:17 stanton Exp $ + * RCS: @(#) $Id: tkScrollbar.c,v 1.3 1999/04/16 01:51:21 stanton Exp $ */ #include "tkPort.h" @@ -193,7 +193,7 @@ Tk_ScrollbarCmd(clientData, interp, argc, argv) return TCL_ERROR; } - interp->result = Tk_PathName(scrollPtr->tkwin); + Tcl_SetResult(interp, Tk_PathName(scrollPtr->tkwin), TCL_STATIC); return TCL_OK; } @@ -240,9 +240,15 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv) int oldActiveField; if (argc == 2) { switch (scrollPtr->activeField) { - case TOP_ARROW: interp->result = "arrow1"; break; - case SLIDER: interp->result = "slider"; break; - case BOTTOM_ARROW: interp->result = "arrow2"; break; + 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; } goto done; } @@ -292,6 +298,7 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv) } else if ((c == 'd') && (strncmp(argv[1], "delta", length) == 0)) { int xDelta, yDelta, pixels, length; double fraction; + char buf[TCL_DOUBLE_SPACE]; if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -316,10 +323,12 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv) } else { fraction = ((double) pixels / (double) length); } - sprintf(interp->result, "%g", fraction); + sprintf(buf, "%g", fraction); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) { int x, y, pos, length; double fraction; + char buf[TCL_DOUBLE_SPACE]; if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -349,7 +358,8 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv) } else if (fraction > 1.0) { fraction = 1.0; } - sprintf(interp->result, "%g", fraction); + sprintf(buf, "%g", fraction); + 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 \"", @@ -363,9 +373,12 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv) Tcl_PrintDouble(interp, scrollPtr->lastFraction, last); Tcl_AppendResult(interp, first, " ", last, (char *) NULL); } else { - sprintf(interp->result, "%d %d %d %d", scrollPtr->totalUnits, + 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); } } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { int x, y, thing; @@ -381,11 +394,21 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv) } thing = TkpScrollbarPosition(scrollPtr, x,y); switch (thing) { - case TOP_ARROW: interp->result = "arrow1"; break; - case TOP_GAP: interp->result = "trough1"; break; - case SLIDER: interp->result = "slider"; break; - case BOTTOM_GAP: interp->result = "trough2"; break; - case BOTTOM_ARROW: interp->result = "arrow2"; break; + 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; } } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { int totalUnits, windowUnits, firstUnit, lastUnit; @@ -488,7 +511,7 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as colors, border width, diff --git a/generic/tkSelect.c b/generic/tkSelect.c index 01e8af4..fe8f119 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.c @@ -6,12 +6,12 @@ * and Tcl commands. * * Copyright (c) 1990-1993 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkSelect.c,v 1.2 1998/09/14 18:23:17 stanton Exp $ + * RCS: @(#) $Id: tkSelect.c,v 1.3 1999/04/16 01:51:21 stanton Exp $ */ #include "tkInt.h" @@ -45,12 +45,16 @@ typedef struct LostCommand { } LostCommand; /* - * Shared variables: + * The structure below is used to keep each thread's pending list + * separate. */ -TkSelInProgress *pendingPtr = NULL; +typedef struct ThreadSpecificData { + TkSelInProgress *pendingPtr; /* Topmost search in progress, or * NULL if none. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations for procedures defined in this file: @@ -199,6 +203,8 @@ Tk_DeleteSelHandler(tkwin, selection, target) TkWindow *winPtr = (TkWindow *) tkwin; register TkSelHandler *selPtr, *prevPtr; register TkSelInProgress *ipPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Find the selection handler to be deleted, or return if it doesn't @@ -220,7 +226,8 @@ Tk_DeleteSelHandler(tkwin, selection, target) * handler is dead. */ - for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; + ipPtr = ipPtr->nextPtr) { if (ipPtr->selPtr == selPtr) { ipPtr->selPtr = NULL; } @@ -431,7 +438,7 @@ Tk_ClearSelection(tkwin, selection) * Results: * The return value is a standard Tcl return value. * If an error occurs (such as no selection exists) - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * The standard X11 protocols are used to retrieve the @@ -457,7 +464,7 @@ Tk_ClearSelection(tkwin, selection) * the "portion" arguments in separate calls will contain * successive parts of the selection. Proc should normally * return TCL_OK. If it detects an error then it should return - * TCL_ERROR and leave an error message in interp->result; the + * TCL_ERROR and leave an error message in the interp's result; the * remainder of the selection retrieval will be aborted. * *-------------------------------------------------------------- @@ -480,6 +487,8 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData) TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; TkSelectionInfo *infoPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (dispPtr->multipleAtom == None) { TkSelInit(tkwin); @@ -528,13 +537,13 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData) offset = 0; result = TCL_OK; ip.selPtr = selPtr; - ip.nextPtr = pendingPtr; - pendingPtr = &ip; + ip.nextPtr = tsdPtr->pendingPtr; + tsdPtr->pendingPtr = &ip; while (1) { count = (selPtr->proc)(selPtr->clientData, offset, buffer, TK_SEL_BYTES_AT_ONCE); if ((count < 0) || (ip.selPtr == NULL)) { - pendingPtr = ip.nextPtr; + tsdPtr->pendingPtr = ip.nextPtr; goto cantget; } if (count > TK_SEL_BYTES_AT_ONCE) { @@ -548,7 +557,7 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData) } offset += count; } - pendingPtr = ip.nextPtr; + tsdPtr->pendingPtr = ip.nextPtr; } return result; } @@ -602,9 +611,8 @@ Tk_SelectionCmd(clientData, interp, argc, argv) char **args; if (argc < 2) { - sprintf(interp->result, - "wrong # args: should be \"%.50s option ?arg arg ...?\"", - argv[0]); + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option ?arg arg ...?\"", (char *) NULL); return TCL_ERROR; } c = argv[1][0]; @@ -854,7 +862,7 @@ Tk_SelectionCmd(clientData, interp, argc, argv) if ((infoPtr != NULL) && (infoPtr->owner != winPtr->dispPtr->clipWindow)) { - interp->result = Tk_PathName(infoPtr->owner); + Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC); } return TCL_OK; } @@ -878,9 +886,8 @@ Tk_SelectionCmd(clientData, interp, argc, argv) Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr); return TCL_OK; } else { - sprintf(interp->result, - "bad option \"%.50s\": must be clear, get, handle, or own", - argv[1]); + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be clear, get, handle, or own", (char *) NULL); return TCL_ERROR; } } @@ -888,6 +895,60 @@ Tk_SelectionCmd(clientData, interp, argc, argv) /* *---------------------------------------------------------------------- * + * TkSelGetInProgress -- + * + * This procedure returns a pointer to the thread-local + * list of pending searches. + * + * Results: + * The return value is a pointer to the first search in progress, + * or NULL if there are none. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +TkSelInProgress * +TkSelGetInProgress(void) +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->pendingPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TkSelSetInProgress -- + * + * This procedure is used to set the thread-local list of pending + * searches. It is required because the pending list is kept + * in thread local storage. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +void +TkSelSetInProgress(pendingPtr) + TkSelInProgress *pendingPtr; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + tsdPtr->pendingPtr = pendingPtr; +} + +/* + *---------------------------------------------------------------------- + * * TkSelDeadWindow -- * * This procedure is invoked just before a TkWindow is deleted. @@ -909,6 +970,8 @@ TkSelDeadWindow(winPtr) register TkSelHandler *selPtr; register TkSelInProgress *ipPtr; TkSelectionInfo *infoPtr, *prevPtr, *nextPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * While deleting all the handlers, be careful to check whether @@ -919,7 +982,8 @@ TkSelDeadWindow(winPtr) while (winPtr->selHandlerList != NULL) { selPtr = winPtr->selHandlerList; winPtr->selHandlerList = selPtr->nextPtr; - for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; + ipPtr = ipPtr->nextPtr) { if (ipPtr->selPtr == selPtr) { ipPtr->selPtr = NULL; } @@ -1155,11 +1219,12 @@ HandleTclCommand(clientData, offset, buffer, maxBytes) Tcl_DStringInit(&oldResult); Tcl_DStringGetResult(interp, &oldResult); if (TkCopyAndGlobalEval(interp, command) == TCL_OK) { - length = strlen(interp->result); + length = strlen(Tcl_GetStringResult(interp)); if (length > maxBytes) { length = maxBytes; } - memcpy((VOID *) buffer, (VOID *) interp->result, (size_t) length); + memcpy((VOID *) buffer, (VOID *) Tcl_GetStringResult(interp), + (size_t) length); buffer[length] = '\0'; } else { length = -1; @@ -1302,8 +1367,7 @@ LostSelection(clientData) ClientData clientData; /* Pointer to CommandInfo structure. */ { LostCommand *lostPtr = (LostCommand *) clientData; - char *oldResultString; - Tcl_FreeProc *oldFreeProc; + Tcl_Obj *objPtr; Tcl_Interp *interp; interp = lostPtr->interp; @@ -1314,22 +1378,16 @@ LostSelection(clientData) * restore it after executing the command. */ - oldFreeProc = interp->freeProc; - if (oldFreeProc != TCL_STATIC) { - oldResultString = interp->result; - } else { - oldResultString = (char *) ckalloc((unsigned) - (strlen(interp->result) + 1)); - strcpy(oldResultString, interp->result); - oldFreeProc = TCL_DYNAMIC; - } - interp->freeProc = TCL_STATIC; + objPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(objPtr); + Tcl_ResetResult(interp); + if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) { Tcl_BackgroundError(interp); } - Tcl_FreeResult(interp); - interp->result = oldResultString; - interp->freeProc = oldFreeProc; + + Tcl_SetObjResult(interp, objPtr); + Tcl_DecrRefCount(objPtr); Tcl_Release((ClientData) interp); diff --git a/generic/tkSelect.h b/generic/tkSelect.h index 4963f71..0d8c644 100644 --- a/generic/tkSelect.h +++ b/generic/tkSelect.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkSelect.h,v 1.2 1998/09/14 18:23:17 stanton Exp $ + * RCS: @(#) $Id: tkSelect.h,v 1.3 1999/04/16 01:51:22 stanton Exp $ */ #ifndef _TKSELECT @@ -146,14 +146,6 @@ typedef struct TkSelInProgress { } TkSelInProgress; /* - * Declarations for variables shared among the selection-related files: - */ - -extern TkSelInProgress *pendingPtr; - /* Topmost search in progress, or - * NULL if none. */ - -/* * Chunk size for retrieving selection. It's defined both in * words and in bytes; the word size is used to allocate * buffer space that's guaranteed to be word-aligned and that @@ -168,6 +160,11 @@ extern TkSelInProgress *pendingPtr; * but shouldn't be used anywhere else in Tk (or by Tk clients): */ +extern TkSelInProgress * + TkSelGetInProgress _ANSI_ARGS_((void)); +extern void TkSelSetInProgress _ANSI_ARGS_(( + TkSelInProgress *pendingPtr)); + extern void TkSelClearSelection _ANSI_ARGS_((Tk_Window tkwin, XEvent *eventPtr)); extern int TkSelDefaultSelection _ANSI_ARGS_(( diff --git a/generic/tkSquare.c b/generic/tkSquare.c index e7cc047..a835e31 100644 --- a/generic/tkSquare.c +++ b/generic/tkSquare.c @@ -1,23 +1,24 @@ /* * tkSquare.c -- * - * This module implements "square" widgets. A "square" is - * a widget that displays a single square that can be moved - * around and resized. This file is intended as an example + * This module implements "square" widgets that are object + * based. A "square" is a widget that displays a single square that can + * be moved around and resized. This file is intended as an example * of how to build a widget; it isn't included in the * normal wish, but it is included in "tktest". * - * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkSquare.c,v 1.2 1998/09/14 18:23:17 stanton Exp $ + * RCS: @(#) $Id: tkSquare.c,v 1.3 1999/04/16 01:51:22 stanton Exp $ */ #include "tkPort.h" +#define __NO_OLD_CONFIG #include "tk.h" +#include "tkInt.h" /* * A data structure of the following type is kept for each square @@ -31,22 +32,24 @@ typedef struct { Display *display; /* X's token for the window's display. */ Tcl_Interp *interp; /* Interpreter associated with widget. */ Tcl_Command widgetCmd; /* Token for square's widget command. */ - int x, y; /* Position of square's upper-left corner + Tk_OptionTable optionTable; /* Token representing the configuration + * specifications. */ + Tcl_Obj *xPtr, *yPtr; /* Position of square's upper-left corner * within widget. */ - int size; /* Width and height of square. */ + int x, y; + Tcl_Obj *sizeObjPtr; /* Width and height of square. */ /* * Information used when displaying widget: */ - int borderWidth; /* Width of 3-D border around whole widget. */ - Tk_3DBorder bgBorder; /* Used for drawing background. */ - Tk_3DBorder fgBorder; /* For drawing square. */ - int relief; /* Indicates whether window as a whole is - * raised, sunken, or flat. */ + Tcl_Obj *borderWidthPtr; /* Width of 3-D border around whole widget. */ + Tcl_Obj *bgBorderPtr; + Tcl_Obj *fgBorderPtr; + Tcl_Obj *reliefPtr; GC gc; /* Graphics context for copying from * off-screen pixmap onto screen. */ - int doubleBuffer; /* Non-zero means double-buffer redisplay + Tcl_Obj *doubleBufferPtr; /* Non-zero means double-buffer redisplay * with pixmap; zero means draw straight * onto the display. */ int updatePending; /* Non-zero means a call to SquareDisplay @@ -57,49 +60,52 @@ typedef struct { * Information used for argv parsing. */ -static Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_BORDER, "-background", "background", "Background", - "#d9d9d9", Tk_Offset(Square, bgBorder), TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - "white", Tk_Offset(Square, bgBorder), TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - "2", Tk_Offset(Square, borderWidth), 0}, - {TK_CONFIG_INT, "-dbl", "doubleBuffer", "DoubleBuffer", - "1", Tk_Offset(Square, doubleBuffer), 0}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", - "#b03060", Tk_Offset(Square, fgBorder), TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", - "black", Tk_Offset(Square, fgBorder), TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - "raised", Tk_Offset(Square, relief), 0}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +static Tk_OptionSpec configSpecs[] = { + {TK_OPTION_BORDER, "-background", "background", "Background", + "#d9d9d9", Tk_Offset(Square, bgBorderPtr), -1, 0, + (ClientData) "white"}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background"}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + "2", Tk_Offset(Square, borderWidthPtr), -1}, + {TK_OPTION_BOOLEAN, "-dbl", "doubleBuffer", "DoubleBuffer", + "1", Tk_Offset(Square, doubleBufferPtr), -1}, + {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-foreground"}, + {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground", + "#b03060", Tk_Offset(Square, fgBorderPtr), -1, 0, + (ClientData) "black"}, + {TK_OPTION_PIXELS, "-posx", "posx", "PosX", "0", + Tk_Offset(Square, xPtr), -1}, + {TK_OPTION_PIXELS, "-posy", "posy", "PosY", "0", + Tk_Offset(Square, yPtr), -1}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + "raised", Tk_Offset(Square, reliefPtr), -1}, + {TK_OPTION_PIXELS, "-size", "size", "Size", "20", + Tk_Offset(Square, sizeObjPtr), -1}, + {TK_OPTION_END} }; /* * Forward declarations for procedures defined later in this file: */ -int SquareCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); -static void SquareCmdDeletedProc _ANSI_ARGS_(( +int SquareObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[])); +static void SquareDeletedProc _ANSI_ARGS_(( ClientData clientData)); static int SquareConfigure _ANSI_ARGS_((Tcl_Interp *interp, - Square *squarePtr, int argc, char **argv, - int flags)); + Square *squarePtr)); static void SquareDestroy _ANSI_ARGS_((char *memPtr)); static void SquareDisplay _ANSI_ARGS_((ClientData clientData)); static void KeepInWindow _ANSI_ARGS_((Square *squarePtr)); -static void SquareEventProc _ANSI_ARGS_((ClientData clientData, +static void SquareObjEventProc _ANSI_ARGS_((ClientData clientData, XEvent *eventPtr)); static int SquareWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *, int argc, char **argv)); + Tcl_Interp *, int objc, Tcl_Obj * CONST objv[])); /* *-------------------------------------------------------------- @@ -119,24 +125,41 @@ static int SquareWidgetCmd _ANSI_ARGS_((ClientData clientData, */ int -SquareCmd(clientData, interp, argc, argv) +SquareObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj * CONST objv[]; /* Argument objects. */ { - Tk_Window main = (Tk_Window) clientData; Square *squarePtr; Tk_Window tkwin; + Tk_OptionTable optionTable = (Tk_OptionTable) clientData; + Tcl_CmdInfo info; + char *commandName; + + if (optionTable == NULL) { + /* + * The first time this procedure is invoked, optionTable will + * be NULL. We then create the option table from the template + * and store the table pointer as the command's clinical so + * we'll have easy access to it in the future. + */ + + optionTable = Tk_CreateOptionTable(interp, configSpecs); + commandName = Tcl_GetStringFromObj(objv[0], (int *) NULL); + Tcl_GetCommandInfo(interp, commandName, &info); + info.clientData = (ClientData) optionTable; + Tcl_SetCommandInfo(interp, commandName, &info); + } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } - tkwin = Tk_CreateWindowFromPath(interp, main, argv[1], (char *) NULL); + tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), + Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL); if (tkwin == NULL) { return TCL_ERROR; } @@ -150,29 +173,47 @@ SquareCmd(clientData, interp, argc, argv) squarePtr->tkwin = tkwin; squarePtr->display = Tk_Display(tkwin); squarePtr->interp = interp; - squarePtr->widgetCmd = Tcl_CreateCommand(interp, + squarePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(squarePtr->tkwin), SquareWidgetCmd, - (ClientData) squarePtr, SquareCmdDeletedProc); + (ClientData) squarePtr, SquareDeletedProc); + squarePtr->xPtr = NULL; + squarePtr->yPtr = NULL; squarePtr->x = 0; squarePtr->y = 0; - squarePtr->size = 20; - squarePtr->borderWidth = 0; - squarePtr->bgBorder = NULL; - squarePtr->fgBorder = NULL; - squarePtr->relief = TK_RELIEF_FLAT; + squarePtr->sizeObjPtr = NULL; + squarePtr->borderWidthPtr = NULL; + squarePtr->bgBorderPtr = NULL; + squarePtr->fgBorderPtr = NULL; + squarePtr->reliefPtr = NULL; squarePtr->gc = None; - squarePtr->doubleBuffer = 1; + squarePtr->doubleBufferPtr = NULL; squarePtr->updatePending = 0; + squarePtr->optionTable = optionTable; - Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask, - SquareEventProc, (ClientData) squarePtr); - if (SquareConfigure(interp, squarePtr, argc-2, argv+2, 0) != TCL_OK) { + if (Tk_InitOptions(interp, (char *) squarePtr, optionTable, tkwin) + != TCL_OK) { Tk_DestroyWindow(squarePtr->tkwin); + ckfree((char *) squarePtr); return TCL_ERROR; } - interp->result = Tk_PathName(squarePtr->tkwin); + Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask, + SquareObjEventProc, (ClientData) squarePtr); + if (Tk_SetOptions(interp, (char *) squarePtr, optionTable, objc - 2, + objv + 2, tkwin, NULL, (int *) NULL) != TCL_OK) { + goto error; + } + if (SquareConfigure(interp, squarePtr) != TCL_OK) { + goto error; + } + + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(squarePtr->tkwin), + -1)); return TCL_OK; + +error: + Tk_DestroyWindow(squarePtr->tkwin); + return TCL_ERROR; } /* @@ -194,92 +235,79 @@ SquareCmd(clientData, interp, argc, argv) */ static int -SquareWidgetCmd(clientData, interp, argc, argv) +SquareWidgetCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about square widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj * CONST objv[]; /* Argument objects. */ { Square *squarePtr = (Square *) clientData; int result = TCL_OK; - size_t length; - char c; + static char *squareOptions[] = {"cget", "configure", (char *) NULL}; + enum { + SQUARE_CGET, SQUARE_CONFIGURE + }; + Tcl_Obj *resultObjPtr; + int index; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?"); + return TCL_ERROR; + } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg arg ...?\"", (char *) NULL); + if (Tcl_GetIndexFromObj(interp, objv[1], squareOptions, "command", + 0, &index) != TCL_OK) { return TCL_ERROR; } + Tcl_Preserve((ClientData) squarePtr); - c = argv[1][0]; - length = strlen(argv[1]); - 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\"", - (char *) NULL); - goto error; - } - result = Tk_ConfigureValue(interp, squarePtr->tkwin, configSpecs, - (char *) squarePtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs, - (char *) squarePtr, (char *) NULL, 0); - } else if (argc == 3) { - result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs, - (char *) squarePtr, argv[2], 0); - } else { - result = SquareConfigure(interp, squarePtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); - } - } else if ((c == 'p') && (strncmp(argv[1], "position", length) == 0)) { - if ((argc != 2) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " position ?x y?\"", (char *) NULL); - goto error; - } - if (argc == 4) { - if ((Tk_GetPixels(interp, squarePtr->tkwin, argv[2], - &squarePtr->x) != TCL_OK) || (Tk_GetPixels(interp, - squarePtr->tkwin, argv[3], &squarePtr->y) != TCL_OK)) { + + switch (index) { + case SQUARE_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); goto error; } - KeepInWindow(squarePtr); - } - sprintf(interp->result, "%d %d", squarePtr->x, squarePtr->y); - } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)) { - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " size ?amount?\"", (char *) NULL); - goto error; + resultObjPtr = Tk_GetOptionValue(interp, (char *) squarePtr, + squarePtr->optionTable, objv[2], squarePtr->tkwin); + if (resultObjPtr == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObjPtr); + } + break; } - if (argc == 3) { - int i; - - if (Tk_GetPixels(interp, squarePtr->tkwin, argv[2], &i) != TCL_OK) { - goto error; + case SQUARE_CONFIGURE: { + resultObjPtr = NULL; + if (objc == 2) { + resultObjPtr = Tk_GetOptionInfo(interp, (char *) squarePtr, + squarePtr->optionTable, (Tcl_Obj *) NULL, + squarePtr->tkwin); + if (resultObjPtr == NULL) { + result = TCL_ERROR; + } + } else if (objc == 3) { + resultObjPtr = Tk_GetOptionInfo(interp, (char *) squarePtr, + squarePtr->optionTable, objv[2], squarePtr->tkwin); + if (resultObjPtr == NULL) { + result = TCL_ERROR; + } + } else { + result = Tk_SetOptions(interp, (char *) squarePtr, + squarePtr->optionTable, objc - 2, objv + 2, + squarePtr->tkwin, NULL, (int *) NULL); + if (result == TCL_OK) { + result = SquareConfigure(interp, squarePtr); + } + if (!squarePtr->updatePending) { + Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr); + squarePtr->updatePending = 1; + } } - if ((i <= 0) || (i > 100)) { - Tcl_AppendResult(interp, "bad size \"", argv[2], - "\"", (char *) NULL); - goto error; + if (resultObjPtr != NULL) { + Tcl_SetObjResult(interp, resultObjPtr); } - squarePtr->size = i; - KeepInWindow(squarePtr); } - sprintf(interp->result, "%d", squarePtr->size); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be cget, configure, position, or size", - (char *) NULL); - goto error; - } - if (!squarePtr->updatePending) { - Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr); - squarePtr->updatePending = 1; } Tcl_Release((ClientData) squarePtr); return result; @@ -300,7 +328,7 @@ SquareWidgetCmd(clientData, interp, argc, argv) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as colors, border width, @@ -311,27 +339,25 @@ SquareWidgetCmd(clientData, interp, argc, argv) */ static int -SquareConfigure(interp, squarePtr, argc, argv, flags) +SquareConfigure(interp, squarePtr) Tcl_Interp *interp; /* Used for error reporting. */ Square *squarePtr; /* Information about widget. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ - int flags; /* Flags to pass to - * Tk_ConfigureWidget. */ { - if (Tk_ConfigureWidget(interp, squarePtr->tkwin, configSpecs, - argc, argv, (char *) squarePtr, flags) != TCL_OK) { - return TCL_ERROR; - } + int borderWidth; + Tk_3DBorder bgBorder; + int doubleBuffer; /* * Set the background for the window and create a graphics context * for use during redisplay. */ + bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin, + squarePtr->bgBorderPtr); Tk_SetWindowBackground(squarePtr->tkwin, - Tk_3DBorderColor(squarePtr->bgBorder)->pixel); - if ((squarePtr->gc == None) && (squarePtr->doubleBuffer)) { + Tk_3DBorderColor(bgBorder)->pixel); + Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer); + if ((squarePtr->gc == None) && (doubleBuffer)) { XGCValues gcValues; gcValues.function = GXcopy; gcValues.graphics_exposures = False; @@ -345,18 +371,21 @@ SquareConfigure(interp, squarePtr, argc, argv, flags) */ Tk_GeometryRequest(squarePtr->tkwin, 200, 150); - Tk_SetInternalBorder(squarePtr->tkwin, squarePtr->borderWidth); + Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr, + &borderWidth); + Tk_SetInternalBorder(squarePtr->tkwin, borderWidth); if (!squarePtr->updatePending) { Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr); squarePtr->updatePending = 1; } + KeepInWindow(squarePtr); return TCL_OK; } /* *-------------------------------------------------------------- * - * SquareEventProc -- + * SquareObjEventProc -- * * This procedure is invoked by the Tk dispatcher for various * events on squares. @@ -372,7 +401,7 @@ SquareConfigure(interp, squarePtr, argc, argv, flags) */ static void -SquareEventProc(clientData, eventPtr) +SquareObjEventProc(clientData, eventPtr) ClientData clientData; /* Information about window. */ XEvent *eventPtr; /* Information about event. */ { @@ -391,6 +420,11 @@ SquareEventProc(clientData, eventPtr) } } else if (eventPtr->type == DestroyNotify) { if (squarePtr->tkwin != NULL) { + Tk_FreeConfigOptions((char *) squarePtr, squarePtr->optionTable, + squarePtr->tkwin); + if (squarePtr->gc != None) { + Tk_FreeGC(squarePtr->display, squarePtr->gc); + } squarePtr->tkwin = NULL; Tcl_DeleteCommandFromToken(squarePtr->interp, squarePtr->widgetCmd); @@ -405,7 +439,7 @@ SquareEventProc(clientData, eventPtr) /* *---------------------------------------------------------------------- * - * SquareCmdDeletedProc -- + * SquareDeletedProc -- * * This procedure is invoked when a widget command is deleted. If * the widget isn't already in the process of being destroyed, @@ -421,7 +455,7 @@ SquareEventProc(clientData, eventPtr) */ static void -SquareCmdDeletedProc(clientData) +SquareDeletedProc(clientData) ClientData clientData; /* Pointer to widget record for widget. */ { Square *squarePtr = (Square *) clientData; @@ -435,7 +469,6 @@ SquareCmdDeletedProc(clientData) */ if (tkwin != NULL) { - squarePtr->tkwin = NULL; Tk_DestroyWindow(tkwin); } } @@ -466,6 +499,9 @@ SquareDisplay(clientData) Tk_Window tkwin = squarePtr->tkwin; Pixmap pm = None; Drawable d; + int borderWidth, size, relief; + Tk_3DBorder bgBorder, fgBorder; + int doubleBuffer; squarePtr->updatePending = 0; if (!Tk_IsMapped(tkwin)) { @@ -476,7 +512,8 @@ SquareDisplay(clientData) * Create a pixmap for double-buffering, if necessary. */ - if (squarePtr->doubleBuffer) { + Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer); + if (doubleBuffer) { pm = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), DefaultDepthOfScreen(Tk_Screen(tkwin))); @@ -489,22 +526,29 @@ SquareDisplay(clientData) * Redraw the widget's background and border. */ - Tk_Fill3DRectangle(tkwin, d, squarePtr->bgBorder, 0, 0, Tk_Width(tkwin), - Tk_Height(tkwin), squarePtr->borderWidth, squarePtr->relief); + Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr, + &borderWidth); + bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin, + squarePtr->bgBorderPtr); + Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief); + Tk_Fill3DRectangle(tkwin, d, bgBorder, 0, 0, Tk_Width(tkwin), + Tk_Height(tkwin), borderWidth, relief); /* * Display the square. */ - Tk_Fill3DRectangle(tkwin, d, squarePtr->fgBorder, squarePtr->x, - squarePtr->y, squarePtr->size, squarePtr->size, - squarePtr->borderWidth, TK_RELIEF_RAISED); + Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size); + fgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin, + squarePtr->fgBorderPtr); + Tk_Fill3DRectangle(tkwin, d, fgBorder, squarePtr->x, squarePtr->y, size, + size, borderWidth, TK_RELIEF_RAISED); /* * If double-buffered, copy to the screen and release the pixmap. */ - if (squarePtr->doubleBuffer) { + if (doubleBuffer) { XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); @@ -535,11 +579,7 @@ SquareDestroy(memPtr) char *memPtr; /* Info about square widget. */ { Square *squarePtr = (Square *) memPtr; - - Tk_FreeOptions(configSpecs, (char *) squarePtr, squarePtr->display, 0); - if (squarePtr->gc != None) { - Tk_FreeGC(squarePtr->display, squarePtr->gc); - } + ckfree((char *) squarePtr); } @@ -565,16 +605,26 @@ static void KeepInWindow(squarePtr) register Square *squarePtr; /* Pointer to widget record. */ { - int i, bd; + int i, bd, relief; + int borderWidth, size; + + Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr, + &borderWidth); + Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->xPtr, + &squarePtr->x); + Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->yPtr, + &squarePtr->y); + Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size); + Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief); bd = 0; - if (squarePtr->relief != TK_RELIEF_FLAT) { - bd = squarePtr->borderWidth; + if (relief != TK_RELIEF_FLAT) { + bd = borderWidth; } - i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + squarePtr->size); + i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + size); if (i < 0) { squarePtr->x += i; } - i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + squarePtr->size); + i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + size); if (i < 0) { squarePtr->y += i; } diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index b3a0ff2..4e685c5 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkStubInit.c,v 1.4 1999/03/12 03:17:48 stanton Exp $ + * RCS: @(#) $Id: tkStubInit.c,v 1.5 1999/04/16 01:51:22 stanton Exp $ */ #include "tkInt.h" @@ -226,10 +226,38 @@ TkStubs tkStubs = { Tk_UnmapWindow, /* 182 */ Tk_UnsetGrid, /* 183 */ Tk_UpdatePointer, /* 184 */ + Tk_AllocBitmapFromObj, /* 185 */ + Tk_Alloc3DBorderFromObj, /* 186 */ + Tk_AllocColorFromObj, /* 187 */ + Tk_AllocCursorFromObj, /* 188 */ + Tk_AllocFontFromObj, /* 189 */ + Tk_CreateOptionTable, /* 190 */ + Tk_DeleteOptionTable, /* 191 */ + Tk_Free3DBorderFromObj, /* 192 */ + Tk_FreeBitmapFromObj, /* 193 */ + Tk_FreeColorFromObj, /* 194 */ + Tk_FreeConfigOptions, /* 195 */ + Tk_FreeSavedOptions, /* 196 */ + Tk_FreeCursorFromObj, /* 197 */ + Tk_FreeFontFromObj, /* 198 */ + Tk_Get3DBorderFromObj, /* 199 */ + Tk_GetAnchorFromObj, /* 200 */ + Tk_GetBitmapFromObj, /* 201 */ + Tk_GetColorFromObj, /* 202 */ + Tk_GetCursorFromObj, /* 203 */ + Tk_GetOptionInfo, /* 204 */ + Tk_GetOptionValue, /* 205 */ + Tk_GetJustifyFromObj, /* 206 */ + Tk_GetMMFromObj, /* 207 */ + Tk_GetPixelsFromObj, /* 208 */ + Tk_GetReliefFromObj, /* 209 */ + Tk_GetScrollInfoObj, /* 210 */ + Tk_InitOptions, /* 211 */ + Tk_MainEx, /* 212 */ + Tk_RestoreSavedOptions, /* 213 */ + Tk_SetOptions, /* 214 */ }; -TkStubs *tkStubsPtr = &tkStubs; - TkIntStubs tkIntStubs = { TCL_STUB_MAGIC, NULL, @@ -262,7 +290,7 @@ TkIntStubs tkIntStubs = { TkFontPkgInit, /* 26 */ TkFontPkgFree, /* 27 */ TkFreeBindingTags, /* 28 */ - TkFreeCursor, /* 29 */ + TkpFreeCursor, /* 29 */ TkGetBitmapData, /* 30 */ TkGetButtPoints, /* 31 */ TkGetCursorByName, /* 32 */ @@ -331,10 +359,23 @@ TkIntStubs tkIntStubs = { TkWmRestackToplevel, /* 95 */ TkWmSetClass, /* 96 */ TkWmUnmapWindow, /* 97 */ + TkDebugBitmap, /* 98 */ + TkDebugBorder, /* 99 */ + TkDebugCursor, /* 100 */ + TkDebugColor, /* 101 */ + TkDebugConfig, /* 102 */ + TkDebugFont, /* 103 */ + TkFindStateNumObj, /* 104 */ + TkGetBitmapPredefTable, /* 105 */ + TkGetDisplayList, /* 106 */ + TkGetMainInfoList, /* 107 */ + TkGetWindowFromObj, /* 108 */ + TkpGetString, /* 109 */ + TkpGetSubFonts, /* 110 */ + TkpGetSystemDefault, /* 111 */ + TkpMenuThreadInit, /* 112 */ }; -TkIntStubs *tkIntStubsPtr = &tkIntStubs; - TkIntPlatStubs tkIntPlatStubs = { TCL_STUB_MAGIC, NULL, @@ -385,6 +426,10 @@ TkIntPlatStubs tkIntPlatStubs = { TkWinWmCleanup, /* 33 */ TkWinXCleanup, /* 34 */ TkWinXInit, /* 35 */ + TkWinSetForegroundWindow, /* 36 */ + TkWinDialogDebug, /* 37 */ + TkWinGetMenuSystemDefault, /* 38 */ + TkWinGetPlatformId, /* 39 */ #endif /* __WIN32__ */ #ifdef MAC_TCL TkClipBox, /* 0 */ @@ -462,8 +507,6 @@ TkIntPlatStubs tkIntPlatStubs = { #endif /* MAC_TCL */ }; -TkIntPlatStubs *tkIntPlatStubsPtr = &tkIntPlatStubs; - TkIntXlibStubs tkIntXlibStubs = { TCL_STUB_MAGIC, NULL, @@ -549,6 +592,29 @@ TkIntXlibStubs tkIntXlibStubs = { XFilterEvent, /* 78 */ XmbLookupString, /* 79 */ TkPutImage, /* 80 */ + NULL, /* 81 */ + XParseColor, /* 82 */ + XCreateGC, /* 83 */ + XFreeGC, /* 84 */ + XInternAtom, /* 85 */ + XSetBackground, /* 86 */ + XSetForeground, /* 87 */ + XSetClipMask, /* 88 */ + XSetClipOrigin, /* 89 */ + XSetTSOrigin, /* 90 */ + XChangeGC, /* 91 */ + XSetFont, /* 92 */ + XSetArcMode, /* 93 */ + XSetStipple, /* 94 */ + XSetFillRule, /* 95 */ + XSetFillStyle, /* 96 */ + XSetFunction, /* 97 */ + XSetLineAttributes, /* 98 */ + _XInitImageFuncPtrs, /* 99 */ + XCreateIC, /* 100 */ + XGetVisualInfo, /* 101 */ + XSetWMClientMachine, /* 102 */ + XStringListToTextProperty, /* 103 */ #endif /* __WIN32__ */ #ifdef MAC_TCL NULL, /* 0 */ @@ -609,11 +675,31 @@ TkIntXlibStubs tkIntXlibStubs = { XUngrabPointer, /* 55 */ XUnmapWindow, /* 56 */ TkPutImage, /* 57 */ + XParseColor, /* 58 */ + XCreateGC, /* 59 */ + XFreeGC, /* 60 */ + XInternAtom, /* 61 */ + XSetBackground, /* 62 */ + XSetForeground, /* 63 */ + XSetClipMask, /* 64 */ + XSetClipOrigin, /* 65 */ + XSetTSOrigin, /* 66 */ + XChangeGC, /* 67 */ + XSetFont, /* 68 */ + XSetArcMode, /* 69 */ + XSetStipple, /* 70 */ + XSetFillRule, /* 71 */ + XSetFillStyle, /* 72 */ + XSetFunction, /* 73 */ + XSetLineAttributes, /* 74 */ + _XInitImageFuncPtrs, /* 75 */ + XCreateIC, /* 76 */ + XGetVisualInfo, /* 77 */ + XSetWMClientMachine, /* 78 */ + XStringListToTextProperty, /* 79 */ #endif /* MAC_TCL */ }; -TkIntXlibStubs *tkIntXlibStubsPtr = &tkIntXlibStubs; - TkPlatStubs tkPlatStubs = { TCL_STUB_MAGIC, NULL, @@ -640,8 +726,6 @@ TkPlatStubs tkPlatStubs = { #endif /* MAC_TCL */ }; -TkPlatStubs *tkPlatStubsPtr = &tkPlatStubs; - static TkStubHooks tkStubHooks = { &tkPlatStubs, &tkIntStubs, diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c index 85e5d99..438226f 100644 --- a/generic/tkStubLib.c +++ b/generic/tkStubLib.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkStubLib.c,v 1.2 1999/03/10 07:04:43 stanton Exp $ + * RCS: @(#) $Id: tkStubLib.c,v 1.3 1999/04/16 01:51:22 stanton Exp $ */ /* @@ -21,6 +21,11 @@ */ +#ifndef USE_TCL_STUBS +#define USE_TCL_STUBS +#endif +#undef USE_TCL_STUB_PROCS + #ifndef USE_TK_STUBS #define USE_TK_STUBS #endif diff --git a/generic/tkStubs.c b/generic/tkStubs.c deleted file mode 100644 index b69022e..0000000 --- a/generic/tkStubs.c +++ /dev/null @@ -1,1933 +0,0 @@ -/* - * tkStubs.c -- - * - * This file contains the wrapper functions for the platform independent - * public Tk API. - * - * Copyright (c) 1998-1999 by Scriptics Corporation. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tkStubs.c,v 1.2 1999/03/10 07:04:43 stanton Exp $ - */ - -#include "tk.h" - -/* - * Undefine function macros that will interfere with the defintions below. - */ - - -/* - * WARNING: This file is automatically generated by the tools/genStubs.tcl - * script. Any modifications to the function declarations below should be made - * in the generic/tk.decls script. - */ - -/* !BEGIN!: Do not edit below this line. */ - -/* - * Exported stub functions: - */ - -/* Slot 0 */ -void -Tk_MainLoop() -{ - (tkStubsPtr->tk_MainLoop)(); -} - -/* Slot 1 */ -XColor * -Tk_3DBorderColor(border) - Tk_3DBorder border; -{ - return (tkStubsPtr->tk_3DBorderColor)(border); -} - -/* Slot 2 */ -GC -Tk_3DBorderGC(tkwin, border, which) - Tk_Window tkwin; - Tk_3DBorder border; - int which; -{ - return (tkStubsPtr->tk_3DBorderGC)(tkwin, border, which); -} - -/* Slot 3 */ -void -Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, height, leftIn, rightIn, topBevel, relief) - Tk_Window tkwin; - Drawable drawable; - Tk_3DBorder border; - int x; - int y; - int width; - int height; - int leftIn; - int rightIn; - int topBevel; - int relief; -{ - (tkStubsPtr->tk_3DHorizontalBevel)(tkwin, drawable, border, x, y, width, height, leftIn, rightIn, topBevel, relief); -} - -/* Slot 4 */ -void -Tk_3DVerticalBevel(tkwin, drawable, border, x, y, width, height, leftBevel, relief) - Tk_Window tkwin; - Drawable drawable; - Tk_3DBorder border; - int x; - int y; - int width; - int height; - int leftBevel; - int relief; -{ - (tkStubsPtr->tk_3DVerticalBevel)(tkwin, drawable, border, x, y, width, height, leftBevel, relief); -} - -/* Slot 5 */ -void -Tk_AddOption(tkwin, name, value, priority) - Tk_Window tkwin; - char * name; - char * value; - int priority; -{ - (tkStubsPtr->tk_AddOption)(tkwin, name, value, priority); -} - -/* Slot 6 */ -void -Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) - Tk_BindingTable bindingTable; - XEvent * eventPtr; - Tk_Window tkwin; - int numObjects; - ClientData * objectPtr; -{ - (tkStubsPtr->tk_BindEvent)(bindingTable, eventPtr, tkwin, numObjects, objectPtr); -} - -/* Slot 7 */ -void -Tk_CanvasDrawableCoords(canvas, x, y, drawableXPtr, drawableYPtr) - Tk_Canvas canvas; - double x; - double y; - short * drawableXPtr; - short * drawableYPtr; -{ - (tkStubsPtr->tk_CanvasDrawableCoords)(canvas, x, y, drawableXPtr, drawableYPtr); -} - -/* Slot 8 */ -void -Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2) - Tk_Canvas canvas; - int x1; - int y1; - int x2; - int y2; -{ - (tkStubsPtr->tk_CanvasEventuallyRedraw)(canvas, x1, y1, x2, y2); -} - -/* Slot 9 */ -int -Tk_CanvasGetCoord(interp, canvas, string, doublePtr) - Tcl_Interp * interp; - Tk_Canvas canvas; - char * string; - double * doublePtr; -{ - return (tkStubsPtr->tk_CanvasGetCoord)(interp, canvas, string, doublePtr); -} - -/* Slot 10 */ -Tk_CanvasTextInfo * -Tk_CanvasGetTextInfo(canvas) - Tk_Canvas canvas; -{ - return (tkStubsPtr->tk_CanvasGetTextInfo)(canvas); -} - -/* Slot 11 */ -int -Tk_CanvasPsBitmap(interp, canvas, bitmap, x, y, width, height) - Tcl_Interp * interp; - Tk_Canvas canvas; - Pixmap bitmap; - int x; - int y; - int width; - int height; -{ - return (tkStubsPtr->tk_CanvasPsBitmap)(interp, canvas, bitmap, x, y, width, height); -} - -/* Slot 12 */ -int -Tk_CanvasPsColor(interp, canvas, colorPtr) - Tcl_Interp * interp; - Tk_Canvas canvas; - XColor * colorPtr; -{ - return (tkStubsPtr->tk_CanvasPsColor)(interp, canvas, colorPtr); -} - -/* Slot 13 */ -int -Tk_CanvasPsFont(interp, canvas, font) - Tcl_Interp * interp; - Tk_Canvas canvas; - Tk_Font font; -{ - return (tkStubsPtr->tk_CanvasPsFont)(interp, canvas, font); -} - -/* Slot 14 */ -void -Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints) - Tcl_Interp * interp; - Tk_Canvas canvas; - double * coordPtr; - int numPoints; -{ - (tkStubsPtr->tk_CanvasPsPath)(interp, canvas, coordPtr, numPoints); -} - -/* Slot 15 */ -int -Tk_CanvasPsStipple(interp, canvas, bitmap) - Tcl_Interp * interp; - Tk_Canvas canvas; - Pixmap bitmap; -{ - return (tkStubsPtr->tk_CanvasPsStipple)(interp, canvas, bitmap); -} - -/* Slot 16 */ -double -Tk_CanvasPsY(canvas, y) - Tk_Canvas canvas; - double y; -{ - return (tkStubsPtr->tk_CanvasPsY)(canvas, y); -} - -/* Slot 17 */ -void -Tk_CanvasSetStippleOrigin(canvas, gc) - Tk_Canvas canvas; - GC gc; -{ - (tkStubsPtr->tk_CanvasSetStippleOrigin)(canvas, gc); -} - -/* Slot 18 */ -int -Tk_CanvasTagsParseProc(clientData, interp, tkwin, value, widgRec, offset) - ClientData clientData; - Tcl_Interp * interp; - Tk_Window tkwin; - char * value; - char * widgRec; - int offset; -{ - return (tkStubsPtr->tk_CanvasTagsParseProc)(clientData, interp, tkwin, value, widgRec, offset); -} - -/* Slot 19 */ -char * -Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) - ClientData clientData; - Tk_Window tkwin; - char * widgRec; - int offset; - Tcl_FreeProc ** freeProcPtr; -{ - return (tkStubsPtr->tk_CanvasTagsPrintProc)(clientData, tkwin, widgRec, offset, freeProcPtr); -} - -/* Slot 20 */ -Tk_Window -Tk_CanvasTkwin(canvas) - Tk_Canvas canvas; -{ - return (tkStubsPtr->tk_CanvasTkwin)(canvas); -} - -/* Slot 21 */ -void -Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr) - Tk_Canvas canvas; - double x; - double y; - short * screenXPtr; - short * screenYPtr; -{ - (tkStubsPtr->tk_CanvasWindowCoords)(canvas, x, y, screenXPtr, screenYPtr); -} - -/* Slot 22 */ -void -Tk_ChangeWindowAttributes(tkwin, valueMask, attsPtr) - Tk_Window tkwin; - unsigned long valueMask; - XSetWindowAttributes * attsPtr; -{ - (tkStubsPtr->tk_ChangeWindowAttributes)(tkwin, valueMask, attsPtr); -} - -/* Slot 23 */ -int -Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr) - Tk_TextLayout layout; - int index; - int * xPtr; - int * yPtr; - int * widthPtr; - int * heightPtr; -{ - return (tkStubsPtr->tk_CharBbox)(layout, index, xPtr, yPtr, widthPtr, heightPtr); -} - -/* Slot 24 */ -void -Tk_ClearSelection(tkwin, selection) - Tk_Window tkwin; - Atom selection; -{ - (tkStubsPtr->tk_ClearSelection)(tkwin, selection); -} - -/* Slot 25 */ -int -Tk_ClipboardAppend(interp, tkwin, target, format, buffer) - Tcl_Interp * interp; - Tk_Window tkwin; - Atom target; - Atom format; - char* buffer; -{ - return (tkStubsPtr->tk_ClipboardAppend)(interp, tkwin, target, format, buffer); -} - -/* Slot 26 */ -int -Tk_ClipboardClear(interp, tkwin) - Tcl_Interp * interp; - Tk_Window tkwin; -{ - return (tkStubsPtr->tk_ClipboardClear)(interp, tkwin); -} - -/* Slot 27 */ -int -Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_ConfigSpec * specs; - char * widgRec; - char * argvName; - int flags; -{ - return (tkStubsPtr->tk_ConfigureInfo)(interp, tkwin, specs, widgRec, argvName, flags); -} - -/* Slot 28 */ -int -Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_ConfigSpec * specs; - char * widgRec; - char * argvName; - int flags; -{ - return (tkStubsPtr->tk_ConfigureValue)(interp, tkwin, specs, widgRec, argvName, flags); -} - -/* Slot 29 */ -int -Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_ConfigSpec * specs; - int argc; - char ** argv; - char * widgRec; - int flags; -{ - return (tkStubsPtr->tk_ConfigureWidget)(interp, tkwin, specs, argc, argv, widgRec, flags); -} - -/* Slot 30 */ -void -Tk_ConfigureWindow(tkwin, valueMask, valuePtr) - Tk_Window tkwin; - unsigned int valueMask; - XWindowChanges * valuePtr; -{ - (tkStubsPtr->tk_ConfigureWindow)(tkwin, valueMask, valuePtr); -} - -/* Slot 31 */ -Tk_TextLayout -Tk_ComputeTextLayout(font, string, numChars, wrapLength, justify, flags, widthPtr, heightPtr) - Tk_Font font; - CONST char * string; - int numChars; - int wrapLength; - Tk_Justify justify; - int flags; - int * widthPtr; - int * heightPtr; -{ - return (tkStubsPtr->tk_ComputeTextLayout)(font, string, numChars, wrapLength, justify, flags, widthPtr, heightPtr); -} - -/* Slot 32 */ -Tk_Window -Tk_CoordsToWindow(rootX, rootY, tkwin) - int rootX; - int rootY; - Tk_Window tkwin; -{ - return (tkStubsPtr->tk_CoordsToWindow)(rootX, rootY, tkwin); -} - -/* Slot 33 */ -unsigned long -Tk_CreateBinding(interp, bindingTable, object, eventString, command, append) - Tcl_Interp * interp; - Tk_BindingTable bindingTable; - ClientData object; - char * eventString; - char * command; - int append; -{ - return (tkStubsPtr->tk_CreateBinding)(interp, bindingTable, object, eventString, command, append); -} - -/* Slot 34 */ -Tk_BindingTable -Tk_CreateBindingTable(interp) - Tcl_Interp * interp; -{ - return (tkStubsPtr->tk_CreateBindingTable)(interp); -} - -/* Slot 35 */ -Tk_ErrorHandler -Tk_CreateErrorHandler(display, errNum, request, minorCode, errorProc, clientData) - Display * display; - int errNum; - int request; - int minorCode; - Tk_ErrorProc * errorProc; - ClientData clientData; -{ - return (tkStubsPtr->tk_CreateErrorHandler)(display, errNum, request, minorCode, errorProc, clientData); -} - -/* Slot 36 */ -void -Tk_CreateEventHandler(token, mask, proc, clientData) - Tk_Window token; - unsigned long mask; - Tk_EventProc * proc; - ClientData clientData; -{ - (tkStubsPtr->tk_CreateEventHandler)(token, mask, proc, clientData); -} - -/* Slot 37 */ -void -Tk_CreateGenericHandler(proc, clientData) - Tk_GenericProc * proc; - ClientData clientData; -{ - (tkStubsPtr->tk_CreateGenericHandler)(proc, clientData); -} - -/* Slot 38 */ -void -Tk_CreateImageType(typePtr) - Tk_ImageType * typePtr; -{ - (tkStubsPtr->tk_CreateImageType)(typePtr); -} - -/* Slot 39 */ -void -Tk_CreateItemType(typePtr) - Tk_ItemType * typePtr; -{ - (tkStubsPtr->tk_CreateItemType)(typePtr); -} - -/* Slot 40 */ -void -Tk_CreatePhotoImageFormat(formatPtr) - Tk_PhotoImageFormat * formatPtr; -{ - (tkStubsPtr->tk_CreatePhotoImageFormat)(formatPtr); -} - -/* Slot 41 */ -void -Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format) - Tk_Window tkwin; - Atom selection; - Atom target; - Tk_SelectionProc * proc; - ClientData clientData; - Atom format; -{ - (tkStubsPtr->tk_CreateSelHandler)(tkwin, selection, target, proc, clientData, format); -} - -/* Slot 42 */ -Tk_Window -Tk_CreateWindow(interp, parent, name, screenName) - Tcl_Interp * interp; - Tk_Window parent; - char * name; - char * screenName; -{ - return (tkStubsPtr->tk_CreateWindow)(interp, parent, name, screenName); -} - -/* Slot 43 */ -Tk_Window -Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName) - Tcl_Interp * interp; - Tk_Window tkwin; - char * pathName; - char * screenName; -{ - return (tkStubsPtr->tk_CreateWindowFromPath)(interp, tkwin, pathName, screenName); -} - -/* Slot 44 */ -int -Tk_DefineBitmap(interp, name, source, width, height) - Tcl_Interp * interp; - Tk_Uid name; - char * source; - int width; - int height; -{ - return (tkStubsPtr->tk_DefineBitmap)(interp, name, source, width, height); -} - -/* Slot 45 */ -void -Tk_DefineCursor(window, cursor) - Tk_Window window; - Tk_Cursor cursor; -{ - (tkStubsPtr->tk_DefineCursor)(window, cursor); -} - -/* Slot 46 */ -void -Tk_DeleteAllBindings(bindingTable, object) - Tk_BindingTable bindingTable; - ClientData object; -{ - (tkStubsPtr->tk_DeleteAllBindings)(bindingTable, object); -} - -/* Slot 47 */ -int -Tk_DeleteBinding(interp, bindingTable, object, eventString) - Tcl_Interp * interp; - Tk_BindingTable bindingTable; - ClientData object; - char * eventString; -{ - return (tkStubsPtr->tk_DeleteBinding)(interp, bindingTable, object, eventString); -} - -/* Slot 48 */ -void -Tk_DeleteBindingTable(bindingTable) - Tk_BindingTable bindingTable; -{ - (tkStubsPtr->tk_DeleteBindingTable)(bindingTable); -} - -/* Slot 49 */ -void -Tk_DeleteErrorHandler(handler) - Tk_ErrorHandler handler; -{ - (tkStubsPtr->tk_DeleteErrorHandler)(handler); -} - -/* Slot 50 */ -void -Tk_DeleteEventHandler(token, mask, proc, clientData) - Tk_Window token; - unsigned long mask; - Tk_EventProc * proc; - ClientData clientData; -{ - (tkStubsPtr->tk_DeleteEventHandler)(token, mask, proc, clientData); -} - -/* Slot 51 */ -void -Tk_DeleteGenericHandler(proc, clientData) - Tk_GenericProc * proc; - ClientData clientData; -{ - (tkStubsPtr->tk_DeleteGenericHandler)(proc, clientData); -} - -/* Slot 52 */ -void -Tk_DeleteImage(interp, name) - Tcl_Interp * interp; - char * name; -{ - (tkStubsPtr->tk_DeleteImage)(interp, name); -} - -/* Slot 53 */ -void -Tk_DeleteSelHandler(tkwin, selection, target) - Tk_Window tkwin; - Atom selection; - Atom target; -{ - (tkStubsPtr->tk_DeleteSelHandler)(tkwin, selection, target); -} - -/* Slot 54 */ -void -Tk_DestroyWindow(tkwin) - Tk_Window tkwin; -{ - (tkStubsPtr->tk_DestroyWindow)(tkwin); -} - -/* Slot 55 */ -char * -Tk_DisplayName(tkwin) - Tk_Window tkwin; -{ - return (tkStubsPtr->tk_DisplayName)(tkwin); -} - -/* Slot 56 */ -int -Tk_DistanceToTextLayout(layout, x, y) - Tk_TextLayout layout; - int x; - int y; -{ - return (tkStubsPtr->tk_DistanceToTextLayout)(layout, x, y); -} - -/* Slot 57 */ -void -Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief) - Tk_Window tkwin; - Drawable drawable; - Tk_3DBorder border; - XPoint * pointPtr; - int numPoints; - int borderWidth; - int leftRelief; -{ - (tkStubsPtr->tk_Draw3DPolygon)(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief); -} - -/* Slot 58 */ -void -Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width, height, borderWidth, relief) - Tk_Window tkwin; - Drawable drawable; - Tk_3DBorder border; - int x; - int y; - int width; - int height; - int borderWidth; - int relief; -{ - (tkStubsPtr->tk_Draw3DRectangle)(tkwin, drawable, border, x, y, width, height, borderWidth, relief); -} - -/* Slot 59 */ -void -Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) - Display * display; - Drawable drawable; - GC gc; - Tk_Font tkfont; - CONST char * source; - int numChars; - int x; - int y; -{ - (tkStubsPtr->tk_DrawChars)(display, drawable, gc, tkfont, source, numChars, x, y); -} - -/* Slot 60 */ -void -Tk_DrawFocusHighlight(tkwin, gc, width, drawable) - Tk_Window tkwin; - GC gc; - int width; - Drawable drawable; -{ - (tkStubsPtr->tk_DrawFocusHighlight)(tkwin, gc, width, drawable); -} - -/* Slot 61 */ -void -Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar) - Display * display; - Drawable drawable; - GC gc; - Tk_TextLayout layout; - int x; - int y; - int firstChar; - int lastChar; -{ - (tkStubsPtr->tk_DrawTextLayout)(display, drawable, gc, layout, x, y, firstChar, lastChar); -} - -/* Slot 62 */ -void -Tk_Fill3DPolygon(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief) - Tk_Window tkwin; - Drawable drawable; - Tk_3DBorder border; - XPoint * pointPtr; - int numPoints; - int borderWidth; - int leftRelief; -{ - (tkStubsPtr->tk_Fill3DPolygon)(tkwin, drawable, border, pointPtr, numPoints, borderWidth, leftRelief); -} - -/* Slot 63 */ -void -Tk_Fill3DRectangle(tkwin, drawable, border, x, y, width, height, borderWidth, relief) - Tk_Window tkwin; - Drawable drawable; - Tk_3DBorder border; - int x; - int y; - int width; - int height; - int borderWidth; - int relief; -{ - (tkStubsPtr->tk_Fill3DRectangle)(tkwin, drawable, border, x, y, width, height, borderWidth, relief); -} - -/* Slot 64 */ -Tk_PhotoHandle -Tk_FindPhoto(interp, imageName) - Tcl_Interp * interp; - char * imageName; -{ - return (tkStubsPtr->tk_FindPhoto)(interp, imageName); -} - -/* Slot 65 */ -Font -Tk_FontId(font) - Tk_Font font; -{ - return (tkStubsPtr->tk_FontId)(font); -} - -/* Slot 66 */ -void -Tk_Free3DBorder(border) - Tk_3DBorder border; -{ - (tkStubsPtr->tk_Free3DBorder)(border); -} - -/* Slot 67 */ -void -Tk_FreeBitmap(display, bitmap) - Display * display; - Pixmap bitmap; -{ - (tkStubsPtr->tk_FreeBitmap)(display, bitmap); -} - -/* Slot 68 */ -void -Tk_FreeColor(colorPtr) - XColor * colorPtr; -{ - (tkStubsPtr->tk_FreeColor)(colorPtr); -} - -/* Slot 69 */ -void -Tk_FreeColormap(display, colormap) - Display * display; - Colormap colormap; -{ - (tkStubsPtr->tk_FreeColormap)(display, colormap); -} - -/* Slot 70 */ -void -Tk_FreeCursor(display, cursor) - Display * display; - Tk_Cursor cursor; -{ - (tkStubsPtr->tk_FreeCursor)(display, cursor); -} - -/* Slot 71 */ -void -Tk_FreeFont(f) - Tk_Font f; -{ - (tkStubsPtr->tk_FreeFont)(f); -} - -/* Slot 72 */ -void -Tk_FreeGC(display, gc) - Display * display; - GC gc; -{ - (tkStubsPtr->tk_FreeGC)(display, gc); -} - -/* Slot 73 */ -void -Tk_FreeImage(image) - Tk_Image image; -{ - (tkStubsPtr->tk_FreeImage)(image); -} - -/* Slot 74 */ -void -Tk_FreeOptions(specs, widgRec, display, needFlags) - Tk_ConfigSpec * specs; - char * widgRec; - Display * display; - int needFlags; -{ - (tkStubsPtr->tk_FreeOptions)(specs, widgRec, display, needFlags); -} - -/* Slot 75 */ -void -Tk_FreePixmap(display, pixmap) - Display * display; - Pixmap pixmap; -{ - (tkStubsPtr->tk_FreePixmap)(display, pixmap); -} - -/* Slot 76 */ -void -Tk_FreeTextLayout(textLayout) - Tk_TextLayout textLayout; -{ - (tkStubsPtr->tk_FreeTextLayout)(textLayout); -} - -/* Slot 77 */ -void -Tk_FreeXId(display, xid) - Display * display; - XID xid; -{ - (tkStubsPtr->tk_FreeXId)(display, xid); -} - -/* Slot 78 */ -GC -Tk_GCForColor(colorPtr, drawable) - XColor * colorPtr; - Drawable drawable; -{ - return (tkStubsPtr->tk_GCForColor)(colorPtr, drawable); -} - -/* Slot 79 */ -void -Tk_GeometryRequest(tkwin, reqWidth, reqHeight) - Tk_Window tkwin; - int reqWidth; - int reqHeight; -{ - (tkStubsPtr->tk_GeometryRequest)(tkwin, reqWidth, reqHeight); -} - -/* Slot 80 */ -Tk_3DBorder -Tk_Get3DBorder(interp, tkwin, colorName) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_Uid colorName; -{ - return (tkStubsPtr->tk_Get3DBorder)(interp, tkwin, colorName); -} - -/* Slot 81 */ -void -Tk_GetAllBindings(interp, bindingTable, object) - Tcl_Interp * interp; - Tk_BindingTable bindingTable; - ClientData object; -{ - (tkStubsPtr->tk_GetAllBindings)(interp, bindingTable, object); -} - -/* Slot 82 */ -int -Tk_GetAnchor(interp, string, anchorPtr) - Tcl_Interp * interp; - char * string; - Tk_Anchor * anchorPtr; -{ - return (tkStubsPtr->tk_GetAnchor)(interp, string, anchorPtr); -} - -/* Slot 83 */ -char * -Tk_GetAtomName(tkwin, atom) - Tk_Window tkwin; - Atom atom; -{ - return (tkStubsPtr->tk_GetAtomName)(tkwin, atom); -} - -/* Slot 84 */ -char * -Tk_GetBinding(interp, bindingTable, object, eventString) - Tcl_Interp * interp; - Tk_BindingTable bindingTable; - ClientData object; - char * eventString; -{ - return (tkStubsPtr->tk_GetBinding)(interp, bindingTable, object, eventString); -} - -/* Slot 85 */ -Pixmap -Tk_GetBitmap(interp, tkwin, string) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_Uid string; -{ - return (tkStubsPtr->tk_GetBitmap)(interp, tkwin, string); -} - -/* Slot 86 */ -Pixmap -Tk_GetBitmapFromData(interp, tkwin, source, width, height) - Tcl_Interp * interp; - Tk_Window tkwin; - char * source; - int width; - int height; -{ - return (tkStubsPtr->tk_GetBitmapFromData)(interp, tkwin, source, width, height); -} - -/* Slot 87 */ -int -Tk_GetCapStyle(interp, string, capPtr) - Tcl_Interp * interp; - char * string; - int * capPtr; -{ - return (tkStubsPtr->tk_GetCapStyle)(interp, string, capPtr); -} - -/* Slot 88 */ -XColor * -Tk_GetColor(interp, tkwin, name) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_Uid name; -{ - return (tkStubsPtr->tk_GetColor)(interp, tkwin, name); -} - -/* Slot 89 */ -XColor * -Tk_GetColorByValue(tkwin, colorPtr) - Tk_Window tkwin; - XColor * colorPtr; -{ - return (tkStubsPtr->tk_GetColorByValue)(tkwin, colorPtr); -} - -/* Slot 90 */ -Colormap -Tk_GetColormap(interp, tkwin, string) - Tcl_Interp * interp; - Tk_Window tkwin; - char * string; -{ - return (tkStubsPtr->tk_GetColormap)(interp, tkwin, string); -} - -/* Slot 91 */ -Tk_Cursor -Tk_GetCursor(interp, tkwin, string) - Tcl_Interp * interp; - Tk_Window tkwin; - Tk_Uid string; -{ - return (tkStubsPtr->tk_GetCursor)(interp, tkwin, string); -} - -/* Slot 92 */ -Tk_Cursor -Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, xHot, yHot, fg, bg) - Tcl_Interp * interp; - Tk_Window tkwin; - char * source; - char * mask; - int width; - int height; - int xHot; - int yHot; - Tk_Uid fg; - Tk_Uid bg; -{ - return (tkStubsPtr->tk_GetCursorFromData)(interp, tkwin, source, mask, width, height, xHot, yHot, fg, bg); -} - -/* Slot 93 */ -Tk_Font -Tk_GetFont(interp, tkwin, string) - Tcl_Interp * interp; - Tk_Window tkwin; - CONST char * string; -{ - return (tkStubsPtr->tk_GetFont)(interp, tkwin, string); -} - -/* Slot 94 */ -Tk_Font -Tk_GetFontFromObj(interp, tkwin, objPtr) - Tcl_Interp * interp; - Tk_Window tkwin; - Tcl_Obj * objPtr; -{ - return (tkStubsPtr->tk_GetFontFromObj)(interp, tkwin, objPtr); -} - -/* Slot 95 */ -void -Tk_GetFontMetrics(font, fmPtr) - Tk_Font font; - Tk_FontMetrics * fmPtr; -{ - (tkStubsPtr->tk_GetFontMetrics)(font, fmPtr); -} - -/* Slot 96 */ -GC -Tk_GetGC(tkwin, valueMask, valuePtr) - Tk_Window tkwin; - unsigned long valueMask; - XGCValues * valuePtr; -{ - return (tkStubsPtr->tk_GetGC)(tkwin, valueMask, valuePtr); -} - -/* Slot 97 */ -Tk_Image -Tk_GetImage(interp, tkwin, name, changeProc, clientData) - Tcl_Interp * interp; - Tk_Window tkwin; - char * name; - Tk_ImageChangedProc * changeProc; - ClientData clientData; -{ - return (tkStubsPtr->tk_GetImage)(interp, tkwin, name, changeProc, clientData); -} - -/* Slot 98 */ -ClientData -Tk_GetImageMasterData(interp, name, typePtrPtr) - Tcl_Interp * interp; - char * name; - Tk_ImageType ** typePtrPtr; -{ - return (tkStubsPtr->tk_GetImageMasterData)(interp, name, typePtrPtr); -} - -/* Slot 99 */ -Tk_ItemType * -Tk_GetItemTypes() -{ - return (tkStubsPtr->tk_GetItemTypes)(); -} - -/* Slot 100 */ -int -Tk_GetJoinStyle(interp, string, joinPtr) - Tcl_Interp * interp; - char * string; - int * joinPtr; -{ - return (tkStubsPtr->tk_GetJoinStyle)(interp, string, joinPtr); -} - -/* Slot 101 */ -int -Tk_GetJustify(interp, string, justifyPtr) - Tcl_Interp * interp; - char * string; - Tk_Justify * justifyPtr; -{ - return (tkStubsPtr->tk_GetJustify)(interp, string, justifyPtr); -} - -/* Slot 102 */ -int -Tk_GetNumMainWindows() -{ - return (tkStubsPtr->tk_GetNumMainWindows)(); -} - -/* Slot 103 */ -Tk_Uid -Tk_GetOption(tkwin, name, className) - Tk_Window tkwin; - char * name; - char * className; -{ - return (tkStubsPtr->tk_GetOption)(tkwin, name, className); -} - -/* Slot 104 */ -int -Tk_GetPixels(interp, tkwin, string, intPtr) - Tcl_Interp * interp; - Tk_Window tkwin; - char * string; - int * intPtr; -{ - return (tkStubsPtr->tk_GetPixels)(interp, tkwin, string, intPtr); -} - -/* Slot 105 */ -Pixmap -Tk_GetPixmap(display, d, width, height, depth) - Display * display; - Drawable d; - int width; - int height; - int depth; -{ - return (tkStubsPtr->tk_GetPixmap)(display, d, width, height, depth); -} - -/* Slot 106 */ -int -Tk_GetRelief(interp, name, reliefPtr) - Tcl_Interp * interp; - char * name; - int * reliefPtr; -{ - return (tkStubsPtr->tk_GetRelief)(interp, name, reliefPtr); -} - -/* Slot 107 */ -void -Tk_GetRootCoords(tkwin, xPtr, yPtr) - Tk_Window tkwin; - int * xPtr; - int * yPtr; -{ - (tkStubsPtr->tk_GetRootCoords)(tkwin, xPtr, yPtr); -} - -/* Slot 108 */ -int -Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr) - Tcl_Interp * interp; - int argc; - char ** argv; - double * dblPtr; - int * intPtr; -{ - return (tkStubsPtr->tk_GetScrollInfo)(interp, argc, argv, dblPtr, intPtr); -} - -/* Slot 109 */ -int -Tk_GetScreenMM(interp, tkwin, string, doublePtr) - Tcl_Interp * interp; - Tk_Window tkwin; - char * string; - double * doublePtr; -{ - return (tkStubsPtr->tk_GetScreenMM)(interp, tkwin, string, doublePtr); -} - -/* Slot 110 */ -int -Tk_GetSelection(interp, tkwin, selection, target, proc, clientData) - Tcl_Interp * interp; - Tk_Window tkwin; - Atom selection; - Atom target; - Tk_GetSelProc * proc; - ClientData clientData; -{ - return (tkStubsPtr->tk_GetSelection)(interp, tkwin, selection, target, proc, clientData); -} - -/* Slot 111 */ -Tk_Uid -Tk_GetUid(string) - CONST char * string; -{ - return (tkStubsPtr->tk_GetUid)(string); -} - -/* Slot 112 */ -Visual * -Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr) - Tcl_Interp * interp; - Tk_Window tkwin; - char * string; - int * depthPtr; - Colormap * colormapPtr; -{ - return (tkStubsPtr->tk_GetVisual)(interp, tkwin, string, depthPtr, colormapPtr); -} - -/* Slot 113 */ -void -Tk_GetVRootGeometry(tkwin, xPtr, yPtr, widthPtr, heightPtr) - Tk_Window tkwin; - int * xPtr; - int * yPtr; - int * widthPtr; - int * heightPtr; -{ - (tkStubsPtr->tk_GetVRootGeometry)(tkwin, xPtr, yPtr, widthPtr, heightPtr); -} - -/* Slot 114 */ -int -Tk_Grab(interp, tkwin, grabGlobal) - Tcl_Interp * interp; - Tk_Window tkwin; - int grabGlobal; -{ - return (tkStubsPtr->tk_Grab)(interp, tkwin, grabGlobal); -} - -/* Slot 115 */ -void -Tk_HandleEvent(eventPtr) - XEvent * eventPtr; -{ - (tkStubsPtr->tk_HandleEvent)(eventPtr); -} - -/* Slot 116 */ -Tk_Window -Tk_IdToWindow(display, window) - Display * display; - Window window; -{ - return (tkStubsPtr->tk_IdToWindow)(display, window); -} - -/* Slot 117 */ -void -Tk_ImageChanged(master, x, y, width, height, imageWidth, imageHeight) - Tk_ImageMaster master; - int x; - int y; - int width; - int height; - int imageWidth; - int imageHeight; -{ - (tkStubsPtr->tk_ImageChanged)(master, x, y, width, height, imageWidth, imageHeight); -} - -/* Slot 118 */ -int -Tk_Init(interp) - Tcl_Interp * interp; -{ - return (tkStubsPtr->tk_Init)(interp); -} - -/* Slot 119 */ -Atom -Tk_InternAtom(tkwin, name) - Tk_Window tkwin; - char * name; -{ - return (tkStubsPtr->tk_InternAtom)(tkwin, name); -} - -/* Slot 120 */ -int -Tk_IntersectTextLayout(layout, x, y, width, height) - Tk_TextLayout layout; - int x; - int y; - int width; - int height; -{ - return (tkStubsPtr->tk_IntersectTextLayout)(layout, x, y, width, height); -} - -/* Slot 121 */ -void -Tk_MaintainGeometry(slave, master, x, y, width, height) - Tk_Window slave; - Tk_Window master; - int x; - int y; - int width; - int height; -{ - (tkStubsPtr->tk_MaintainGeometry)(slave, master, x, y, width, height); -} - -/* Slot 122 */ -Tk_Window -Tk_MainWindow(interp) - Tcl_Interp * interp; -{ - return (tkStubsPtr->tk_MainWindow)(interp); -} - -/* Slot 123 */ -void -Tk_MakeWindowExist(tkwin) - Tk_Window tkwin; -{ - (tkStubsPtr->tk_MakeWindowExist)(tkwin); -} - -/* Slot 124 */ -void -Tk_ManageGeometry(tkwin, mgrPtr, clientData) - Tk_Window tkwin; - Tk_GeomMgr * mgrPtr; - ClientData clientData; -{ - (tkStubsPtr->tk_ManageGeometry)(tkwin, mgrPtr, clientData); -} - -/* Slot 125 */ -void -Tk_MapWindow(tkwin) - Tk_Window tkwin; -{ - (tkStubsPtr->tk_MapWindow)(tkwin); -} - -/* Slot 126 */ -int -Tk_MeasureChars(tkfont, source, maxChars, maxPixels, flags, lengthPtr) - Tk_Font tkfont; - CONST char * source; - int maxChars; - int maxPixels; - int flags; - int * lengthPtr; -{ - return (tkStubsPtr->tk_MeasureChars)(tkfont, source, maxChars, maxPixels, flags, lengthPtr); -} - -/* Slot 127 */ -void -Tk_MoveResizeWindow(tkwin, x, y, width, height) - Tk_Window tkwin; - int x; - int y; - int width; - int height; -{ - (tkStubsPtr->tk_MoveResizeWindow)(tkwin, x, y, width, height); -} - -/* Slot 128 */ -void -Tk_MoveWindow(tkwin, x, y) - Tk_Window tkwin; - int x; - int y; -{ - (tkStubsPtr->tk_MoveWindow)(tkwin, x, y); -} - -/* Slot 129 */ -void -Tk_MoveToplevelWindow(tkwin, x, y) - Tk_Window tkwin; - int x; - int y; -{ - (tkStubsPtr->tk_MoveToplevelWindow)(tkwin, x, y); -} - -/* Slot 130 */ -char * -Tk_NameOf3DBorder(border) - Tk_3DBorder border; -{ - return (tkStubsPtr->tk_NameOf3DBorder)(border); -} - -/* Slot 131 */ -char * -Tk_NameOfAnchor(anchor) - Tk_Anchor anchor; -{ - return (tkStubsPtr->tk_NameOfAnchor)(anchor); -} - -/* Slot 132 */ -char * -Tk_NameOfBitmap(display, bitmap) - Display * display; - Pixmap bitmap; -{ - return (tkStubsPtr->tk_NameOfBitmap)(display, bitmap); -} - -/* Slot 133 */ -char * -Tk_NameOfCapStyle(cap) - int cap; -{ - return (tkStubsPtr->tk_NameOfCapStyle)(cap); -} - -/* Slot 134 */ -char * -Tk_NameOfColor(colorPtr) - XColor * colorPtr; -{ - return (tkStubsPtr->tk_NameOfColor)(colorPtr); -} - -/* Slot 135 */ -char * -Tk_NameOfCursor(display, cursor) - Display * display; - Tk_Cursor cursor; -{ - return (tkStubsPtr->tk_NameOfCursor)(display, cursor); -} - -/* Slot 136 */ -char * -Tk_NameOfFont(font) - Tk_Font font; -{ - return (tkStubsPtr->tk_NameOfFont)(font); -} - -/* Slot 137 */ -char * -Tk_NameOfImage(imageMaster) - Tk_ImageMaster imageMaster; -{ - return (tkStubsPtr->tk_NameOfImage)(imageMaster); -} - -/* Slot 138 */ -char * -Tk_NameOfJoinStyle(join) - int join; -{ - return (tkStubsPtr->tk_NameOfJoinStyle)(join); -} - -/* Slot 139 */ -char * -Tk_NameOfJustify(justify) - Tk_Justify justify; -{ - return (tkStubsPtr->tk_NameOfJustify)(justify); -} - -/* Slot 140 */ -char * -Tk_NameOfRelief(relief) - int relief; -{ - return (tkStubsPtr->tk_NameOfRelief)(relief); -} - -/* Slot 141 */ -Tk_Window -Tk_NameToWindow(interp, pathName, tkwin) - Tcl_Interp * interp; - char * pathName; - Tk_Window tkwin; -{ - return (tkStubsPtr->tk_NameToWindow)(interp, pathName, tkwin); -} - -/* Slot 142 */ -void -Tk_OwnSelection(tkwin, selection, proc, clientData) - Tk_Window tkwin; - Atom selection; - Tk_LostSelProc * proc; - ClientData clientData; -{ - (tkStubsPtr->tk_OwnSelection)(tkwin, selection, proc, clientData); -} - -/* Slot 143 */ -int -Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags) - Tcl_Interp * interp; - Tk_Window tkwin; - int * argcPtr; - char ** argv; - Tk_ArgvInfo * argTable; - int flags; -{ - return (tkStubsPtr->tk_ParseArgv)(interp, tkwin, argcPtr, argv, argTable, flags); -} - -/* Slot 144 */ -void -Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height) - Tk_PhotoHandle handle; - Tk_PhotoImageBlock * blockPtr; - int x; - int y; - int width; - int height; -{ - (tkStubsPtr->tk_PhotoPutBlock)(handle, blockPtr, x, y, width, height); -} - -/* Slot 145 */ -void -Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY, subsampleX, subsampleY) - Tk_PhotoHandle handle; - Tk_PhotoImageBlock * blockPtr; - int x; - int y; - int width; - int height; - int zoomX; - int zoomY; - int subsampleX; - int subsampleY; -{ - (tkStubsPtr->tk_PhotoPutZoomedBlock)(handle, blockPtr, x, y, width, height, zoomX, zoomY, subsampleX, subsampleY); -} - -/* Slot 146 */ -int -Tk_PhotoGetImage(handle, blockPtr) - Tk_PhotoHandle handle; - Tk_PhotoImageBlock * blockPtr; -{ - return (tkStubsPtr->tk_PhotoGetImage)(handle, blockPtr); -} - -/* Slot 147 */ -void -Tk_PhotoBlank(handle) - Tk_PhotoHandle handle; -{ - (tkStubsPtr->tk_PhotoBlank)(handle); -} - -/* Slot 148 */ -void -Tk_PhotoExpand(handle, width, height) - Tk_PhotoHandle handle; - int width; - int height; -{ - (tkStubsPtr->tk_PhotoExpand)(handle, width, height); -} - -/* Slot 149 */ -void -Tk_PhotoGetSize(handle, widthPtr, heightPtr) - Tk_PhotoHandle handle; - int * widthPtr; - int * heightPtr; -{ - (tkStubsPtr->tk_PhotoGetSize)(handle, widthPtr, heightPtr); -} - -/* Slot 150 */ -void -Tk_PhotoSetSize(handle, width, height) - Tk_PhotoHandle handle; - int width; - int height; -{ - (tkStubsPtr->tk_PhotoSetSize)(handle, width, height); -} - -/* Slot 151 */ -int -Tk_PointToChar(layout, x, y) - Tk_TextLayout layout; - int x; - int y; -{ - return (tkStubsPtr->tk_PointToChar)(layout, x, y); -} - -/* Slot 152 */ -int -Tk_PostscriptFontName(tkfont, dsPtr) - Tk_Font tkfont; - Tcl_DString * dsPtr; -{ - return (tkStubsPtr->tk_PostscriptFontName)(tkfont, dsPtr); -} - -/* Slot 153 */ -void -Tk_PreserveColormap(display, colormap) - Display * display; - Colormap colormap; -{ - (tkStubsPtr->tk_PreserveColormap)(display, colormap); -} - -/* Slot 154 */ -void -Tk_QueueWindowEvent(eventPtr, position) - XEvent * eventPtr; - Tcl_QueuePosition position; -{ - (tkStubsPtr->tk_QueueWindowEvent)(eventPtr, position); -} - -/* Slot 155 */ -void -Tk_RedrawImage(image, imageX, imageY, width, height, drawable, drawableX, drawableY) - Tk_Image image; - int imageX; - int imageY; - int width; - int height; - Drawable drawable; - int drawableX; - int drawableY; -{ - (tkStubsPtr->tk_RedrawImage)(image, imageX, imageY, width, height, drawable, drawableX, drawableY); -} - -/* Slot 156 */ -void -Tk_ResizeWindow(tkwin, width, height) - Tk_Window tkwin; - int width; - int height; -{ - (tkStubsPtr->tk_ResizeWindow)(tkwin, width, height); -} - -/* Slot 157 */ -int -Tk_RestackWindow(tkwin, aboveBelow, other) - Tk_Window tkwin; - int aboveBelow; - Tk_Window other; -{ - return (tkStubsPtr->tk_RestackWindow)(tkwin, aboveBelow, other); -} - -/* Slot 158 */ -Tk_RestrictProc * -Tk_RestrictEvents(proc, arg, prevArgPtr) - Tk_RestrictProc * proc; - ClientData arg; - ClientData * prevArgPtr; -{ - return (tkStubsPtr->tk_RestrictEvents)(proc, arg, prevArgPtr); -} - -/* Slot 159 */ -int -Tk_SafeInit(interp) - Tcl_Interp * interp; -{ - return (tkStubsPtr->tk_SafeInit)(interp); -} - -/* Slot 160 */ -char * -Tk_SetAppName(tkwin, name) - Tk_Window tkwin; - char * name; -{ - return (tkStubsPtr->tk_SetAppName)(tkwin, name); -} - -/* Slot 161 */ -void -Tk_SetBackgroundFromBorder(tkwin, border) - Tk_Window tkwin; - Tk_3DBorder border; -{ - (tkStubsPtr->tk_SetBackgroundFromBorder)(tkwin, border); -} - -/* Slot 162 */ -void -Tk_SetClass(tkwin, className) - Tk_Window tkwin; - char * className; -{ - (tkStubsPtr->tk_SetClass)(tkwin, className); -} - -/* Slot 163 */ -void -Tk_SetGrid(tkwin, reqWidth, reqHeight, gridWidth, gridHeight) - Tk_Window tkwin; - int reqWidth; - int reqHeight; - int gridWidth; - int gridHeight; -{ - (tkStubsPtr->tk_SetGrid)(tkwin, reqWidth, reqHeight, gridWidth, gridHeight); -} - -/* Slot 164 */ -void -Tk_SetInternalBorder(tkwin, width) - Tk_Window tkwin; - int width; -{ - (tkStubsPtr->tk_SetInternalBorder)(tkwin, width); -} - -/* Slot 165 */ -void -Tk_SetWindowBackground(tkwin, pixel) - Tk_Window tkwin; - unsigned long pixel; -{ - (tkStubsPtr->tk_SetWindowBackground)(tkwin, pixel); -} - -/* Slot 166 */ -void -Tk_SetWindowBackgroundPixmap(tkwin, pixmap) - Tk_Window tkwin; - Pixmap pixmap; -{ - (tkStubsPtr->tk_SetWindowBackgroundPixmap)(tkwin, pixmap); -} - -/* Slot 167 */ -void -Tk_SetWindowBorder(tkwin, pixel) - Tk_Window tkwin; - unsigned long pixel; -{ - (tkStubsPtr->tk_SetWindowBorder)(tkwin, pixel); -} - -/* Slot 168 */ -void -Tk_SetWindowBorderWidth(tkwin, width) - Tk_Window tkwin; - int width; -{ - (tkStubsPtr->tk_SetWindowBorderWidth)(tkwin, width); -} - -/* Slot 169 */ -void -Tk_SetWindowBorderPixmap(tkwin, pixmap) - Tk_Window tkwin; - Pixmap pixmap; -{ - (tkStubsPtr->tk_SetWindowBorderPixmap)(tkwin, pixmap); -} - -/* Slot 170 */ -void -Tk_SetWindowColormap(tkwin, colormap) - Tk_Window tkwin; - Colormap colormap; -{ - (tkStubsPtr->tk_SetWindowColormap)(tkwin, colormap); -} - -/* Slot 171 */ -int -Tk_SetWindowVisual(tkwin, visual, depth, colormap) - Tk_Window tkwin; - Visual * visual; - int depth; - Colormap colormap; -{ - return (tkStubsPtr->tk_SetWindowVisual)(tkwin, visual, depth, colormap); -} - -/* Slot 172 */ -void -Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr) - Display * display; - Pixmap bitmap; - int * widthPtr; - int * heightPtr; -{ - (tkStubsPtr->tk_SizeOfBitmap)(display, bitmap, widthPtr, heightPtr); -} - -/* Slot 173 */ -void -Tk_SizeOfImage(image, widthPtr, heightPtr) - Tk_Image image; - int * widthPtr; - int * heightPtr; -{ - (tkStubsPtr->tk_SizeOfImage)(image, widthPtr, heightPtr); -} - -/* Slot 174 */ -int -Tk_StrictMotif(tkwin) - Tk_Window tkwin; -{ - return (tkStubsPtr->tk_StrictMotif)(tkwin); -} - -/* Slot 175 */ -void -Tk_TextLayoutToPostscript(interp, layout) - Tcl_Interp * interp; - Tk_TextLayout layout; -{ - (tkStubsPtr->tk_TextLayoutToPostscript)(interp, layout); -} - -/* Slot 176 */ -int -Tk_TextWidth(font, string, numChars) - Tk_Font font; - CONST char * string; - int numChars; -{ - return (tkStubsPtr->tk_TextWidth)(font, string, numChars); -} - -/* Slot 177 */ -void -Tk_UndefineCursor(window) - Tk_Window window; -{ - (tkStubsPtr->tk_UndefineCursor)(window); -} - -/* Slot 178 */ -void -Tk_UnderlineChars(display, drawable, gc, tkfont, source, x, y, firstChar, lastChar) - Display * display; - Drawable drawable; - GC gc; - Tk_Font tkfont; - CONST char * source; - int x; - int y; - int firstChar; - int lastChar; -{ - (tkStubsPtr->tk_UnderlineChars)(display, drawable, gc, tkfont, source, x, y, firstChar, lastChar); -} - -/* Slot 179 */ -void -Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline) - Display * display; - Drawable drawable; - GC gc; - Tk_TextLayout layout; - int x; - int y; - int underline; -{ - (tkStubsPtr->tk_UnderlineTextLayout)(display, drawable, gc, layout, x, y, underline); -} - -/* Slot 180 */ -void -Tk_Ungrab(tkwin) - Tk_Window tkwin; -{ - (tkStubsPtr->tk_Ungrab)(tkwin); -} - -/* Slot 181 */ -void -Tk_UnmaintainGeometry(slave, master) - Tk_Window slave; - Tk_Window master; -{ - (tkStubsPtr->tk_UnmaintainGeometry)(slave, master); -} - -/* Slot 182 */ -void -Tk_UnmapWindow(tkwin) - Tk_Window tkwin; -{ - (tkStubsPtr->tk_UnmapWindow)(tkwin); -} - -/* Slot 183 */ -void -Tk_UnsetGrid(tkwin) - Tk_Window tkwin; -{ - (tkStubsPtr->tk_UnsetGrid)(tkwin); -} - -/* Slot 184 */ -void -Tk_UpdatePointer(tkwin, x, y, state) - Tk_Window tkwin; - int x; - int y; - int state; -{ - (tkStubsPtr->tk_UpdatePointer)(tkwin, x, y, state); -} - - -/* !END!: Do not edit above this line. */ diff --git a/generic/tkTest.c b/generic/tkTest.c index 0415e67..4b2fa93 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -8,15 +8,17 @@ * * Copyright (c) 1993-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTest.c,v 1.4 1999/02/04 20:57:17 stanton Exp $ + * RCS: @(#) $Id: tkTest.c,v 1.5 1999/04/16 01:51:23 stanton Exp $ */ #include "tkInt.h" -#include "tkPort.h" +#include "tkPort.h" +#include "tkText.h" #ifdef __WIN32__ #include "tkWinInt.h" @@ -102,8 +104,8 @@ static NewApp *newAppPtr = NULL; * Declaration for the square widget's class command procedure: */ -extern int SquareCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char *argv[])); +extern int SquareObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); typedef struct CBinding { Tcl_Interp *interp; @@ -112,6 +114,32 @@ typedef struct CBinding { } CBinding; /* + * Header for trivial configuration command items. + */ + +#define ODD TK_CONFIG_USER_BIT +#define EVEN (TK_CONFIG_USER_BIT << 1) + +enum { + NONE, + ODD_TYPE, + EVEN_TYPE +}; + +typedef struct TrivialCommandHeader { + Tcl_Interp *interp; /* The interp that this command + * lives in. */ + Tk_OptionTable optionTable; /* The option table that go with + * this command. */ + Tk_Window tkwin; /* For widgets, the window associated + * with this widget. */ + Tcl_Command widgetCmd; /* For widgets, the command associated + * with this widget. */ +} TrivialCommandHeader; + + + +/* * Forward declarations for procedures defined later in this file: */ @@ -124,12 +152,23 @@ static int ImageCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestcbindCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); -#ifdef __WIN32__ -static int TestclipboardCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); -#endif +static int TestbitmapObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[])); +static int TestborderObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[])); +static int TestcolorObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[])); +static int TestcursorObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[])); static int TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static int TestfontObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static int TestmakeexistCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestmenubarCmd _ANSI_ARGS_((ClientData dummy, @@ -138,14 +177,26 @@ static int TestmenubarCmd _ANSI_ARGS_((ClientData dummy, static int TestmetricsCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); #endif +static int TestobjconfigObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[])); +static int TestpropCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, char **argv)); static int TestsendCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); -static int TestpropCmd _ANSI_ARGS_((ClientData dummy, +static int TesttextCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); #if !(defined(__WIN32__) || defined(MAC_TCL)) static int TestwrapperCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); #endif +static void TrivialCmdDeletedProc _ANSI_ARGS_(( + ClientData clientData)); +static int TrivialConfigObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[])); +static void TrivialEventProc _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); /* * External (platform specific) initialization routine: @@ -153,7 +204,9 @@ static int TestwrapperCmd _ANSI_ARGS_((ClientData dummy, extern int TkplatformtestInit _ANSI_ARGS_(( Tcl_Interp *interp)); -#ifndef MAC_TCL +extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); + +#if !(defined(__WIN32__) || defined(MAC_TCL)) #define TkplatformtestInit(x) TCL_OK #endif @@ -167,7 +220,7 @@ extern int TkplatformtestInit _ANSI_ARGS_(( * * Results: * Returns a standard Tcl completion code, and leaves an error - * message in interp->result if an error occurs. + * message in the interp's result if an error occurs. * * Side effects: * Creates several test commands. @@ -189,18 +242,26 @@ Tktest_Init(interp) return TCL_ERROR; } - Tcl_CreateCommand(interp, "square", SquareCmd, + Tcl_CreateObjCommand(interp, "square", SquareObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testcbind", TestcbindCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#ifdef __WIN32__ - Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd, + Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#endif - Tcl_CreateCommand(interp, "testcbind", TestcbindCmd, + Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd, @@ -213,12 +274,20 @@ Tktest_Init(interp) (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsend", TestsendCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testtext", TesttextCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); #if !(defined(__WIN32__) || defined(MAC_TCL)) Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); #endif -/* +#ifdef TCL_THREADS + if (TclThread_Init(interp) != TCL_OK) { + return TCL_ERROR; + } +#endif + + /* * Create test image type. */ @@ -237,48 +306,6 @@ Tktest_Init(interp) /* *---------------------------------------------------------------------- * - * TestclipboardCmd -- - * - * This procedure implements the testclipboard command. It provides - * a way to determine the actual contents of the Windows clipboard. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifdef __WIN32__ -static int -TestclipboardCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ -{ - TkWindow *winPtr = (TkWindow *) clientData; - HGLOBAL handle; - char *data; - - if (OpenClipboard(NULL)) { - handle = GetClipboardData(CF_TEXT); - if (handle != NULL) { - data = GlobalLock(handle); - Tcl_AppendResult(interp, data, (char *) NULL); - GlobalUnlock(handle); - } - CloseClipboard(); - } - return TCL_OK; -} -#endif - -/* - *---------------------------------------------------------------------- - * * TestcbindCmd -- * * This procedure implements the "testcbinding" command. It provides @@ -386,6 +413,146 @@ CBindingFreeProc(clientData) /* *---------------------------------------------------------------------- * + * TestbitmapObjCmd -- + * + * This procedure implements the "testbitmap" command, which is used + * to test color resource handling in tkBitmap tmp.c. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestbitmapObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "bitmap"); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, TkDebugBitmap(Tk_MainWindow(interp), + Tcl_GetString(objv[1]))); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestborderObjCmd -- + * + * This procedure implements the "testborder" command, which is used + * to test color resource handling in tkBorder.c. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestborderObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "border"); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, TkDebugBorder(Tk_MainWindow(interp), + Tcl_GetString(objv[1]))); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestcolorObjCmd -- + * + * This procedure implements the "testcolor" command, which is used + * to test color resource handling in tkColor.c. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestcolorObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "color"); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, TkDebugColor(Tk_MainWindow(interp), + Tcl_GetString(objv[1]))); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestcursorObjCmd -- + * + * This procedure implements the "testcursor" command, which is used + * to test color resource handling in tkCursor.c. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestcursorObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "cursor"); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, TkDebugCursor(Tk_MainWindow(interp), + Tcl_GetString(objv[1]))); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestdeleteappsCmd -- * * This procedure implements the "testdeleteapps" command. It cleans @@ -424,6 +591,956 @@ TestdeleteappsCmd(clientData, interp, argc, argv) /* *---------------------------------------------------------------------- * + * TestobjconfigObjCmd -- + * + * This procedure implements the "testobjconfig" command, + * which is used to test the procedures in tkConfig.c. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestobjconfigObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + static char *options[] = {"alltypes", "chain1", "chain2", + "configerror", "delete", "info", "internal", "new", + "notenoughparams", "twowindows", (char *) NULL}; + enum { + ALL_TYPES, + CHAIN1, + CHAIN2, + CONFIG_ERROR, + DEL, /* Can't use DELETE: VC++ compiler barfs. */ + INFO, + INTERNAL, + NEW, + NOT_ENOUGH_PARAMS, + TWO_WINDOWS + }; + static Tk_OptionTable tables[11]; /* Holds pointers to option tables + * created by commands below; indexed + * with same values as "options" + * array. */ + Tk_Window mainWin = (Tk_Window) clientData; + Tk_Window tkwin; + int index, result = TCL_OK; + + /* + * Structures used by the "chain1" subcommand and also shared by + * the "chain2" subcommand: + */ + + typedef struct ExtensionWidgetRecord { + TrivialCommandHeader header; + Tcl_Obj *base1ObjPtr; + Tcl_Obj *base2ObjPtr; + Tcl_Obj *extension3ObjPtr; + Tcl_Obj *extension4ObjPtr; + Tcl_Obj *extension5ObjPtr; + } ExtensionWidgetRecord; + static Tk_OptionSpec baseSpecs[] = { + {TK_OPTION_STRING, + "-one", "one", "One", "one", + Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1}, + {TK_OPTION_STRING, + "-two", "two", "Two", "two", + Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1}, + {TK_OPTION_END} + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "command"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index) + != TCL_OK) { + return TCL_ERROR; + } + + switch (index) { + case ALL_TYPES: { + typedef struct TypesRecord { + TrivialCommandHeader header; + Tcl_Obj *booleanPtr; + Tcl_Obj *integerPtr; + Tcl_Obj *doublePtr; + Tcl_Obj *stringPtr; + Tcl_Obj *stringTablePtr; + Tcl_Obj *colorPtr; + Tcl_Obj *fontPtr; + Tcl_Obj *bitmapPtr; + Tcl_Obj *borderPtr; + Tcl_Obj *reliefPtr; + Tcl_Obj *cursorPtr; + Tcl_Obj *activeCursorPtr; + Tcl_Obj *justifyPtr; + Tcl_Obj *anchorPtr; + Tcl_Obj *pixelPtr; + Tcl_Obj *mmPtr; + } TypesRecord; + TypesRecord *recordPtr; + static char *stringTable[] = {"one", "two", "three", "four", + (char *) NULL}; + static Tk_OptionSpec typesSpecs[] = { + {TK_OPTION_BOOLEAN, + "-boolean", "boolean", "Boolean", + "1", Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1}, + {TK_OPTION_INT, + "-integer", "integer", "Integer", + "7", Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2}, + {TK_OPTION_DOUBLE, + "-double", "double", "Double", + "3.14159", Tk_Offset(TypesRecord, doublePtr), -1, 0, 0, + 0x4}, + {TK_OPTION_STRING, + "-string", "string", "String", + "foo", Tk_Offset(TypesRecord, stringPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x8}, + {TK_OPTION_STRING_TABLE, + "-stringtable", "StringTable", "stringTable", + "one", Tk_Offset(TypesRecord, stringTablePtr), -1, + TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10}, + {TK_OPTION_COLOR, + "-color", "color", "Color", + "red", Tk_Offset(TypesRecord, colorPtr), -1, + TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, + {TK_OPTION_FONT, + "-font", "font", "Font", + "Helvetica 12", + Tk_Offset(TypesRecord, fontPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x40}, + {TK_OPTION_BITMAP, + "-bitmap", "bitmap", "Bitmap", + "gray50", + Tk_Offset(TypesRecord, bitmapPtr), -1, + 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_OPTION_RELIEF, + "-relief", "relief", "Relief", + "raised", + Tk_Offset(TypesRecord, reliefPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x200}, + {TK_OPTION_CURSOR, + "-cursor", "cursor", "Cursor", + "xterm", + Tk_Offset(TypesRecord, cursorPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x400}, + {TK_OPTION_JUSTIFY, + "-justify", (char *) NULL, (char *) NULL, + "left", + Tk_Offset(TypesRecord, justifyPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x800}, + {TK_OPTION_ANCHOR, + "-anchor", "anchor", "Anchor", + (char *) NULL, + Tk_Offset(TypesRecord, anchorPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x1000}, + {TK_OPTION_PIXELS, + "-pixel", "pixel", "Pixel", + "1", Tk_Offset(TypesRecord, pixelPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x2000}, + {TK_OPTION_SYNONYM, + "-synonym", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-color", + 0x8000}, + {TK_OPTION_END} + }; + Tk_OptionTable optionTable; + Tk_Window tkwin; + optionTable = Tk_CreateOptionTable(interp, + typesSpecs); + tables[index] = optionTable; + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + Tk_SetClass(tkwin, "Test"); + + recordPtr = (TypesRecord *) ckalloc(sizeof(TypesRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->booleanPtr = NULL; + recordPtr->integerPtr = NULL; + recordPtr->doublePtr = NULL; + recordPtr->stringPtr = NULL; + recordPtr->colorPtr = NULL; + recordPtr->fontPtr = NULL; + recordPtr->bitmapPtr = NULL; + recordPtr->borderPtr = NULL; + recordPtr->reliefPtr = NULL; + recordPtr->cursorPtr = NULL; + recordPtr->justifyPtr = NULL; + recordPtr->anchorPtr = NULL; + recordPtr->pixelPtr = NULL; + recordPtr->mmPtr = NULL; + recordPtr->stringTablePtr = NULL; + result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + tkwin); + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetStringFromObj(objv[2], NULL), + TrivialConfigObjCmd, (ClientData) recordPtr, + TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + result = Tk_SetOptions(interp, (char *) recordPtr, + optionTable, objc - 3, objv + 3, tkwin, + (Tk_SavedOptions *) NULL, (int *) NULL); + if (result != TCL_OK) { + Tk_DestroyWindow(tkwin); + } + } else { + Tk_DestroyWindow(tkwin); + ckfree((char *) recordPtr); + } + if (result == TCL_OK) { + Tcl_SetObjResult(interp, objv[2]); + } + break; + } + + case CHAIN1: { + ExtensionWidgetRecord *recordPtr; + Tk_Window tkwin; + Tk_OptionTable optionTable; + + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + Tk_SetClass(tkwin, "Test"); + optionTable = Tk_CreateOptionTable(interp, baseSpecs); + tables[index] = optionTable; + + recordPtr = (ExtensionWidgetRecord *) ckalloc( + sizeof(ExtensionWidgetRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; + recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; + result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + tkwin); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL, + (int *) NULL); + if (result != TCL_OK) { + Tk_FreeConfigOptions((char *) recordPtr, optionTable, + tkwin); + } + } + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetStringFromObj(objv[2], NULL), + TrivialConfigObjCmd, (ClientData) recordPtr, + TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + Tcl_SetObjResult(interp, objv[2]); + } + break; + } + + case CHAIN2: { + ExtensionWidgetRecord *recordPtr; + static Tk_OptionSpec extensionSpecs[] = { + {TK_OPTION_STRING, + "-three", "three", "Three", "three", + Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), + -1}, + {TK_OPTION_STRING, + "-four", "four", "Four", "four", + Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), + -1}, + {TK_OPTION_STRING, + "-two", "two", "Two", "two and a half", + Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), + -1}, + {TK_OPTION_STRING, + "-oneAgain", "oneAgain", "OneAgain", "one again", + Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), + -1}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) baseSpecs} + }; + Tk_Window tkwin; + Tk_OptionTable optionTable; + + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + Tk_SetClass(tkwin, "Test"); + optionTable = Tk_CreateOptionTable(interp, extensionSpecs); + tables[index] = optionTable; + + recordPtr = (ExtensionWidgetRecord *) ckalloc( + sizeof(ExtensionWidgetRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; + recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; + recordPtr->extension5ObjPtr = NULL; + result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + tkwin); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL, + (int *) NULL); + if (result != TCL_OK) { + Tk_FreeConfigOptions((char *) recordPtr, optionTable, + tkwin); + } + } + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetStringFromObj(objv[2], NULL), + TrivialConfigObjCmd, (ClientData) recordPtr, + TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + Tcl_SetObjResult(interp, objv[2]); + } + break; + } + + case CONFIG_ERROR: { + typedef struct ErrorWidgetRecord { + Tcl_Obj *intPtr; + } ErrorWidgetRecord; + ErrorWidgetRecord widgetRecord; + static Tk_OptionSpec errorSpecs[] = { + {TK_OPTION_INT, + "-int", "integer", "Integer", + "bogus", Tk_Offset(ErrorWidgetRecord, intPtr)}, + {TK_OPTION_END} + }; + Tk_OptionTable optionTable; + + widgetRecord.intPtr = NULL; + optionTable = Tk_CreateOptionTable(interp, errorSpecs); + tables[index] = optionTable; + return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable, + (Tk_Window) NULL); + } + + case DEL: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "tableName"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + if (tables[index] != NULL) { + Tk_DeleteOptionTable(tables[index]); + } + break; + } + + case INFO: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "tableName"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index])); + break; + } + + case INTERNAL: { + /* + * This command is similar to the "alltypes" command except + * that it stores all the configuration options as internal + * forms instead of objects. + */ + + typedef struct InternalRecord { + TrivialCommandHeader header; + int boolean; + int integer; + double doubleValue; + char *string; + int index; + XColor *colorPtr; + Tk_Font tkfont; + Pixmap bitmap; + Tk_3DBorder border; + int relief; + Tk_Cursor cursor; + Tk_Justify justify; + Tk_Anchor anchor; + int pixels; + double mm; + Tk_Window tkwin; + } InternalRecord; + InternalRecord *recordPtr; + static char *internalStringTable[] = { + "one", "two", "three", "four", (char *) NULL + }; + static Tk_OptionSpec internalSpecs[] = { + {TK_OPTION_BOOLEAN, + "-boolean", "boolean", "Boolean", + "1", -1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1}, + {TK_OPTION_INT, + "-integer", "integer", "Integer", + "148962237", -1, Tk_Offset(InternalRecord, integer), + 0, 0, 0x2}, + {TK_OPTION_DOUBLE, + "-double", "double", "Double", + "3.14159", -1, Tk_Offset(InternalRecord, doubleValue), + 0, 0, 0x4}, + {TK_OPTION_STRING, + "-string", "string", "String", + "foo", -1, Tk_Offset(InternalRecord, string), + TK_CONFIG_NULL_OK, 0, 0x8}, + {TK_OPTION_STRING_TABLE, + "-stringtable", "StringTable", "stringTable", + "one", -1, Tk_Offset(InternalRecord, index), + TK_CONFIG_NULL_OK, (ClientData) internalStringTable, + 0x10}, + {TK_OPTION_COLOR, + "-color", "color", "Color", + "red", -1, Tk_Offset(InternalRecord, colorPtr), + TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, + {TK_OPTION_FONT, + "-font", "font", "Font", + "Helvetica 12", -1, Tk_Offset(InternalRecord, tkfont), + TK_CONFIG_NULL_OK, 0, 0x40}, + {TK_OPTION_BITMAP, + "-bitmap", "bitmap", "Bitmap", + "gray50", -1, Tk_Offset(InternalRecord, bitmap), + 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_OPTION_RELIEF, + "-relief", "relief", "Relief", + "raised", -1, Tk_Offset(InternalRecord, relief), + TK_CONFIG_NULL_OK, 0, 0x200}, + {TK_OPTION_CURSOR, + "-cursor", "cursor", "Cursor", + "xterm", -1, Tk_Offset(InternalRecord, cursor), + TK_CONFIG_NULL_OK, 0, 0x400}, + {TK_OPTION_JUSTIFY, + "-justify", (char *) NULL, (char *) NULL, + "left", -1, Tk_Offset(InternalRecord, justify), + TK_CONFIG_NULL_OK, 0, 0x800}, + {TK_OPTION_ANCHOR, + "-anchor", "anchor", "Anchor", + (char *) NULL, -1, Tk_Offset(InternalRecord, anchor), + TK_CONFIG_NULL_OK, 0, 0x1000}, + {TK_OPTION_PIXELS, + "-pixel", "pixel", "Pixel", + "1", -1, Tk_Offset(InternalRecord, pixels), + TK_CONFIG_NULL_OK, 0, 0x2000}, + {TK_OPTION_WINDOW, + "-window", "window", "Window", + (char *) NULL, -1, Tk_Offset(InternalRecord, tkwin), + TK_CONFIG_NULL_OK, 0, 0}, + {TK_OPTION_SYNONYM, + "-synonym", (char *) NULL, (char *) NULL, + (char *) NULL, -1, -1, 0, (ClientData) "-color", + 0x8000}, + {TK_OPTION_END} + }; + Tk_OptionTable optionTable; + Tk_Window tkwin; + optionTable = Tk_CreateOptionTable(interp, internalSpecs); + tables[index] = optionTable; + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + Tk_SetClass(tkwin, "Test"); + + recordPtr = (InternalRecord *) ckalloc(sizeof(InternalRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->boolean = 0; + recordPtr->integer = 0; + recordPtr->doubleValue = 0.0; + recordPtr->string = NULL; + recordPtr->index = 0; + recordPtr->colorPtr = NULL; + recordPtr->tkfont = NULL; + recordPtr->bitmap = None; + recordPtr->border = NULL; + recordPtr->relief = TK_RELIEF_FLAT; + recordPtr->cursor = NULL; + recordPtr->justify = TK_JUSTIFY_LEFT; + recordPtr->anchor = TK_ANCHOR_N; + recordPtr->pixels = 0; + recordPtr->mm = 0.0; + recordPtr->tkwin = NULL; + result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + tkwin); + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetStringFromObj(objv[2], NULL), + TrivialConfigObjCmd, (ClientData) recordPtr, + TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + result = Tk_SetOptions(interp, (char *) recordPtr, + optionTable, objc - 3, objv + 3, tkwin, + (Tk_SavedOptions *) NULL, (int *) NULL); + if (result != TCL_OK) { + Tk_DestroyWindow(tkwin); + } + } else { + Tk_DestroyWindow(tkwin); + ckfree((char *) recordPtr); + } + if (result == TCL_OK) { + Tcl_SetObjResult(interp, objv[2]); + } + break; + } + + case NEW: { + typedef struct FiveRecord { + TrivialCommandHeader header; + Tcl_Obj *one; + Tcl_Obj *two; + Tcl_Obj *three; + Tcl_Obj *four; + Tcl_Obj *five; + } FiveRecord; + FiveRecord *recordPtr; + static Tk_OptionSpec smallSpecs[] = { + {TK_OPTION_INT, + "-one", "one", "One", + "1", + Tk_Offset(FiveRecord, one), -1}, + {TK_OPTION_INT, + "-two", "two", "Two", + "2", + Tk_Offset(FiveRecord, two), -1}, + {TK_OPTION_INT, + "-three", "three", "Three", + "3", + Tk_Offset(FiveRecord, three), -1}, + {TK_OPTION_INT, + "-four", "four", "Four", + "4", + Tk_Offset(FiveRecord, four), -1}, + {TK_OPTION_STRING, + "-five", NULL, NULL, + NULL, + Tk_Offset(FiveRecord, five), -1}, + {TK_OPTION_END} + }; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "new name ?options?"); + return TCL_ERROR; + } + + recordPtr = (FiveRecord *) ckalloc(sizeof(FiveRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = Tk_CreateOptionTable(interp, + smallSpecs); + tables[index] = recordPtr->header.optionTable; + recordPtr->header.tkwin = NULL; + recordPtr->one = recordPtr->two = recordPtr->three = NULL; + recordPtr->four = recordPtr->five = NULL; + Tcl_SetObjResult(interp, objv[2]); + result = Tk_InitOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, (Tk_Window) NULL); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, objc - 3, objv + 3, + (Tk_Window) NULL, (Tk_SavedOptions *) NULL, + (int *) NULL); + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetStringFromObj(objv[2], NULL), + TrivialConfigObjCmd, (ClientData) recordPtr, + TrivialCmdDeletedProc); + } else { + Tk_FreeConfigOptions((char *) recordPtr, + recordPtr->header.optionTable, (Tk_Window) NULL); + } + } + if (result != TCL_OK) { + ckfree((char *) recordPtr); + } + + break; + } + case NOT_ENOUGH_PARAMS: { + typedef struct NotEnoughRecord { + Tcl_Obj *fooObjPtr; + } NotEnoughRecord; + NotEnoughRecord record; + static Tk_OptionSpec errorSpecs[] = { + {TK_OPTION_INT, + "-foo", "foo", "Foo", + "0", Tk_Offset(NotEnoughRecord, fooObjPtr)}, + {TK_OPTION_END} + }; + Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1); + Tk_OptionTable optionTable; + + record.fooObjPtr = NULL; + + tkwin = Tk_CreateWindowFromPath(interp, mainWin, + ".config", (char *) NULL); + Tk_SetClass(tkwin, "Config"); + optionTable = Tk_CreateOptionTable(interp, errorSpecs); + tables[index] = optionTable; + Tk_InitOptions(interp, (char *) &record, optionTable, tkwin); + if (Tk_SetOptions(interp, (char *) &record, optionTable, + 1, &newObjPtr, tkwin, (Tk_SavedOptions *) NULL, + (int *) NULL) + != TCL_OK) { + result = TCL_ERROR; + } + Tcl_DecrRefCount(newObjPtr); + Tk_FreeConfigOptions( (char *) &record, optionTable, tkwin); + Tk_DestroyWindow(tkwin); + return result; + } + + case TWO_WINDOWS: { + typedef struct SlaveRecord { + TrivialCommandHeader header; + Tcl_Obj *windowPtr; + } SlaveRecord; + SlaveRecord *recordPtr; + static Tk_OptionSpec slaveSpecs[] = { + {TK_OPTION_WINDOW, + "-window", "window", "Window", + ".bar", Tk_Offset(SlaveRecord, windowPtr), -1, + TK_CONFIG_NULL_OK}, + {TK_OPTION_END} + }; + Tk_Window tkwin = Tk_CreateWindowFromPath(interp, + (Tk_Window) clientData, + Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + Tk_SetClass(tkwin, "Test"); + + recordPtr = (SlaveRecord *) ckalloc(sizeof(SlaveRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = Tk_CreateOptionTable(interp, + slaveSpecs); + tables[index] = recordPtr->header.optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->windowPtr = NULL; + + result = Tk_InitOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, tkwin); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, objc - 3, objv + 3, + tkwin, (Tk_SavedOptions *) NULL, (int *) NULL); + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetStringFromObj(objv[2], NULL), + TrivialConfigObjCmd, (ClientData) recordPtr, + TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + Tcl_SetObjResult(interp, objv[2]); + } else { + Tk_FreeConfigOptions((char *) recordPtr, + recordPtr->header.optionTable, tkwin); + } + } + if (result != TCL_OK) { + Tk_DestroyWindow(tkwin); + ckfree((char *) recordPtr); + } + + } + } + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TrivialConfigObjCmd -- + * + * This command is used to test the configuration package. It only + * handles the "configure" and "cget" subcommands. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TrivialConfigObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + int result = TCL_OK; + static char *options[] = {"cget", "configure", "csave", (char *) NULL}; + enum { + CGET, CONFIGURE, CSAVE + }; + Tcl_Obj *resultObjPtr; + int index, mask; + TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData; + Tk_Window tkwin = headerPtr->tkwin; + Tk_SavedOptions saved; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", + 0, &index) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_Preserve(clientData); + + switch (index) { + case CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); + result = TCL_ERROR; + goto done; + } + resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData, + headerPtr->optionTable, objv[2], tkwin); + if (resultObjPtr != NULL) { + Tcl_SetObjResult(interp, resultObjPtr); + result = TCL_OK; + } else { + result = TCL_ERROR; + } + break; + } + case CONFIGURE: { + if (objc == 2) { + resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, + headerPtr->optionTable, (Tcl_Obj *) NULL, tkwin); + if (resultObjPtr == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObjPtr); + } + } else if (objc == 3) { + resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, + headerPtr->optionTable, objv[2], tkwin); + if (resultObjPtr == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObjPtr); + } + } else { + result = Tk_SetOptions(interp, (char *) clientData, + headerPtr->optionTable, objc - 2, objv + 2, + tkwin, (Tk_SavedOptions *) NULL, &mask); + if (result == TCL_OK) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), mask); + } + } + break; + } + case CSAVE: { + result = Tk_SetOptions(interp, (char *) clientData, + headerPtr->optionTable, objc - 2, objv + 2, + tkwin, &saved, &mask); + Tk_FreeSavedOptions(&saved); + if (result == TCL_OK) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), mask); + } + break; + } + } +done: + Tcl_Release(clientData); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TrivialCmdDeletedProc -- + * + * This procedure is invoked when a widget command is deleted. If + * the widget isn't already in the process of being destroyed, + * this command destroys it. + * + * Results: + * None. + * + * Side effects: + * The widget is destroyed. + * + *---------------------------------------------------------------------- + */ + +static void +TrivialCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData; + Tk_Window tkwin = headerPtr->tkwin; + + if (tkwin != NULL) { + Tk_DestroyWindow(tkwin); + } else if (headerPtr->optionTable != NULL) { + /* + * This is a "new" object, which doesn't have a window, so + * we can't depend on cleaning up in the event procedure. + * Free its resources here. + */ + + Tk_FreeConfigOptions((char *) clientData, + headerPtr->optionTable, (Tk_Window) NULL); + Tcl_EventuallyFree(clientData, TCL_DYNAMIC); + } +} + +/* + *-------------------------------------------------------------- + * + * TrivialEventProc -- + * + * A dummy event proc. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. + * + *-------------------------------------------------------------- + */ + +static void +TrivialEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + XEvent *eventPtr; /* Information about event. */ +{ + TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData; + + if (eventPtr->type == DestroyNotify) { + if (headerPtr->tkwin != NULL) { + Tk_FreeConfigOptions((char *) clientData, + headerPtr->optionTable, headerPtr->tkwin); + headerPtr->optionTable = NULL; + headerPtr->tkwin = NULL; + Tcl_DeleteCommandFromToken(headerPtr->interp, + headerPtr->widgetCmd); + } + Tcl_EventuallyFree(clientData, TCL_DYNAMIC); + } +} + +/* + *---------------------------------------------------------------------- + * + * TestfontObjCmd -- + * + * This procedure implements the "testfont" command, which is used + * to test TkFont objects. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestfontObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + static char *options[] = {"counts", "subfonts", (char *) NULL}; + enum option {COUNTS, SUBFONTS}; + int index; + Tk_Window tkwin; + Tk_Font tkfont; + + tkwin = (Tk_Window) clientData; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "option fontName"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index) + != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum option) index) { + case COUNTS: { + Tcl_SetObjResult(interp, TkDebugFont(Tk_MainWindow(interp), + Tcl_GetString(objv[2]))); + break; + } + case SUBFONTS: { + tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]); + if (tkfont == NULL) { + return TCL_ERROR; + } + TkpGetSubFonts(interp, tkfont); + Tk_FreeFont(tkfont); + break; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * ImageCreate -- * * This procedure is called by the Tk image code to create "test" @@ -523,7 +1640,8 @@ ImageCmd(clientData, interp, argc, argv) 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", + argv[0], + " changed x y width height imageWidth imageHeight", (char *) NULL); return TCL_ERROR; } @@ -617,7 +1735,7 @@ ImageDisplay(clientData, display, drawable, imageX, imageY, width, height, * imageX and imageY. */ { TImageInstance *instPtr = (TImageInstance *) clientData; - char buffer[200]; + char buffer[200 + TCL_INTEGER_SPACE * 6]; sprintf(buffer, "%s display %d %d %d %d %d %d", instPtr->masterPtr->imageName, imageX, imageY, width, height, @@ -734,12 +1852,12 @@ TestmakeexistCmd(clientData, interp, argc, argv) int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { - Tk_Window mainwin = (Tk_Window) clientData; + Tk_Window mainWin = (Tk_Window) clientData; int i; Tk_Window tkwin; for (i = 1; i < argc; i++) { - tkwin = Tk_NameToWindow(interp, argv[i], mainwin); + tkwin = Tk_NameToWindow(interp, argv[i], mainWin); if (tkwin == NULL) { return TCL_ERROR; } @@ -776,7 +1894,7 @@ TestmenubarCmd(clientData, interp, argc, argv) char **argv; /* Argument strings. */ { #ifdef __UNIX__ - Tk_Window mainwin = (Tk_Window) clientData; + Tk_Window mainWin = (Tk_Window) clientData; Tk_Window tkwin, menubar; if (argc < 2) { @@ -791,14 +1909,14 @@ TestmenubarCmd(clientData, interp, argc, argv) "window toplevel menubar\"", (char *) NULL); return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, argv[2], mainwin); + tkwin = Tk_NameToWindow(interp, argv[2], mainWin); if (tkwin == NULL) { return TCL_ERROR; } if (argv[3][0] == 0) { TkUnixSetMenubar(tkwin, NULL); } else { - menubar = Tk_NameToWindow(interp, argv[3], mainwin); + menubar = Tk_NameToWindow(interp, argv[3], mainWin); if (menubar == NULL) { return TCL_ERROR; } @@ -812,7 +1930,8 @@ TestmenubarCmd(clientData, interp, argc, argv) return TCL_OK; #else - interp->result = "testmenubar is supported only under Unix"; + Tcl_SetResult(interp, "testmenubar is supported only under Unix", + TCL_STATIC); return TCL_ERROR; #endif } @@ -842,7 +1961,7 @@ TestmetricsCmd(clientData, interp, argc, argv) int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { - char buf[200]; + char buf[TCL_INTEGER_SPACE]; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], @@ -874,7 +1993,7 @@ TestmetricsCmd(clientData, interp, argc, argv) { Tk_Window tkwin = (Tk_Window) clientData; TkWindow *winPtr; - char buf[200]; + char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], @@ -927,7 +2046,7 @@ TestpropCmd(clientData, interp, argc, argv) int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { - Tk_Window mainwin = (Tk_Window) clientData; + Tk_Window mainWin = (Tk_Window) clientData; int result, actualFormat; unsigned long bytesAfter, length, value; Atom actualType, propName; @@ -942,9 +2061,9 @@ TestpropCmd(clientData, interp, argc, argv) } w = strtoul(argv[1], &end, 0); - propName = Tk_InternAtom(mainwin, argv[2]); + propName = Tk_InternAtom(mainWin, argv[2]); property = NULL; - result = XGetWindowProperty(Tk_Display(mainwin), + result = XGetWindowProperty(Tk_Display(mainWin), w, propName, 0, 100000, False, AnyPropertyType, &actualType, &actualFormat, &length, &bytesAfter, (unsigned char **) &property); @@ -1005,7 +2124,9 @@ TestsendCmd(clientData, interp, argc, argv) int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { +#if !(defined(__WIN32__) || defined(MAC_TCL)) TkWindow *winPtr = (TkWindow *) clientData; +#endif if (argc < 2) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], @@ -1073,7 +2194,10 @@ TestsendCmd(clientData, interp, argc, argv) } } } else if (strcmp(argv[1], "serial") == 0) { - sprintf(interp->result, "%d", tkSendSerial+1); + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "%d", tkSendSerial+1); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be bogus, prop, or serial", (char *) NULL); @@ -1083,6 +2207,85 @@ TestsendCmd(clientData, interp, argc, argv) return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * TesttextCmd -- + * + * This procedure implements the "testtext" command. It provides + * a set of functions for testing text widgets and the associated + * functions in tkText*.c. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Depends on option; see below. + * + *---------------------------------------------------------------------- + */ + +static int +TesttextCmd(clientData, interp, argc, argv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + TkText *textPtr; + size_t len; + int lineIndex, byteIndex, byteOffset; + TkTextIndex index; + char buf[64]; + Tcl_CmdInfo info; + + if (argc < 3) { + return TCL_ERROR; + } + + if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) { + return TCL_ERROR; + } + textPtr = (TkText *) info.clientData; + len = strlen(argv[2]); + if (strncmp(argv[2], "byteindex", len) == 0) { + if (argc != 5) { + return TCL_ERROR; + } + lineIndex = atoi(argv[3]) - 1; + byteIndex = atoi(argv[4]); + + TkTextMakeByteIndex(textPtr->tree, lineIndex, byteIndex, &index); + } else if (strncmp(argv[2], "forwbytes", len) == 0) { + if (argc != 5) { + return TCL_ERROR; + } + if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + return TCL_ERROR; + } + byteOffset = atoi(argv[4]); + TkTextIndexForwBytes(&index, byteOffset, &index); + } else if (strncmp(argv[2], "backbytes", len) == 0) { + if (argc != 5) { + return TCL_ERROR; + } + if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + return TCL_ERROR; + } + byteOffset = atoi(argv[4]); + TkTextIndexBackBytes(&index, byteOffset, &index); + } else { + return TCL_ERROR; + } + + TkTextSetMark(textPtr, "insert", &index); + TkTextPrintIndex(&index, buf); + sprintf(buf + strlen(buf), " %d", index.byteIndex); + Tcl_AppendResult(interp, buf, NULL); + + return TCL_OK; +} + #if !(defined(__WIN32__) || defined(MAC_TCL)) /* *---------------------------------------------------------------------- @@ -1127,7 +2330,10 @@ TestwrapperCmd(clientData, interp, argc, argv) wrapperPtr = TkpGetWrapperWindow(winPtr); if (wrapperPtr != NULL) { - TkpPrintWindowId(interp->result, Tk_WindowId(wrapperPtr)); + char buf[TCL_INTEGER_SPACE]; + + TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } diff --git a/generic/tkText.c b/generic/tkText.c index 67232fb..ee19f8a 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkText.c,v 1.2 1998/09/14 18:23:17 stanton Exp $ + * RCS: @(#) $Id: tkText.c,v 1.3 1999/04/16 01:51:23 stanton Exp $ */ #include "default.h" @@ -134,16 +134,6 @@ static Tk_ConfigSpec configSpecs[] = { }; /* - * Tk_Uid's used to represent text states: - */ - -Tk_Uid tkTextCharUid = NULL; -Tk_Uid tkTextDisabledUid = NULL; -Tk_Uid tkTextNoneUid = NULL; -Tk_Uid tkTextNormalUid = NULL; -Tk_Uid tkTextWordUid = NULL; - -/* * Boolean variable indicating whether or not special debugging code * should be executed. */ @@ -232,18 +222,6 @@ Tk_TextCmd(clientData, interp, argc, argv) } /* - * Perform once-only initialization: - */ - - if (tkTextNormalUid == NULL) { - tkTextCharUid = Tk_GetUid("char"); - tkTextDisabledUid = Tk_GetUid("disabled"); - tkTextNoneUid = Tk_GetUid("none"); - tkTextNormalUid = Tk_GetUid("normal"); - tkTextWordUid = Tk_GetUid("word"); - } - - /* * Create the window. */ @@ -265,7 +243,7 @@ Tk_TextCmd(clientData, interp, argc, argv) Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS); Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS); Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS); - textPtr->state = tkTextNormalUid; + textPtr->state = Tk_GetUid("normal"); textPtr->border = NULL; textPtr->borderWidth = 0; textPtr->padX = 0; @@ -283,14 +261,14 @@ Tk_TextCmd(clientData, interp, argc, argv) textPtr->spacing3 = 0; textPtr->tabOptionString = NULL; textPtr->tabArrayPtr = NULL; - textPtr->wrapMode = tkTextCharUid; + textPtr->wrapMode = Tk_GetUid("char"); textPtr->width = 0; textPtr->height = 0; textPtr->setGrid = 0; textPtr->prevWidth = Tk_Width(new); textPtr->prevHeight = Tk_Height(new); TkTextCreateDInfo(textPtr); - TkTextMakeIndex(textPtr->tree, 0, 0, &startIndex); + TkTextMakeByteIndex(textPtr->tree, 0, 0, &startIndex); TkTextSetYView(textPtr, &startIndex, 0); textPtr->selTagPtr = NULL; textPtr->selBorder = NULL; @@ -322,7 +300,8 @@ Tk_TextCmd(clientData, interp, argc, argv) */ textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel"); - textPtr->selTagPtr->reliefString = (char *) ckalloc(7); + textPtr->selTagPtr->reliefString = + (char *) ckalloc(sizeof(DEF_TEXT_SELECT_RELIEF)); strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF); textPtr->selTagPtr->relief = TK_RELIEF_RAISED; textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex); @@ -343,7 +322,7 @@ Tk_TextCmd(clientData, interp, argc, argv) Tk_DestroyWindow(textPtr->tkwin); return TCL_ERROR; } - interp->result = Tk_PathName(textPtr->tkwin); + Tcl_SetResult(interp, Tk_PathName(textPtr->tkwin), TCL_STATIC); return TCL_OK; } @@ -401,7 +380,10 @@ TextWidgetCmd(clientData, interp, argc, argv) goto done; } if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) { - sprintf(interp->result, "%d %d %d %d", x, y, width, height); + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", x, y, width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) && (length >= 2)) { @@ -459,7 +441,7 @@ TextWidgetCmd(clientData, interp, argc, argv) } else { goto compareError; } - interp->result = (value) ? "1" : "0"; + Tcl_SetResult(interp, ((value) ? "1" : "0"), TCL_STATIC); } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) && (length >= 3)) { if (argc == 2) { @@ -481,7 +463,7 @@ TextWidgetCmd(clientData, interp, argc, argv) goto done; } if (argc == 2) { - interp->result = (tkBTreeDebug) ? "1" : "0"; + Tcl_SetResult(interp, ((tkBTreeDebug) ? "1" : "0"), TCL_STATIC); } else { if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) { result = TCL_ERROR; @@ -497,7 +479,7 @@ TextWidgetCmd(clientData, interp, argc, argv) result = TCL_ERROR; goto done; } - if (textPtr->state == tkTextNormalUid) { + if (textPtr->state == Tk_GetUid("normal")) { result = DeleteChars(textPtr, argv[2], (argc == 4) ? argv[3] : (char *) NULL); } @@ -517,8 +499,10 @@ TextWidgetCmd(clientData, interp, argc, argv) } if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base) == 0) { - sprintf(interp->result, "%d %d %d %d %d", x, y, width, - height, base); + char buf[TCL_INTEGER_SPACE * 5]; + + sprintf(buf, "%d %d %d %d %d", x, y, width, height, base); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { if ((argc != 3) && (argc != 4)) { @@ -551,10 +535,10 @@ TextWidgetCmd(clientData, interp, argc, argv) if (index1.linePtr == index2.linePtr) { int last2; - if (index2.charIndex == index1.charIndex) { + if (index2.byteIndex == index1.byteIndex) { break; } - last2 = index2.charIndex - index1.charIndex + offset; + last2 = index2.byteIndex - index1.byteIndex + offset; if (last2 < last) { last = last2; } @@ -566,10 +550,12 @@ TextWidgetCmd(clientData, interp, argc, argv) (char *) NULL); segPtr->body.chars[last] = savedChar; } - TkTextIndexForwChars(&index1, last-offset, &index1); + TkTextIndexForwBytes(&index1, last-offset, &index1); } } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) && (length >= 3)) { + char buf[200]; + if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " index index\"", @@ -581,7 +567,8 @@ TextWidgetCmd(clientData, interp, argc, argv) result = TCL_ERROR; goto done; } - TkTextPrintIndex(&index1, interp->result); + TkTextPrintIndex(&index1, buf); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) && (length >= 3)) { int i, j, numTags; @@ -600,11 +587,11 @@ TextWidgetCmd(clientData, interp, argc, argv) result = TCL_ERROR; goto done; } - if (textPtr->state == tkTextNormalUid) { + if (textPtr->state == Tk_GetUid("normal")) { for (j = 3; j < argc; j += 2) { InsertChars(textPtr, &index1, argv[j]); if (argc > (j+1)) { - TkTextIndexForwChars(&index1, (int) strlen(argv[j]), + TkTextIndexForwBytes(&index1, (int) strlen(argv[j]), &index2); oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags); if (oldTagArrayPtr != NULL) { @@ -745,7 +732,7 @@ DestroyText(memPtr) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message. + * returned, then the interp's result contains an error message. * * Side effects: * Configuration information, such as text string, colors, font, @@ -776,20 +763,20 @@ ConfigureText(interp, textPtr, argc, argv, flags) * the geometry and setting the background from a 3-D border. */ - if ((textPtr->state != tkTextNormalUid) - && (textPtr->state != tkTextDisabledUid)) { + if ((textPtr->state != Tk_GetUid("normal")) + && (textPtr->state != Tk_GetUid("disabled"))) { Tcl_AppendResult(interp, "bad state value \"", textPtr->state, "\": must be normal or disabled", (char *) NULL); - textPtr->state = tkTextNormalUid; + textPtr->state = Tk_GetUid("normal"); return TCL_ERROR; } - if ((textPtr->wrapMode != tkTextCharUid) - && (textPtr->wrapMode != tkTextNoneUid) - && (textPtr->wrapMode != tkTextWordUid)) { + if ((textPtr->wrapMode != Tk_GetUid("char")) + && (textPtr->wrapMode != Tk_GetUid("none")) + && (textPtr->wrapMode != Tk_GetUid("word"))) { Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode, "\": must be char, none, or word", (char *) NULL); - textPtr->wrapMode = tkTextCharUid; + textPtr->wrapMode = Tk_GetUid("char"); return TCL_ERROR; } @@ -882,8 +869,8 @@ ConfigureText(interp, textPtr, argc, argv, flags) TkTextSearch search; TkTextIndex first, last; - TkTextMakeIndex(textPtr->tree, 0, 0, &first); - TkTextMakeIndex(textPtr->tree, + TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &last); TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search); if (TkBTreeCharTagged(&first, textPtr->selTagPtr) @@ -1114,7 +1101,7 @@ InsertChars(textPtr, indexPtr, string) lineIndex = TkBTreeLineIndex(indexPtr->linePtr); if (lineIndex == TkBTreeNumLines(textPtr->tree)) { lineIndex--; - TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr); + TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, indexPtr); } /* @@ -1127,16 +1114,16 @@ InsertChars(textPtr, indexPtr, string) resetView = offset = 0; if (indexPtr->linePtr == textPtr->topIndex.linePtr) { resetView = 1; - offset = textPtr->topIndex.charIndex; - if (offset > indexPtr->charIndex) { + offset = textPtr->topIndex.byteIndex; + if (offset > indexPtr->byteIndex) { offset += strlen(string); } } TkTextChanged(textPtr, indexPtr, indexPtr); TkBTreeInsertChars(indexPtr, string); if (resetView) { - TkTextMakeIndex(textPtr->tree, lineIndex, 0, &newTop); - TkTextIndexForwChars(&newTop, offset, &newTop); + TkTextMakeByteIndex(textPtr->tree, lineIndex, 0, &newTop); + TkTextIndexForwBytes(&newTop, offset, &newTop); TkTextSetYView(textPtr, &newTop, 0); } @@ -1175,7 +1162,7 @@ DeleteChars(textPtr, index1String, index2String) * delete the one character given by * index1String. */ { - int line1, line2, line, charIndex, resetView; + int line1, line2, line, byteIndex, resetView; TkTextIndex index1, index2; /* @@ -1226,7 +1213,7 @@ DeleteChars(textPtr, index1String, index2String) oldIndex2 = index2; TkTextIndexBackChars(&oldIndex2, 1, &index2); line2--; - if ((index1.charIndex == 0) && (line1 != 0)) { + if ((index1.byteIndex == 0) && (line1 != 0)) { TkTextIndexBackChars(&index1, 1, &index1); line1--; } @@ -1249,7 +1236,9 @@ DeleteChars(textPtr, index1String, index2String) */ TkTextChanged(textPtr, &index1, &index2); - resetView = line = charIndex = 0; + resetView = 0; + line = 0; + byteIndex = 0; if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) { if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) { /* @@ -1259,7 +1248,7 @@ DeleteChars(textPtr, index1String, index2String) resetView = 1; line = line1; - charIndex = index1.charIndex; + byteIndex = index1.byteIndex; } else if (index1.linePtr == textPtr->topIndex.linePtr) { /* * Deletion range starts on top line but after topIndex. @@ -1268,7 +1257,7 @@ DeleteChars(textPtr, index1String, index2String) resetView = 1; line = line1; - charIndex = textPtr->topIndex.charIndex; + byteIndex = textPtr->topIndex.byteIndex; } } else if (index2.linePtr == textPtr->topIndex.linePtr) { /* @@ -1279,16 +1268,16 @@ DeleteChars(textPtr, index1String, index2String) resetView = 1; line = line2; - charIndex = textPtr->topIndex.charIndex; + byteIndex = textPtr->topIndex.byteIndex; if (index1.linePtr != index2.linePtr) { - charIndex -= index2.charIndex; + byteIndex -= index2.byteIndex; } else { - charIndex -= (index2.charIndex - index1.charIndex); + byteIndex -= (index2.byteIndex - index1.byteIndex); } } TkBTreeDeleteChars(&index1, &index2); if (resetView) { - TkTextMakeIndex(textPtr->tree, line, charIndex, &index1); + TkTextMakeByteIndex(textPtr->tree, line, byteIndex, &index1); TkTextSetYView(textPtr, &index1, 0); } @@ -1352,12 +1341,12 @@ TextFetchSelection(clientData, offset, buffer, maxBytes) */ if (offset == 0) { - TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex); + TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->selIndex); textPtr->abortSelections = 0; } else if (textPtr->abortSelections) { return 0; } - TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof); TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search); if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) { if (!TkBTreeNextTag(&search)) { @@ -1404,8 +1393,8 @@ TextFetchSelection(clientData, offset, buffer, maxBytes) if (textPtr->selIndex.linePtr == search.curIndex.linePtr) { int leftInRange; - leftInRange = search.curIndex.charIndex - - textPtr->selIndex.charIndex; + leftInRange = search.curIndex.byteIndex + - textPtr->selIndex.byteIndex; if (leftInRange < chunkSize) { chunkSize = leftInRange; if (chunkSize <= 0) { @@ -1420,7 +1409,7 @@ TextFetchSelection(clientData, offset, buffer, maxBytes) maxBytes -= chunkSize; count += chunkSize; } - TkTextIndexForwChars(&textPtr->selIndex, chunkSize, + TkTextIndexForwBytes(&textPtr->selIndex, chunkSize, &textPtr->selIndex); } @@ -1477,8 +1466,8 @@ TkTextLostSelection(clientData) * just remove the "sel" tag from everything in the widget. */ - TkTextMakeIndex(textPtr->tree, 0, 0, &start); - TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end); + TkTextMakeByteIndex(textPtr->tree, 0, 0, &start); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end); TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1); TkBTreeTag(&start, &end, textPtr->selTagPtr, 0); #endif @@ -1556,8 +1545,8 @@ TextSearchCmd(textPtr, interp, argc, argv) { int backwards, exact, c, i, argsLeft, noCase, leftToScan; size_t length; - int numLines, startingLine, startingChar, lineNum, firstChar, lastChar; - int code, matchLength, matchChar, passes, stopLine, searchWholeText; + int numLines, startingLine, startingByte, lineNum, firstByte, lastByte; + int code, matchLength, matchByte, passes, stopLine, searchWholeText; int patLength; char *arg, *pattern, *varName, *p, *startOfLine; char buffer[20]; @@ -1594,7 +1583,8 @@ TextSearchCmd(textPtr, interp, argc, argv) backwards = 1; } else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) { if (i >= (argc-1)) { - interp->result = "no value given for \"-count\" option"; + Tcl_SetResult(interp, "no value given for \"-count\" option", + TCL_STATIC); return TCL_ERROR; } i++; @@ -1631,11 +1621,7 @@ TextSearchCmd(textPtr, interp, argc, argv) Tcl_DStringInit(&patDString); Tcl_DStringAppend(&patDString, pattern, -1); pattern = Tcl_DStringValue(&patDString); - for (p = pattern; *p != 0; p++) { - if (isupper(UCHAR(*p))) { - *p = tolower(UCHAR(*p)); - } - } + Tcl_UtfToLower(pattern); } if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) { @@ -1643,15 +1629,15 @@ TextSearchCmd(textPtr, interp, argc, argv) } numLines = TkBTreeNumLines(textPtr->tree); startingLine = TkBTreeLineIndex(index.linePtr); - startingChar = index.charIndex; + startingByte = index.byteIndex; if (startingLine >= numLines) { if (backwards) { startingLine = TkBTreeNumLines(textPtr->tree) - 1; - startingChar = TkBTreeCharsInLine(TkBTreeFindLine(textPtr->tree, + startingByte = TkBTreeBytesInLine(TkBTreeFindLine(textPtr->tree, startingLine)); } else { startingLine = 0; - startingChar = 0; + startingByte = 0; } } if (argsLeft == 1) { @@ -1719,11 +1705,8 @@ TextSearchCmd(textPtr, interp, argc, argv) */ if (noCase) { - for (p = Tcl_DStringValue(&line); *p != 0; p++) { - if (isupper(UCHAR(*p))) { - *p = tolower(UCHAR(*p)); - } - } + Tcl_DStringSetLength(&line, + Tcl_UtfToLower(Tcl_DStringValue(&line))); } /* @@ -1732,9 +1715,9 @@ TextSearchCmd(textPtr, interp, argc, argv) * in the line. */ - matchChar = -1; - firstChar = 0; - lastChar = INT_MAX; + matchByte = -1; + firstByte = 0; + lastByte = INT_MAX; if (lineNum == startingLine) { int indexInDString; @@ -1748,8 +1731,8 @@ TextSearchCmd(textPtr, interp, argc, argv) * character. */ - indexInDString = startingChar; - for (segPtr = linePtr->segPtr, leftToScan = startingChar; + indexInDString = startingByte; + for (segPtr = linePtr->segPtr, leftToScan = startingByte; leftToScan > 0; segPtr = segPtr->nextPtr) { if (segPtr->typePtr != &tkTextCharType) { indexInDString -= segPtr->size; @@ -1763,8 +1746,8 @@ TextSearchCmd(textPtr, interp, argc, argv) * Only use the last part of the line. */ - firstChar = indexInDString; - if (firstChar >= Tcl_DStringLength(&line)) { + firstByte = indexInDString; + if (firstByte >= Tcl_DStringLength(&line)) { goto nextLine; } } else { @@ -1772,13 +1755,16 @@ TextSearchCmd(textPtr, interp, argc, argv) * Use only the first part of the line. */ - lastChar = indexInDString; + lastByte = indexInDString; } } do { int thisLength; + Tcl_UniChar ch; + if (exact) { - p = strstr(startOfLine + firstChar, pattern); + p = strstr(startOfLine + firstByte, /* INTL: Native. */ + pattern); if (p == NULL) { break; } @@ -1789,7 +1775,7 @@ TextSearchCmd(textPtr, interp, argc, argv) int match; match = Tcl_RegExpExec(interp, regexp, - startOfLine + firstChar, startOfLine); + startOfLine + firstByte, startOfLine); if (match < 0) { code = TCL_ERROR; goto done; @@ -1801,12 +1787,12 @@ TextSearchCmd(textPtr, interp, argc, argv) i = start - startOfLine; thisLength = end - start; } - if (i >= lastChar) { + if (i >= lastByte) { break; } - matchChar = i; + matchByte = i; matchLength = thisLength; - firstChar = matchChar+1; + firstByte += Tcl_UtfToUniChar(startOfLine + matchByte, &ch); } while (backwards); /* @@ -1815,7 +1801,16 @@ TextSearchCmd(textPtr, interp, argc, argv) * specified. */ - if (matchChar >= 0) { + if (matchByte >= 0) { + int numChars; + + /* + * Convert the byte length to a character count. + */ + + numChars = Tcl_NumUtfChars(startOfLine + matchByte, + matchLength); + /* * The index information returned by the regular expression * parser only considers textual information: it doesn't @@ -1824,10 +1819,10 @@ TextSearchCmd(textPtr, interp, argc, argv) * matchChar and matchCount. */ - for (segPtr = linePtr->segPtr, leftToScan = matchChar; + for (segPtr = linePtr->segPtr, leftToScan = matchByte; leftToScan >= 0; segPtr = segPtr->nextPtr) { if (segPtr->typePtr != &tkTextCharType) { - matchChar += segPtr->size; + matchByte += segPtr->size; continue; } leftToScan -= segPtr->size; @@ -1835,12 +1830,12 @@ TextSearchCmd(textPtr, interp, argc, argv) for (leftToScan += matchLength; leftToScan > 0; segPtr = segPtr->nextPtr) { if (segPtr->typePtr != &tkTextCharType) { - matchLength += segPtr->size; + numChars += segPtr->size; continue; } leftToScan -= segPtr->size; } - TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index); + TkTextMakeByteIndex(textPtr->tree, lineNum, matchByte, &index); if (!searchWholeText) { if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) { goto done; @@ -1850,14 +1845,15 @@ TextSearchCmd(textPtr, interp, argc, argv) } } if (varName != NULL) { - sprintf(buffer, "%d", matchLength); + sprintf(buffer, "%d", numChars); if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG) == NULL) { code = TCL_ERROR; goto done; } } - TkTextPrintIndex(&index, interp->result); + TkTextPrintIndex(&index, buffer); + Tcl_SetResult(interp, buffer, TCL_VOLATILE); goto done; } @@ -1906,7 +1902,7 @@ TextSearchCmd(textPtr, interp, argc, argv) * The return value is a pointer to a malloc'ed structure holding * parsed information about the tab stops. If an error occurred * then the return value is NULL and an error message is left in - * interp->result. + * the interp's result. * * Side effects: * Memory is allocated for the structure that is returned. It is @@ -1928,6 +1924,7 @@ TkTextGetTabs(interp, tkwin, string) char **argv; TkTextTabArray *tabArrayPtr; TkTextTab *tabPtr; + Tcl_UniChar ch; if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) { return NULL; @@ -1970,11 +1967,12 @@ TkTextGetTabs(interp, tkwin, string) if ((i+1) == argc) { continue; } - c = UCHAR(argv[i+1][0]); - if (!isalpha(c)) { + Tcl_UtfToUniChar(argv[i+1], &ch); + if (!Tcl_UniCharIsAlpha(ch)) { continue; } i += 1; + c = argv[i][0]; if ((c == 'l') && (strncmp(argv[i], "left", strlen(argv[i])) == 0)) { tabPtr->alignment = LEFT; @@ -2104,10 +2102,10 @@ TextDumpCmd(textPtr, interp, argc, argv) } if (index1.linePtr == index2.linePtr) { DumpLine(interp, textPtr, what, index1.linePtr, - index1.charIndex, index2.charIndex, lineno, command); + index1.byteIndex, index2.byteIndex, lineno, command); } else { DumpLine(interp, textPtr, what, index1.linePtr, - index1.charIndex, 32000000, lineno, command); + index1.byteIndex, 32000000, lineno, command); linePtr = index1.linePtr; while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) { lineno++; @@ -2118,14 +2116,14 @@ TextDumpCmd(textPtr, interp, argc, argv) lineno, command); } DumpLine(interp, textPtr, what, index2.linePtr, 0, - index2.charIndex, lineno, command); + index2.byteIndex, lineno, command); } /* * Special case to get the leftovers hiding at the end mark. */ if (atEnd) { DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr, - 0, 1, lineno, command); + 0, 1, lineno, command); } return TCL_OK; @@ -2143,12 +2141,12 @@ TextDumpCmd(textPtr, interp, argc, argv) * None, but see DumpSegment. */ static void -DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command) +DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command) Tcl_Interp *interp; TkText *textPtr; int what; /* bit flags to select segment types */ TkTextLine *linePtr; /* The current line */ - int start, end; /* Character range to dump */ + int startByte, endByte; /* Byte range to dump */ int lineno; /* Line number for indices dump */ char *command; /* Script to apply to the segment */ { @@ -2163,25 +2161,25 @@ DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command) * window */ for (offset = 0, segPtr = linePtr->segPtr ; - (offset < end) && (segPtr != (TkTextSegment *)NULL) ; + (offset < endByte) && (segPtr != (TkTextSegment *)NULL) ; offset += segPtr->size, segPtr = segPtr->nextPtr) { if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) && - (offset + segPtr->size > start)) { + (offset + segPtr->size > startByte)) { char savedChar; /* Last char used in the seg */ int last = segPtr->size; /* Index of savedChar */ int first = 0; /* Index of first char in seg */ - if (offset + segPtr->size > end) { - last = end - offset; + if (offset + segPtr->size > endByte) { + last = endByte - offset; } - if (start > offset) { - first = start - offset; + if (startByte > offset) { + first = startByte - offset; } savedChar = segPtr->body.chars[last]; segPtr->body.chars[last] = '\0'; DumpSegment(interp, "text", segPtr->body.chars + first, command, lineno, offset + first, what); segPtr->body.chars[last] = savedChar; - } else if ((offset >= start)) { + } else if ((offset >= startByte)) { if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) { TkTextMark *markPtr = (TkTextMark *)&segPtr->body; char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr); @@ -2237,11 +2235,11 @@ DumpSegment(interp, key, value, command, lineno, offset, what) char *value; /* Segment value */ char *command; /* Script callback */ int lineno; /* Line number for indices dump */ - int offset; /* Character position */ + int offset; /* Byte position */ int what; /* Look for TK_DUMP_INDEX bit */ { char buffer[30]; - sprintf(buffer, "%d.%d", lineno, offset); + sprintf(buffer, "%d.%d", lineno, offset); if (command == (char *) NULL) { Tcl_AppendElement(interp, key); Tcl_AppendElement(interp, value); diff --git a/generic/tkText.h b/generic/tkText.h index ad30c99..68cfff5 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkText.h,v 1.2 1998/09/14 18:23:18 stanton Exp $ + * RCS: @(#) $Id: tkText.h,v 1.3 1999/04/16 01:51:23 stanton Exp $ */ #ifndef _TKTEXT @@ -176,7 +176,7 @@ typedef struct TkTextIndex { TkTextBTree tree; /* Tree containing desired position. */ TkTextLine *linePtr; /* Pointer to line containing position * of interest. */ - int charIndex; /* Index within line of desired + int byteIndex; /* Index within line of desired * character (0 means first one). */ } TkTextIndex; @@ -241,7 +241,7 @@ struct TkTextDispChunk { * a given x-location. */ Tk_ChunkBboxProc *bboxProc; /* Procedure to find bounding box * of character in chunk. */ - int numChars; /* Number of characters that will be + int numBytes; /* Number of bytes that will be * displayed in the chunk. */ int minAscent; /* Minimum space above the baseline * needed by this chunk. */ @@ -256,7 +256,7 @@ struct TkTextDispChunk { * of line. */ int breakIndex; /* Index within chunk of last * acceptable position for a line - * (break just before this character). + * (break just before this byte index). * <= 0 means don't break during or * immediately after this chunk. */ ClientData clientData; /* Additional information for use @@ -470,8 +470,8 @@ typedef struct TkText { * image segment doesn't yet have an * associated image, there is no entry for * it here. */ - Tk_Uid state; /* Normal or disabled. Text is read-only - * when disabled. */ + Tk_Uid state; /* Either normal or disabled. A text + * widget is read-only when disabled. */ /* * Default information for displaying (may be overridden by tags @@ -730,6 +730,7 @@ extern int TkBTreeCharTagged _ANSI_ARGS_((TkTextIndex *indexPtr, TkTextTag *tagPtr)); extern void TkBTreeCheck _ANSI_ARGS_((TkTextBTree tree)); extern int TkBTreeCharsInLine _ANSI_ARGS_((TkTextLine *linePtr)); +extern int TkBTreeBytesInLine _ANSI_ARGS_((TkTextLine *linePtr)); extern TkTextBTree TkBTreeCreate _ANSI_ARGS_((TkText *textPtr)); extern void TkBTreeDestroy _ANSI_ARGS_((TkTextBTree tree)); extern void TkBTreeDeleteChars _ANSI_ARGS_((TkTextIndex *index1Ptr, @@ -784,23 +785,35 @@ extern int TkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp, TkTextIndex *indexPtr)); extern TkTextTabArray * TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin, char *string)); -extern void TkTextIndexBackChars _ANSI_ARGS_((TkTextIndex *srcPtr, - int count, TkTextIndex *dstPtr)); -extern int TkTextIndexCmp _ANSI_ARGS_((TkTextIndex *index1Ptr, - TkTextIndex *index2Ptr)); -extern void TkTextIndexForwChars _ANSI_ARGS_((TkTextIndex *srcPtr, - int count, TkTextIndex *dstPtr)); -extern TkTextSegment * TkTextIndexToSeg _ANSI_ARGS_((TkTextIndex *indexPtr, - int *offsetPtr)); +extern void TkTextIndexBackBytes _ANSI_ARGS_(( + CONST TkTextIndex *srcPtr, int count, + TkTextIndex *dstPtr)); +extern void TkTextIndexBackChars _ANSI_ARGS_(( + CONST TkTextIndex *srcPtr, int count, + TkTextIndex *dstPtr)); +extern int TkTextIndexCmp _ANSI_ARGS_(( + CONST TkTextIndex *index1Ptr, + CONST TkTextIndex *index2Ptr)); +extern void TkTextIndexForwBytes _ANSI_ARGS_(( + CONST TkTextIndex *srcPtr, int count, + TkTextIndex *dstPtr)); +extern void TkTextIndexForwChars _ANSI_ARGS_(( + CONST TkTextIndex *srcPtr, int count, + TkTextIndex *dstPtr)); +extern TkTextSegment * TkTextIndexToSeg _ANSI_ARGS_(( + CONST TkTextIndex *indexPtr, int *offsetPtr)); extern void TkTextInsertDisplayProc _ANSI_ARGS_(( TkTextDispChunk *chunkPtr, int x, int y, int height, int baseline, Display *display, Drawable dst, int screenY)); extern void TkTextLostSelection _ANSI_ARGS_(( ClientData clientData)); -extern TkTextIndex * TkTextMakeIndex _ANSI_ARGS_((TkTextBTree tree, +extern TkTextIndex * TkTextMakeCharIndex _ANSI_ARGS_((TkTextBTree tree, int lineIndex, int charIndex, TkTextIndex *indexPtr)); +extern TkTextIndex * TkTextMakeByteIndex _ANSI_ARGS_((TkTextBTree tree, + int lineIndex, int byteIndex, + TkTextIndex *indexPtr)); extern int TkTextMarkCmd _ANSI_ARGS_((TkText *textPtr, Tcl_Interp *interp, int argc, char **argv)); extern int TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr, @@ -812,8 +825,8 @@ extern void TkTextPickCurrent _ANSI_ARGS_((TkText *textPtr, XEvent *eventPtr)); extern void TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr, int x, int y, TkTextIndex *indexPtr)); -extern void TkTextPrintIndex _ANSI_ARGS_((TkTextIndex *indexPtr, - char *string)); +extern void TkTextPrintIndex _ANSI_ARGS_(( + CONST TkTextIndex *indexPtr, char *string)); extern void TkTextRedrawRegion _ANSI_ARGS_((TkText *textPtr, int x, int y, int width, int height)); extern void TkTextRedrawTag _ANSI_ARGS_((TkText *textPtr, @@ -824,8 +837,9 @@ extern int TkTextScanCmd _ANSI_ARGS_((TkText *textPtr, Tcl_Interp *interp, int argc, char **argv)); extern int TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr, Tcl_Interp *interp, int argc, char **argv)); -extern int TkTextSegToOffset _ANSI_ARGS_((TkTextSegment *segPtr, - TkTextLine *linePtr)); +extern int TkTextSegToOffset _ANSI_ARGS_(( + CONST TkTextSegment *segPtr, + CONST TkTextLine *linePtr)); extern TkTextSegment * TkTextSetMark _ANSI_ARGS_((TkText *textPtr, char *name, TkTextIndex *indexPtr)); extern void TkTextSetYView _ANSI_ARGS_((TkText *textPtr, diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c index 44b021f..6f7beb6 100644 --- a/generic/tkTextBTree.c +++ b/generic/tkTextBTree.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextBTree.c,v 1.2 1998/09/14 18:23:18 stanton Exp $ + * RCS: @(#) $Id: tkTextBTree.c,v 1.3 1999/04/16 01:51:23 stanton Exp $ */ #include "tkInt.h" @@ -535,7 +535,7 @@ SplitSeg(indexPtr) TkTextSegment *prevPtr, *segPtr; int count; - for (count = indexPtr->charIndex, prevPtr = NULL, + for (count = indexPtr->byteIndex, prevPtr = NULL, segPtr = indexPtr->linePtr->segPtr; segPtr != NULL; count -= segPtr->size, prevPtr = segPtr, segPtr = segPtr->nextPtr) { if (segPtr->size > count) { @@ -1530,7 +1530,7 @@ FindTagStart(tree, tagPtr, indexPtr) */ indexPtr->tree = tree; indexPtr->linePtr = linePtr; - indexPtr->charIndex = offset; + indexPtr->byteIndex = offset; return segPtr; } } @@ -1619,7 +1619,7 @@ FindTagEnd(tree, tagPtr, indexPtr) } indexPtr->tree = tree; indexPtr->linePtr = lastLinePtr; - indexPtr->charIndex = lastoffset2; + indexPtr->byteIndex = lastoffset2; return last2SegPtr; } @@ -1694,7 +1694,7 @@ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, searchPtr) searchPtr->curIndex = *index1Ptr; searchPtr->segPtr = NULL; searchPtr->nextPtr = TkTextIndexToSeg(index1Ptr, &offset); - searchPtr->curIndex.charIndex -= offset; + searchPtr->curIndex.byteIndex -= offset; } searchPtr->lastPtr = TkTextIndexToSeg(index2Ptr, (int *) NULL); searchPtr->tagPtr = tagPtr; @@ -1709,9 +1709,9 @@ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, searchPtr) * the range, unless the range is artificially moved up to index0. */ if (((index1Ptr == &index0) && - (index1Ptr->charIndex > index2Ptr->charIndex)) || + (index1Ptr->byteIndex > index2Ptr->byteIndex)) || ((index1Ptr != &index0) && - (index1Ptr->charIndex >= index2Ptr->charIndex))) { + (index1Ptr->byteIndex >= index2Ptr->byteIndex))) { searchPtr->linesLeft = 0; } } @@ -1793,7 +1793,7 @@ TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr) } searchPtr->segPtr = NULL; searchPtr->nextPtr = TkTextIndexToSeg(&searchPtr->curIndex, &offset); - searchPtr->curIndex.charIndex -= offset; + searchPtr->curIndex.byteIndex -= offset; /* * Adjust the end of the search so it does find toggles that are right @@ -1801,7 +1801,7 @@ TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr) */ if ((TkBTreeLineIndex(index2Ptr->linePtr) == 0) && - (index2Ptr->charIndex == 0)) { + (index2Ptr->byteIndex == 0)) { backOne = *index2Ptr; searchPtr->lastPtr = NULL; /* Signals special case for 1.0 */ } else { @@ -1819,7 +1819,7 @@ TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr) * first. */ - if (index1Ptr->charIndex <= backOne.charIndex) { + if (index1Ptr->byteIndex <= backOne.byteIndex) { searchPtr->linesLeft = 0; } } @@ -1889,7 +1889,7 @@ TkBTreeNextTag(searchPtr) searchPtr->tagPtr = segPtr->body.toggle.tagPtr; return 1; } - searchPtr->curIndex.charIndex += segPtr->size; + searchPtr->curIndex.byteIndex += segPtr->size; } /* @@ -1906,7 +1906,7 @@ TkBTreeNextTag(searchPtr) } if (searchPtr->curIndex.linePtr != NULL) { segPtr = searchPtr->curIndex.linePtr->segPtr; - searchPtr->curIndex.charIndex = 0; + searchPtr->curIndex.byteIndex = 0; continue; } if (nodePtr == searchPtr->tagPtr->tagRootPtr) { @@ -1972,7 +1972,7 @@ TkBTreeNextTag(searchPtr) */ searchPtr->curIndex.linePtr = nodePtr->children.linePtr; - searchPtr->curIndex.charIndex = 0; + searchPtr->curIndex.byteIndex = 0; segPtr = searchPtr->curIndex.linePtr->segPtr; if (searchPtr->linesLeft <= 0) { goto searchOver; @@ -2022,7 +2022,7 @@ TkBTreePrevTag(searchPtr) register TkTextLine *linePtr, *prevLinePtr; register Node *nodePtr, *node2Ptr, *prevNodePtr; register Summary *summaryPtr; - int charIndex; + int byteIndex; int pastLast; /* Saw last marker during scan */ int linesSkipped; @@ -2041,7 +2041,7 @@ TkBTreePrevTag(searchPtr) /* * Check for the last toggle before the current segment on this line. */ - charIndex = 0; + byteIndex = 0; if (searchPtr->lastPtr == NULL) { /* * Search back to the very beginning, so pastLast is irrelevent. @@ -2058,13 +2058,13 @@ TkBTreePrevTag(searchPtr) && (searchPtr->allTags || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) { prevPtr = segPtr; - searchPtr->curIndex.charIndex = charIndex; + searchPtr->curIndex.byteIndex = byteIndex; } if (segPtr == searchPtr->lastPtr) { prevPtr = NULL; /* Segments earlier than last don't count */ pastLast = 1; } - charIndex += segPtr->size; + byteIndex += segPtr->size; } if (prevPtr != NULL) { if (searchPtr->linesLeft == 1 && !pastLast) { @@ -2191,7 +2191,7 @@ TkBTreePrevTag(searchPtr) /* empty loop body */ ; } searchPtr->curIndex.linePtr = prevLinePtr; - searchPtr->curIndex.charIndex = 0; + searchPtr->curIndex.byteIndex = 0; if (searchPtr->linesLeft <= 0) { goto searchOver; } @@ -2241,7 +2241,7 @@ TkBTreeCharTagged(indexPtr, tagPtr) toggleSegPtr = NULL; for (index = 0, segPtr = indexPtr->linePtr->segPtr; - (index + segPtr->size) <= indexPtr->charIndex; + (index + segPtr->size) <= indexPtr->byteIndex; index += segPtr->size, segPtr = segPtr->nextPtr) { if (((segPtr->typePtr == &tkTextToggleOnType) || (segPtr->typePtr == &tkTextToggleOffType)) @@ -2360,7 +2360,7 @@ TkBTreeGetTags(indexPtr, numTagsPtr) */ for (index = 0, segPtr = indexPtr->linePtr->segPtr; - (index + segPtr->size) <= indexPtr->charIndex; + (index + segPtr->size) <= indexPtr->byteIndex; index += segPtr->size, segPtr = segPtr->nextPtr) { if ((segPtr->typePtr == &tkTextToggleOnType) || (segPtr->typePtr == &tkTextToggleOffType)) { @@ -3588,6 +3588,25 @@ TkBTreeCharsInLine(linePtr) count = 0; for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr == &tkTextCharType) { + count += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size); + } else { + count += segPtr->size; + } + } + return count; +} + +int +TkBTreeBytesInLine(linePtr) + TkTextLine *linePtr; /* Line whose characters should be + * counted. */ +{ + TkTextSegment *segPtr; + int count; + + count = 0; + for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { count += segPtr->size; } return count; diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 8cbdd27..d1f05fa 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextDisp.c,v 1.3 1999/03/10 07:04:44 stanton Exp $ + * RCS: @(#) $Id: tkTextDisp.c,v 1.4 1999/04/16 01:51:23 stanton Exp $ */ #include "tkPort.h" @@ -60,8 +60,7 @@ typedef struct StyleValues { int underline; /* Non-zero means draw underline underneath * text. */ Tk_Uid wrapMode; /* How to handle wrap-around for this tag. - * One of tkTextCharUid, tkTextNoneUid, - * or tkTextWordUid. */ + * One of char, none, or text. */ } StyleValues; /* @@ -102,7 +101,7 @@ typedef struct TextStyle { typedef struct DLine { TkTextIndex index; /* Identifies first character in text * that is displayed on this line. */ - int count; /* Number of characters accounted for by this + int byteCount; /* Number of bytes accounted for by this * display line, including a trailing space * or newline that isn't actually displayed. */ int y; /* Y-position at which line is supposed to @@ -203,7 +202,7 @@ typedef struct TextDInfo { * Information used for scrolling: */ - int newCharOffset; /* Desired x scroll position, measured as the + int newByteOffset; /* Desired x scroll position, measured as the * number of average-size characters off-screen * to the left for a line with no left * margin. */ @@ -226,8 +225,9 @@ typedef struct TextDInfo { * The following information is used to implement scanning: */ - int scanMarkChar; /* Character that was at the left edge of - * the window when the scan started. */ + int scanMarkIndex; /* Byte index of character that was at the + * left edge of the window when the scan + * started. */ int scanMarkX; /* X-position of mouse at time scan started. */ int scanTotalScroll; /* Total scrolling (in screen lines) that has * occurred since scanMarkY was set. */ @@ -258,9 +258,9 @@ typedef struct TextDInfo { */ typedef struct CharInfo { - int numChars; /* Number of characters to display. */ - char chars[4]; /* Characters to display. Actual size - * will be numChars, not 4. THIS MUST BE + 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 FIELD IN THE STRUCTURE. */ } CharInfo; @@ -335,7 +335,7 @@ static void GetYView _ANSI_ARGS_((Tcl_Interp *interp, static DLine * LayoutDLine _ANSI_ARGS_((TkText *textPtr, TkTextIndex *indexPtr)); static int MeasureChars _ANSI_ARGS_((Tk_Font tkfont, - CONST char *source, int maxChars, int startX, + CONST char *source, int maxBytes, int startX, int maxX, int tabOrigin, int *nextXPtr)); static void MeasureUp _ANSI_ARGS_((TkText *textPtr, TkTextIndex *srcPtr, int distance, @@ -385,14 +385,14 @@ TkTextCreateDInfo(textPtr) dInfoPtr->scrollGC = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures, &gcValues); dInfoPtr->topOfEof = 0; - dInfoPtr->newCharOffset = 0; + dInfoPtr->newByteOffset = 0; dInfoPtr->curPixelOffset = 0; dInfoPtr->maxLength = 0; dInfoPtr->xScrollFirst = -1; dInfoPtr->xScrollLast = -1; dInfoPtr->yScrollFirst = -1; dInfoPtr->yScrollLast = -1; - dInfoPtr->scanMarkChar = 0; + dInfoPtr->scanMarkIndex = 0; dInfoPtr->scanMarkX = 0; dInfoPtr->scanTotalScroll = 0; dInfoPtr->scanMarkY = 0; @@ -743,12 +743,14 @@ LayoutDLine(textPtr, indexPtr) * point, if any. */ TkTextIndex breakIndex; /* Index of first character in * breakChunkPtr. */ - int breakCharOffset; /* Character within breakChunkPtr just - * to right of best break point. */ + int breakByteOffset; /* Byte offset of character within + * breakChunkPtr just to right of best + * break point. */ int noCharsYet; /* Non-zero means that no characters * have been placed on the line yet. */ int justify; /* How to justify line: taken from - * style for first character in line. */ + * style for the first character in + * line. */ int jIndent; /* Additional indentation (beyond * margins) due to justification. */ int rMargin; /* Right margin width for line. */ @@ -762,17 +764,18 @@ LayoutDLine(textPtr, indexPtr) * contains a tab. */ TkTextDispChunk *tabChunkPtr; /* Pointer to the chunk containing * the previous tab stop. */ - int maxChars; /* Maximum number of characters to + int maxBytes; /* Maximum number of bytes to * include in this chunk. */ - TkTextTabArray *tabArrayPtr; /* Tab stops for line; taken from - * style for first character on line. */ + TkTextTabArray *tabArrayPtr; /* Tab stops for line; taken from + * style for the first character on + * line. */ int tabSize; /* Number of pixels consumed by current * tab stop. */ TkTextDispChunk *lastCharChunkPtr; /* Pointer to last chunk in display - * lines with numChars > 0. Used to + * lines with numBytes > 0. Used to * drop 0-sized chunks from the end * of the line. */ - int offset, ascent, descent, code; + int byteOffset, ascent, descent, code; StyleValues *sValuePtr; /* @@ -781,7 +784,7 @@ LayoutDLine(textPtr, indexPtr) dlPtr = (DLine *) ckalloc(sizeof(DLine)); dlPtr->index = *indexPtr; - dlPtr->count = 0; + dlPtr->byteCount = 0; dlPtr->y = 0; dlPtr->oldY = -1; dlPtr->height = 0; @@ -802,13 +805,13 @@ LayoutDLine(textPtr, indexPtr) chunkPtr = NULL; noCharsYet = 1; breakChunkPtr = NULL; - breakCharOffset = 0; + breakByteOffset = 0; justify = TK_JUSTIFY_LEFT; tabIndex = -1; tabChunkPtr = NULL; tabArrayPtr = NULL; rMargin = 0; - wrapMode = tkTextCharUid; + wrapMode = Tk_GetUid("char"); tabSize = 0; lastCharChunkPtr = NULL; @@ -818,16 +821,16 @@ LayoutDLine(textPtr, indexPtr) * with zero size (such as the insertion cursor's mark). */ - for (offset = curIndex.charIndex, segPtr = curIndex.linePtr->segPtr; - (offset > 0) && (offset >= segPtr->size); - offset -= segPtr->size, segPtr = segPtr->nextPtr) { + for (byteOffset = curIndex.byteIndex, segPtr = curIndex.linePtr->segPtr; + (byteOffset > 0) && (byteOffset >= segPtr->size); + byteOffset -= segPtr->size, segPtr = segPtr->nextPtr) { /* Empty loop body. */ } while (segPtr != NULL) { if (segPtr->typePtr->layoutProc == NULL) { segPtr = segPtr->nextPtr; - offset = 0; + byteOffset = 0; continue; } if (chunkPtr == NULL) { @@ -847,11 +850,11 @@ LayoutDLine(textPtr, indexPtr) justify = chunkPtr->stylePtr->sValuePtr->justify; rMargin = chunkPtr->stylePtr->sValuePtr->rMargin; wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode; - x = ((curIndex.charIndex == 0) + x = ((curIndex.byteIndex == 0) ? chunkPtr->stylePtr->sValuePtr->lMargin1 : chunkPtr->stylePtr->sValuePtr->lMargin2); - if (wrapMode == tkTextNoneUid) { - maxX = INT_MAX; + if (wrapMode == Tk_GetUid("none")) { + maxX = -1; } else { maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin; @@ -867,14 +870,14 @@ LayoutDLine(textPtr, indexPtr) */ gotTab = 0; - maxChars = segPtr->size - offset; + maxBytes = segPtr->size - byteOffset; if (justify == TK_JUSTIFY_LEFT) { if (segPtr->typePtr == &tkTextCharType) { char *p; - for (p = segPtr->body.chars + offset; *p != 0; p++) { + for (p = segPtr->body.chars + byteOffset; *p != 0; p++) { if (*p == '\t') { - maxChars = (p + 1 - segPtr->body.chars) - offset; + maxBytes = (p + 1 - segPtr->body.chars) - byteOffset; gotTab = 1; break; } @@ -884,7 +887,7 @@ LayoutDLine(textPtr, indexPtr) chunkPtr->x = x; code = (*segPtr->typePtr->layoutProc)(textPtr, &curIndex, segPtr, - offset, maxX-tabSize, maxChars, noCharsYet, wrapMode, + byteOffset, maxX-tabSize, maxBytes, noCharsYet, wrapMode, chunkPtr); if (code <= 0) { FreeStyle(textPtr, chunkPtr->stylePtr); @@ -895,7 +898,7 @@ LayoutDLine(textPtr, indexPtr) */ segPtr = segPtr->nextPtr; - offset = 0; + byteOffset = 0; continue; } @@ -909,7 +912,7 @@ LayoutDLine(textPtr, indexPtr) } break; } - if (chunkPtr->numChars > 0) { + if (chunkPtr->numBytes > 0) { noCharsYet = 0; lastCharChunkPtr = chunkPtr; } @@ -921,11 +924,11 @@ LayoutDLine(textPtr, indexPtr) lastChunkPtr = chunkPtr; x += chunkPtr->width; if (chunkPtr->breakIndex > 0) { - breakCharOffset = chunkPtr->breakIndex; + breakByteOffset = chunkPtr->breakIndex; breakIndex = curIndex; breakChunkPtr = chunkPtr; } - if (chunkPtr->numChars != maxChars) { + if (chunkPtr->numBytes != maxBytes) { break; } @@ -944,14 +947,14 @@ LayoutDLine(textPtr, indexPtr) tabIndex++; tabChunkPtr = chunkPtr; tabSize = SizeOfTab(textPtr, tabArrayPtr, tabIndex, x, maxX); - if (tabSize >= (maxX - x)) { + if ((maxX >= 0) && (tabSize >= maxX - x)) { break; } } - curIndex.charIndex += chunkPtr->numChars; - offset += chunkPtr->numChars; - if (offset >= segPtr->size) { - offset = 0; + curIndex.byteIndex += chunkPtr->numBytes; + byteOffset += chunkPtr->numBytes; + if (byteOffset >= segPtr->size) { + byteOffset = 0; segPtr = segPtr->nextPtr; } chunkPtr = NULL; @@ -977,10 +980,10 @@ LayoutDLine(textPtr, indexPtr) */ breakChunkPtr = lastCharChunkPtr; - breakCharOffset = breakChunkPtr->numChars; + breakByteOffset = breakChunkPtr->numBytes; } if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr) - || (breakCharOffset != lastChunkPtr->numChars))) { + || (breakByteOffset != lastChunkPtr->numBytes))) { while (1) { chunkPtr = breakChunkPtr->nextPtr; if (chunkPtr == NULL) { @@ -991,11 +994,11 @@ LayoutDLine(textPtr, indexPtr) (*chunkPtr->undisplayProc)(textPtr, chunkPtr); ckfree((char *) chunkPtr); } - if (breakCharOffset != breakChunkPtr->numChars) { + if (breakByteOffset != breakChunkPtr->numBytes) { (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr); - segPtr = TkTextIndexToSeg(&breakIndex, &offset); + segPtr = TkTextIndexToSeg(&breakIndex, &byteOffset); (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex, - segPtr, offset, maxX, breakCharOffset, 0, + segPtr, byteOffset, maxX, breakByteOffset, 0, wrapMode, breakChunkPtr); } lastChunkPtr = breakChunkPtr; @@ -1012,7 +1015,7 @@ LayoutDLine(textPtr, indexPtr) /* * Make one more pass over the line to recompute various things - * like its height, length, and total number of characters. Also + * like its height, length, and total number of bytes. Also * modify the x-locations of chunks to reflect justification. * If we're not wrapping, I'm not sure what is the best way to * handle left and center justification: should the total length, @@ -1023,7 +1026,7 @@ LayoutDLine(textPtr, indexPtr) * what is implemented below. */ - if (wrapMode == tkTextNoneUid) { + if (wrapMode == Tk_GetUid("none")) { maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin; } dlPtr->length = lastChunkPtr->x + lastChunkPtr->width; @@ -1038,7 +1041,7 @@ LayoutDLine(textPtr, indexPtr) for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL; chunkPtr = chunkPtr->nextPtr) { chunkPtr->x += jIndent; - dlPtr->count += chunkPtr->numChars; + dlPtr->byteCount += chunkPtr->numBytes; if (chunkPtr->minAscent > ascent) { ascent = chunkPtr->minAscent; } @@ -1061,7 +1064,7 @@ LayoutDLine(textPtr, indexPtr) dlPtr->baseline = ascent + (dlPtr->height - ascent - descent)/2; } sValuePtr = dlPtr->chunkPtr->stylePtr->sValuePtr; - if (dlPtr->index.charIndex == 0) { + if (dlPtr->index.byteIndex == 0) { dlPtr->spaceAbove = sValuePtr->spacing1; } else { dlPtr->spaceAbove = sValuePtr->spacing2 - sValuePtr->spacing2/2; @@ -1214,7 +1217,7 @@ UpdateDisplayInfo(textPtr) * index within the line. */ - if (index.charIndex == dlPtr->index.charIndex) { + if (index.byteIndex == dlPtr->index.byteIndex) { /* * Case (a) -- can use existing display line as-is. */ @@ -1225,7 +1228,7 @@ UpdateDisplayInfo(textPtr) } goto lineOK; } - if (index.charIndex < dlPtr->index.charIndex) { + if (index.byteIndex < dlPtr->index.byteIndex) { goto makeNewDLine; } @@ -1252,7 +1255,7 @@ UpdateDisplayInfo(textPtr) lineOK: dlPtr->y = y; y += dlPtr->height; - TkTextIndexForwChars(&index, dlPtr->count, &index); + TkTextIndexForwBytes(&index, dlPtr->byteCount, &index); prevPtr = dlPtr; dlPtr = dlPtr->nextPtr; @@ -1303,7 +1306,7 @@ UpdateDisplayInfo(textPtr) */ if (y < maxY) { - int lineNum, spaceLeft, charsToCount; + int lineNum, spaceLeft, bytesToCount; DLine *lowestPtr; /* @@ -1316,22 +1319,22 @@ UpdateDisplayInfo(textPtr) spaceLeft = maxY - y; lineNum = TkBTreeLineIndex(dInfoPtr->dLinePtr->index.linePtr); - charsToCount = dInfoPtr->dLinePtr->index.charIndex; - if (charsToCount == 0) { - charsToCount = INT_MAX; + bytesToCount = dInfoPtr->dLinePtr->index.byteIndex; + if (bytesToCount == 0) { + bytesToCount = INT_MAX; lineNum--; } for ( ; (lineNum >= 0) && (spaceLeft > 0); lineNum--) { index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum); - index.charIndex = 0; + index.byteIndex = 0; lowestPtr = NULL; do { dlPtr = LayoutDLine(textPtr, &index); dlPtr->nextPtr = lowestPtr; lowestPtr = dlPtr; - TkTextIndexForwChars(&index, dlPtr->count, &index); - charsToCount -= dlPtr->count; - } while ((charsToCount > 0) + TkTextIndexForwBytes(&index, dlPtr->byteCount, &index); + bytesToCount -= dlPtr->byteCount; + } while ((bytesToCount > 0) && (index.linePtr == lowestPtr->index.linePtr)); /* @@ -1358,7 +1361,7 @@ UpdateDisplayInfo(textPtr) } } FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0); - charsToCount = INT_MAX; + bytesToCount = INT_MAX; } /* @@ -1445,13 +1448,13 @@ UpdateDisplayInfo(textPtr) } maxOffset = (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x) + textPtr->charWidth - 1)/textPtr->charWidth; - if (dInfoPtr->newCharOffset > maxOffset) { - dInfoPtr->newCharOffset = maxOffset; + if (dInfoPtr->newByteOffset > maxOffset) { + dInfoPtr->newByteOffset = maxOffset; } - if (dInfoPtr->newCharOffset < 0) { - dInfoPtr->newCharOffset = 0; + if (dInfoPtr->newByteOffset < 0) { + dInfoPtr->newByteOffset = 0; } - pixelOffset = dInfoPtr->newCharOffset * textPtr->charWidth; + pixelOffset = dInfoPtr->newByteOffset * textPtr->charWidth; if (pixelOffset != dInfoPtr->curPixelOffset) { dInfoPtr->curPixelOffset = pixelOffset; for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; @@ -1581,7 +1584,7 @@ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap) * to its left. */ - if (textPtr->state == tkNormalUid) { + if (textPtr->state == Tk_GetUid("normal")) { for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL); chunkPtr = chunkPtr->nextPtr) { x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset; @@ -2595,7 +2598,7 @@ TkTextChanged(textPtr, index1Ptr, index2Ptr) */ rounded = *index1Ptr; - rounded.charIndex = 0; + rounded.byteIndex = 0; firstPtr = FindDLine(dInfoPtr->dLinePtr, &rounded); if (firstPtr == NULL) { return; @@ -2671,7 +2674,7 @@ TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag) */ if (index2Ptr == NULL) { - index2Ptr = TkTextMakeIndex(textPtr->tree, + index2Ptr = TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &endOfText); } @@ -2725,13 +2728,13 @@ TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag) * previous character. */ - if (curIndexPtr->charIndex == 0) { + if (curIndexPtr->byteIndex == 0) { dlPtr = FindDLine(dlPtr, curIndexPtr); } else { TkTextIndex tmp; tmp = *curIndexPtr; - tmp.charIndex -= 1; + tmp.byteIndex -= 1; dlPtr = FindDLine(dlPtr, &tmp); } if (dlPtr == NULL) { @@ -2750,7 +2753,7 @@ TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag) } endPtr = FindDLine(dlPtr, endIndexPtr); if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr) - && (endPtr->index.charIndex < endIndexPtr->charIndex)) { + && (endPtr->index.byteIndex < endIndexPtr->byteIndex)) { endPtr = endPtr->nextPtr; } @@ -2862,7 +2865,7 @@ TkTextRelayoutWindow(textPtr) * or options could change the way lines wrap. */ - if (textPtr->topIndex.charIndex != 0) { + if (textPtr->topIndex.byteIndex != 0) { MeasureUp(textPtr, &textPtr->topIndex, 0, &textPtr->topIndex); } @@ -2929,7 +2932,7 @@ TkTextSetYView(textPtr, indexPtr, pickPlace) * without redisplaying it all. */ - if (indexPtr->charIndex == 0) { + if (indexPtr->byteIndex == 0) { textPtr->topIndex = *indexPtr; } else { MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex); @@ -2957,7 +2960,7 @@ TkTextSetYView(textPtr, indexPtr, pickPlace) dlPtr = NULL; } else if ((dlPtr->index.linePtr == indexPtr->linePtr) - && (dlPtr->index.charIndex <= indexPtr->charIndex)) { + && (dlPtr->index.byteIndex <= indexPtr->byteIndex)) { return; } } @@ -3055,37 +3058,37 @@ MeasureUp(textPtr, srcPtr, distance, dstPtr) TkTextIndex *dstPtr; /* Index to fill in with result. */ { int lineNum; /* Number of current line. */ - int charsToCount; /* Maximum number of characters to measure - * in current line. */ + int bytesToCount; /* Maximum number of bytes to measure in + * current line. */ TkTextIndex bestIndex; /* Best candidate seen so far for result. */ TkTextIndex index; DLine *dlPtr, *lowestPtr; int noBestYet; /* 1 means bestIndex hasn't been set. */ noBestYet = 1; - charsToCount = srcPtr->charIndex + 1; + bytesToCount = srcPtr->byteIndex + 1; index.tree = srcPtr->tree; for (lineNum = TkBTreeLineIndex(srcPtr->linePtr); lineNum >= 0; lineNum--) { /* * Layout an entire text line (potentially > 1 display line). * For the first line, which contains srcPtr, only layout the - * part up through srcPtr (charsToCount is non-infinite to + * part up through srcPtr (bytesToCount is non-infinite to * accomplish this). Make a list of all the display lines * in backwards order (the lowest DLine on the screen is first * in the list). */ index.linePtr = TkBTreeFindLine(srcPtr->tree, lineNum); - index.charIndex = 0; + index.byteIndex = 0; lowestPtr = NULL; do { dlPtr = LayoutDLine(textPtr, &index); dlPtr->nextPtr = lowestPtr; lowestPtr = dlPtr; - TkTextIndexForwChars(&index, dlPtr->count, &index); - charsToCount -= dlPtr->count; - } while ((charsToCount > 0) && (index.linePtr == dlPtr->index.linePtr)); + TkTextIndexForwBytes(&index, dlPtr->byteCount, &index); + bytesToCount -= dlPtr->byteCount; + } while ((bytesToCount > 0) && (index.linePtr == dlPtr->index.linePtr)); /* * Scan through the display lines to see if we've covered enough @@ -3112,7 +3115,7 @@ MeasureUp(textPtr, srcPtr, distance, dstPtr) if (distance < 0) { return; } - charsToCount = INT_MAX; /* Consider all chars. in next line. */ + bytesToCount = INT_MAX; /* Consider all chars. in next line. */ } /* @@ -3120,7 +3123,7 @@ MeasureUp(textPtr, srcPtr, distance, dstPtr) * in the text. */ - TkTextMakeIndex(textPtr->tree, 0, 0, dstPtr); + TkTextMakeByteIndex(textPtr->tree, 0, 0, dstPtr); } /* @@ -3152,7 +3155,7 @@ TkTextSeeCmd(textPtr, interp, argc, argv) { TextDInfo *dInfoPtr = textPtr->dInfoPtr; TkTextIndex index; - int x, y, width, height, lineWidth, charCount, oneThird, delta; + int x, y, width, height, lineWidth, byteCount, oneThird, delta; DLine *dlPtr; TkTextDispChunk *chunkPtr; @@ -3197,12 +3200,12 @@ TkTextSeeCmd(textPtr, interp, argc, argv) */ dlPtr = FindDLine(dInfoPtr->dLinePtr, &index); - charCount = index.charIndex - dlPtr->index.charIndex; + byteCount = index.byteIndex - dlPtr->index.byteIndex; for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) { - if (charCount < chunkPtr->numChars) { + if (byteCount < chunkPtr->numBytes) { break; } - charCount -= chunkPtr->numChars; + byteCount -= chunkPtr->numBytes; } /* @@ -3210,7 +3213,7 @@ TkTextSeeCmd(textPtr, interp, argc, argv) * the character within the chunk. */ - (*chunkPtr->bboxProc)(chunkPtr, charCount, dlPtr->y + dlPtr->spaceAbove, + (*chunkPtr->bboxProc)(chunkPtr, byteCount, dlPtr->y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width, &height); @@ -3218,18 +3221,18 @@ TkTextSeeCmd(textPtr, interp, argc, argv) oneThird = lineWidth/3; if (delta < 0) { if (delta < -oneThird) { - dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth; + dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth; } else { - dInfoPtr->newCharOffset -= ((-delta) + textPtr->charWidth - 1) + dInfoPtr->newByteOffset -= ((-delta) + textPtr->charWidth - 1) / textPtr->charWidth; } } else { delta -= (lineWidth - width); if (delta > 0) { if (delta > oneThird) { - dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth; + dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth; } else { - dInfoPtr->newCharOffset += (delta + textPtr->charWidth - 1) + dInfoPtr->newByteOffset += (delta + textPtr->charWidth - 1) / textPtr->charWidth; } } else { @@ -3284,7 +3287,7 @@ TkTextXviewCmd(textPtr, interp, argc, argv) return TCL_OK; } - newOffset = dInfoPtr->newCharOffset; + newOffset = dInfoPtr->newByteOffset; type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); switch (type) { case TK_SCROLL_ERROR: @@ -3305,14 +3308,14 @@ TkTextXviewCmd(textPtr, interp, argc, argv) if (charsPerPage < 1) { charsPerPage = 1; } - newOffset += charsPerPage*count; + newOffset += charsPerPage * count; break; case TK_SCROLL_UNITS: newOffset += count; break; } - dInfoPtr->newCharOffset = newOffset; + dInfoPtr->newByteOffset = newOffset; dInfoPtr->flags |= DINFO_OUT_OF_DATE; if (!(dInfoPtr->flags & REDRAW_PENDING)) { dInfoPtr->flags |= REDRAW_PENDING; @@ -3348,7 +3351,7 @@ ScrollByLines(textPtr, offset) * means that information earlier in the * text becomes visible. */ { - int i, charsToCount, lineNum; + int i, bytesToCount, lineNum; TkTextIndex new, index; TkTextLine *lastLinePtr; TextDInfo *dInfoPtr = textPtr->dInfoPtr; @@ -3361,21 +3364,21 @@ ScrollByLines(textPtr, offset) * it counts lines instead of pixels. */ - charsToCount = textPtr->topIndex.charIndex + 1; + bytesToCount = textPtr->topIndex.byteIndex + 1; index.tree = textPtr->tree; offset--; /* Skip line containing topIndex. */ for (lineNum = TkBTreeLineIndex(textPtr->topIndex.linePtr); lineNum >= 0; lineNum--) { index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum); - index.charIndex = 0; + index.byteIndex = 0; lowestPtr = NULL; do { dlPtr = LayoutDLine(textPtr, &index); dlPtr->nextPtr = lowestPtr; lowestPtr = dlPtr; - TkTextIndexForwChars(&index, dlPtr->count, &index); - charsToCount -= dlPtr->count; - } while ((charsToCount > 0) + TkTextIndexForwBytes(&index, dlPtr->byteCount, &index); + bytesToCount -= dlPtr->byteCount; + } while ((bytesToCount > 0) && (index.linePtr == dlPtr->index.linePtr)); for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) { @@ -3395,7 +3398,7 @@ ScrollByLines(textPtr, offset) if (offset >= 0) { goto scheduleUpdate; } - charsToCount = INT_MAX; + bytesToCount = INT_MAX; } /* @@ -3403,7 +3406,7 @@ ScrollByLines(textPtr, offset) * in the text. */ - TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->topIndex); + TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->topIndex); } else { /* * Scrolling down, to show later information in the text. @@ -3415,7 +3418,7 @@ ScrollByLines(textPtr, offset) for (i = 0; i < offset; i++) { dlPtr = LayoutDLine(textPtr, &textPtr->topIndex); dlPtr->nextPtr = NULL; - TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count, &new); + TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount, &new); FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0); if (new.linePtr == lastLinePtr) { break; @@ -3459,7 +3462,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv) * argv[1] is "yview". */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; - int pickPlace, lineNum, type, charsInLine; + int pickPlace, lineNum, type, bytesInLine; Tk_FontMetrics fm; int pixels, count; size_t switchLength; @@ -3497,7 +3500,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv) } if ((argc == 3) || pickPlace) { if (Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) { - TkTextMakeIndex(textPtr->tree, lineNum, 0, &index); + TkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index); TkTextSetYView(textPtr, &index, 0); return TCL_OK; } @@ -3532,11 +3535,11 @@ TkTextYviewCmd(textPtr, interp, argc, argv) } fraction *= TkBTreeNumLines(textPtr->tree); lineNum = (int) fraction; - TkTextMakeIndex(textPtr->tree, lineNum, 0, &index); - charsInLine = TkBTreeCharsInLine(index.linePtr); - index.charIndex = (int)((charsInLine * (fraction-lineNum)) + 0.5); - if (index.charIndex >= charsInLine) { - TkTextMakeIndex(textPtr->tree, lineNum+1, 0, &index); + TkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index); + bytesInLine = TkBTreeBytesInLine(index.linePtr); + index.byteIndex = (int)((bytesInLine * (fraction-lineNum)) + 0.5); + if (index.byteIndex >= bytesInLine) { + TkTextMakeByteIndex(textPtr->tree, lineNum + 1, 0, &index); } TkTextSetYView(textPtr, &index, 0); break; @@ -3574,7 +3577,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv) do { dlPtr = LayoutDLine(textPtr, &textPtr->topIndex); dlPtr->nextPtr = NULL; - TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count, + TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount, &new); pixels -= dlPtr->height; FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0); @@ -3626,7 +3629,7 @@ TkTextScanCmd(textPtr, interp, argc, argv) { TextDInfo *dInfoPtr = textPtr->dInfoPtr; TkTextIndex index; - int c, x, y, totalScroll, newChar, maxChar; + int c, x, y, totalScroll, newByte, maxByte; Tk_FontMetrics fm; size_t length; @@ -3656,18 +3659,20 @@ TkTextScanCmd(textPtr, interp, argc, argv) * moving again). */ - newChar = dInfoPtr->scanMarkChar + (10*(dInfoPtr->scanMarkX - x)) + newByte = dInfoPtr->scanMarkIndex + (10*(dInfoPtr->scanMarkX - x)) / (textPtr->charWidth); - maxChar = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x) + maxByte = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x) + textPtr->charWidth - 1)/textPtr->charWidth; - if (newChar < 0) { - dInfoPtr->scanMarkChar = newChar = 0; + if (newByte < 0) { + newByte = 0; + dInfoPtr->scanMarkIndex = 0; dInfoPtr->scanMarkX = x; - } else if (newChar > maxChar) { - dInfoPtr->scanMarkChar = newChar = maxChar; + } else if (newByte > maxByte) { + newByte = maxByte; + dInfoPtr->scanMarkIndex = maxByte; dInfoPtr->scanMarkX = x; } - dInfoPtr->newCharOffset = newChar; + dInfoPtr->newByteOffset = newByte; Tk_GetFontMetrics(textPtr->tkfont, &fm); totalScroll = (10*(dInfoPtr->scanMarkY - y)) / fm.linespace; @@ -3676,13 +3681,13 @@ TkTextScanCmd(textPtr, interp, argc, argv) ScrollByLines(textPtr, totalScroll-dInfoPtr->scanTotalScroll); dInfoPtr->scanTotalScroll = totalScroll; if ((index.linePtr == textPtr->topIndex.linePtr) && - (index.charIndex == textPtr->topIndex.charIndex)) { + (index.byteIndex == textPtr->topIndex.byteIndex)) { dInfoPtr->scanTotalScroll = 0; dInfoPtr->scanMarkY = y; } } } else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) { - dInfoPtr->scanMarkChar = dInfoPtr->newCharOffset; + dInfoPtr->scanMarkIndex = dInfoPtr->newByteOffset; dInfoPtr->scanMarkX = x; dInfoPtr->scanTotalScroll = 0; dInfoPtr->scanMarkY = y; @@ -3709,11 +3714,11 @@ TkTextScanCmd(textPtr, interp, argc, argv) * Tcl script to report them to the text's associated scrollbar. * * Results: - * If report is zero, then interp->result is filled in with + * If report is zero, then the interp's result is filled in with * two real numbers separated by a space, giving the position of * the left and right edges of the window as fractions from 0 to * 1, where 0 means the left edge of the text and 1 means the right - * edge. If report is non-zero, then interp->result isn't modified + * edge. If report is non-zero, then the interp's result isn't modified * directly, but instead a script is evaluated in interp to report * the new horizontal scroll position to the scrollbar (if the scroll * position hasn't changed then no script is invoked). @@ -3728,13 +3733,13 @@ static void GetXView(interp, textPtr, report) Tcl_Interp *interp; /* If "report" is FALSE, string * describing visible range gets - * stored in interp->result. */ + * stored in the interp's result. */ TkText *textPtr; /* Information about text widget. */ int report; /* Non-zero means report info to * scrollbar if it has changed. */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; - char buffer[200]; + char buffer[TCL_DOUBLE_SPACE * 2]; double first, last; int code; @@ -3751,7 +3756,8 @@ GetXView(interp, textPtr, report) last = 1.0; } if (!report) { - sprintf(interp->result, "%g %g", first, last); + sprintf(buffer, "%g %g", first, last); + Tcl_SetResult(interp, buffer, TCL_VOLATILE); return; } if ((first == dInfoPtr->xScrollFirst) && (last == dInfoPtr->xScrollLast)) { @@ -3779,11 +3785,11 @@ GetXView(interp, textPtr, report) * Tcl script to report them to the text's associated scrollbar. * * Results: - * If report is zero, then interp->result is filled in with + * If report is zero, then the interp's result is filled in with * two real numbers separated by a space, giving the position of * the top and bottom of the window as fractions from 0 to 1, where * 0 means the beginning of the text and 1 means the end. If - * report is non-zero, then interp->result isn't modified directly, + * report is non-zero, then the interp's result isn't modified directly, * but a script is evaluated in interp to report the new scroll * position to the scrollbar (if the scroll position hasn't changed * then no script is invoked). @@ -3798,22 +3804,22 @@ static void GetYView(interp, textPtr, report) Tcl_Interp *interp; /* If "report" is FALSE, string * describing visible range gets - * stored in interp->result. */ + * stored in the interp's result. */ TkText *textPtr; /* Information about text widget. */ int report; /* Non-zero means report info to * scrollbar if it has changed. */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; - char buffer[200]; + char buffer[TCL_DOUBLE_SPACE * 2]; double first, last; DLine *dlPtr; int totalLines, code, count; dlPtr = dInfoPtr->dLinePtr; totalLines = TkBTreeNumLines(textPtr->tree); - first = ((double) TkBTreeLineIndex(dlPtr->index.linePtr)) - + ((double) dlPtr->index.charIndex) - / (TkBTreeCharsInLine(dlPtr->index.linePtr)); + first = (double) TkBTreeLineIndex(dlPtr->index.linePtr) + + (double) dlPtr->index.byteIndex + / TkBTreeBytesInLine(dlPtr->index.linePtr); first /= totalLines; while (1) { if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) { @@ -3825,17 +3831,18 @@ GetYView(interp, textPtr, report) break; } if (dlPtr->nextPtr == NULL) { - count = dlPtr->count; + count = dlPtr->byteCount; break; } dlPtr = dlPtr->nextPtr; } last = ((double) TkBTreeLineIndex(dlPtr->index.linePtr)) - + ((double) (dlPtr->index.charIndex + count)) - / (TkBTreeCharsInLine(dlPtr->index.linePtr)); + + ((double) (dlPtr->index.byteIndex + count)) + / (TkBTreeBytesInLine(dlPtr->index.linePtr)); last /= totalLines; if (!report) { - sprintf(interp->result, "%g %g", first, last); + sprintf(buffer, "%g %g", first, last); + Tcl_SetResult(interp, buffer, TCL_VOLATILE); return; } if ((first == dInfoPtr->yScrollFirst) && (last == dInfoPtr->yScrollLast)) { @@ -3844,8 +3851,7 @@ GetYView(interp, textPtr, report) dInfoPtr->yScrollFirst = first; dInfoPtr->yScrollLast = last; sprintf(buffer, " %g %g", first, last); - code = Tcl_VarEval(interp, textPtr->yScrollCmd, - buffer, (char *) NULL); + code = Tcl_VarEval(interp, textPtr->yScrollCmd, buffer, (char *) NULL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (vertical scrolling command executed by text)"); @@ -3917,7 +3923,7 @@ FindDLine(dlPtr, indexPtr) * Now get to the right position within the text line. */ - while (indexPtr->charIndex >= (dlPtr->index.charIndex + dlPtr->count)) { + while (indexPtr->byteIndex >= (dlPtr->index.byteIndex + dlPtr->byteCount)) { dlPtr = dlPtr->nextPtr; if ((dlPtr == NULL) || (dlPtr->index.linePtr != indexPtr->linePtr)) { break; @@ -4009,21 +4015,22 @@ TkTextPixelIndex(textPtr, x, y, indexPtr) *indexPtr = dlPtr->index; x = x - dInfoPtr->x + dInfoPtr->curPixelOffset; for (chunkPtr = dlPtr->chunkPtr; x >= (chunkPtr->x + chunkPtr->width); - indexPtr->charIndex += chunkPtr->numChars, + indexPtr->byteIndex += chunkPtr->numBytes, chunkPtr = chunkPtr->nextPtr) { if (chunkPtr->nextPtr == NULL) { - indexPtr->charIndex += chunkPtr->numChars - 1; + indexPtr->byteIndex += chunkPtr->numBytes; + TkTextIndexBackChars(indexPtr, 1, indexPtr); return; } } /* - * If the chunk has more than one character in it, ask it which + * If the chunk has more than one byte in it, ask it which * character is at the desired location. */ - if (chunkPtr->numChars > 1) { - indexPtr->charIndex += (*chunkPtr->measureProc)(chunkPtr, x); + if (chunkPtr->numBytes > 1) { + indexPtr->byteIndex += (*chunkPtr->measureProc)(chunkPtr, x); } } @@ -4060,7 +4067,7 @@ TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr) TextDInfo *dInfoPtr = textPtr->dInfoPtr; DLine *dlPtr; register TkTextDispChunk *chunkPtr; - int index; + int byteIndex; /* * Make sure that all of the screen layout information is up to date. @@ -4084,15 +4091,15 @@ TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr) * index. */ - index = indexPtr->charIndex - dlPtr->index.charIndex; + byteIndex = indexPtr->byteIndex - dlPtr->index.byteIndex; for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) { if (chunkPtr == NULL) { return -1; } - if (index < chunkPtr->numChars) { + if (byteIndex < chunkPtr->numBytes) { break; } - index -= chunkPtr->numChars; + byteIndex -= chunkPtr->numBytes; } /* @@ -4103,12 +4110,12 @@ TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr) * horizontal scrolling. */ - (*chunkPtr->bboxProc)(chunkPtr, index, dlPtr->y + dlPtr->spaceAbove, + (*chunkPtr->bboxProc)(chunkPtr, byteIndex, dlPtr->y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr, heightPtr); *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curPixelOffset; - if ((index == (chunkPtr->numChars-1)) && (chunkPtr->nextPtr == NULL)) { + if ((byteIndex == (chunkPtr->numBytes - 1)) && (chunkPtr->nextPtr == NULL)) { /* * Last character in display line. Give it all the space up to * the line. @@ -4207,7 +4214,7 @@ TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr) * * This procedure is the "layoutProc" for character segments. * - * Results: +n * Results: * If there is something to display for the chunk then a * non-zero value is returned and the fields of chunkPtr * will be filled in (see the declaration of TkTextDispChunk @@ -4224,29 +4231,29 @@ TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr) */ int -TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, +TkTextCharLayoutProc(textPtr, indexPtr, segPtr, byteOffset, maxX, maxBytes, noCharsYet, wrapMode, chunkPtr) TkText *textPtr; /* Text widget being layed out. */ TkTextIndex *indexPtr; /* Index of first character to lay out * (corresponds to segPtr and offset). */ TkTextSegment *segPtr; /* Segment being layed out. */ - int offset; /* Offset within segment of first character - * to consider. */ + int byteOffset; /* Byte offset within segment of first + * character to consider. */ int maxX; /* Chunk must not occupy pixels at this * position or higher. */ - int maxChars; /* Chunk must not include more than this + int maxBytes; /* Chunk must not include more than this * many characters. */ int noCharsYet; /* Non-zero means no characters have been * assigned to this display line yet. */ - Tk_Uid wrapMode; /* How to handle line wrapping: tkTextCharUid, - * tkTextNoneUid, or tkTextWordUid. */ + Tk_Uid wrapMode; /* How to handle line wrapping: char, + * none, or text. */ register TkTextDispChunk *chunkPtr; /* Structure to fill in with information * about this chunk. The x field has already * been set by the caller. */ { Tk_Font tkfont; - int nextX, charsThatFit, count; + int nextX, bytesThatFit, count; CharInfo *ciPtr; char *p; TkTextSegment *nextPtr; @@ -4264,17 +4271,19 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, * is a white space character. */ - p = segPtr->body.chars + offset; + p = segPtr->body.chars + byteOffset; tkfont = chunkPtr->stylePtr->sValuePtr->tkfont; - charsThatFit = MeasureChars(tkfont, p, maxChars, chunkPtr->x, maxX, 0, + bytesThatFit = MeasureChars(tkfont, p, maxBytes, chunkPtr->x, maxX, 0, &nextX); - if (charsThatFit < maxChars) { - if ((charsThatFit == 0) && noCharsYet) { - charsThatFit = 1; - MeasureChars(tkfont, p, 1, chunkPtr->x, INT_MAX, 0, &nextX); + if (bytesThatFit < maxBytes) { + if ((bytesThatFit == 0) && noCharsYet) { + Tcl_UniChar ch; + + bytesThatFit = MeasureChars(tkfont, p, Tcl_UtfToUniChar(p, &ch), + chunkPtr->x, -1, 0, &nextX); } - if ((nextX < maxX) && ((p[charsThatFit] == ' ') - || (p[charsThatFit] == '\t'))) { + if ((nextX < maxX) && ((p[bytesThatFit] == ' ') + || (p[bytesThatFit] == '\t'))) { /* * Space characters are funny, in that they are considered * to fit if there is at least one pixel of space left on the @@ -4282,17 +4291,17 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, */ nextX = maxX; - charsThatFit++; + bytesThatFit++; } - if (p[charsThatFit] == '\n') { + if (p[bytesThatFit] == '\n') { /* * A newline character takes up no space, so if the previous * character fits then so does the newline. */ - charsThatFit++; + bytesThatFit++; } - if (charsThatFit == 0) { + if (bytesThatFit == 0) { return 0; } } @@ -4309,19 +4318,19 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, chunkPtr->undisplayProc = CharUndisplayProc; chunkPtr->measureProc = CharMeasureProc; chunkPtr->bboxProc = CharBboxProc; - chunkPtr->numChars = charsThatFit; + chunkPtr->numBytes = bytesThatFit; chunkPtr->minAscent = fm.ascent + chunkPtr->stylePtr->sValuePtr->offset; chunkPtr->minDescent = fm.descent - chunkPtr->stylePtr->sValuePtr->offset; chunkPtr->minHeight = 0; chunkPtr->width = nextX - chunkPtr->x; chunkPtr->breakIndex = -1; ciPtr = (CharInfo *) ckalloc((unsigned) - (sizeof(CharInfo) - 3 + charsThatFit)); + (sizeof(CharInfo) - 3 + bytesThatFit)); chunkPtr->clientData = (ClientData) ciPtr; - ciPtr->numChars = charsThatFit; - strncpy(ciPtr->chars, p, (size_t) charsThatFit); - if (p[charsThatFit-1] == '\n') { - ciPtr->numChars--; + ciPtr->numBytes = bytesThatFit; + strncpy(ciPtr->chars, p, (size_t) bytesThatFit); + if (p[bytesThatFit - 1] == '\n') { + ciPtr->numBytes--; } /* @@ -4331,22 +4340,22 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, * is not a character segment. */ - if (wrapMode != tkTextWordUid) { - chunkPtr->breakIndex = chunkPtr->numChars; + if (wrapMode != Tk_GetUid("word")) { + chunkPtr->breakIndex = chunkPtr->numBytes; } else { - for (count = charsThatFit, p += charsThatFit-1; count > 0; + for (count = bytesThatFit, p += bytesThatFit - 1; count > 0; count--, p--) { if (isspace(UCHAR(*p))) { chunkPtr->breakIndex = count; break; } } - if ((charsThatFit+offset) == segPtr->size) { + if ((bytesThatFit + byteOffset) == segPtr->size) { for (nextPtr = segPtr->nextPtr; nextPtr != NULL; nextPtr = nextPtr->nextPtr) { if (nextPtr->size != 0) { if (nextPtr->typePtr != &tkTextCharType) { - chunkPtr->breakIndex = chunkPtr->numChars; + chunkPtr->breakIndex = chunkPtr->numBytes; } break; } @@ -4393,7 +4402,7 @@ CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY) CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; TextStyle *stylePtr; StyleValues *sValuePtr; - int offsetChars, offsetX; + int offsetBytes, offsetX; if ((x + chunkPtr->width) <= 0) { /* @@ -4415,30 +4424,29 @@ CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY) */ offsetX = x; - offsetChars = 0; + offsetBytes = 0; if (x < 0) { - offsetChars = MeasureChars(sValuePtr->tkfont, ciPtr->chars, - ciPtr->numChars, x, 0, x - chunkPtr->x, &offsetX); + offsetBytes = MeasureChars(sValuePtr->tkfont, ciPtr->chars, + ciPtr->numBytes, x, 0, x - chunkPtr->x, &offsetX); } /* * Draw the text, underline, and overstrike for this chunk. */ - if (ciPtr->numChars > offsetChars) { - int numChars = ciPtr->numChars - offsetChars; - char *string = ciPtr->chars + offsetChars; + if (ciPtr->numBytes > offsetBytes) { + int numBytes = ciPtr->numBytes - offsetBytes; + char *string = ciPtr->chars + offsetBytes; - if ((numChars > 0) && (string[numChars - 1] == '\t')) { - numChars--; + if ((numBytes > 0) && (string[numBytes - 1] == '\t')) { + numBytes--; } Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string, - numChars, offsetX, y + baseline - sValuePtr->offset); + numBytes, offsetX, y + baseline - sValuePtr->offset); if (sValuePtr->underline) { Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, - ciPtr->chars + offsetChars, offsetX, - y + baseline - sValuePtr->offset, - 0, numChars); + ciPtr->chars + offsetBytes, offsetX, + y + baseline - sValuePtr->offset, 0, numBytes); } if (sValuePtr->overstrike) { @@ -4446,10 +4454,10 @@ CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY) Tk_GetFontMetrics(sValuePtr->tkfont, &fm); Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, - ciPtr->chars + offsetChars, offsetX, + ciPtr->chars + offsetBytes, offsetX, y + baseline - sValuePtr->offset - fm.descent - (fm.ascent * 3) / 10, - 0, numChars); + 0, numBytes); } } } @@ -4511,7 +4519,8 @@ CharMeasureProc(chunkPtr, x) int endX; return MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars, - chunkPtr->numChars-1, chunkPtr->x, x, 0, &endX); + chunkPtr->numBytes - 1, chunkPtr->x, x, 0, &endX); + /* CHAR OFFSET */ } /* @@ -4538,11 +4547,11 @@ CharMeasureProc(chunkPtr, x) */ static void -CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr, +CharBboxProc(chunkPtr, byteIndex, y, lineHeight, baseline, xPtr, yPtr, widthPtr, heightPtr) TkTextDispChunk *chunkPtr; /* Chunk containing desired char. */ - int index; /* Index of desired character within - * the chunk. */ + int byteIndex; /* Byte offset of desired character + * within the chunk. */ int y; /* Topmost pixel in area allocated * for this line. */ int lineHeight; /* Height of line, in pixels. */ @@ -4561,10 +4570,10 @@ CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr, int maxX; maxX = chunkPtr->width + chunkPtr->x; - MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars, index, - chunkPtr->x, 1000000, 0, xPtr); + MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars, + byteIndex, chunkPtr->x, -1, 0, xPtr); - if (index == ciPtr->numChars) { + if (byteIndex == ciPtr->numBytes) { /* * This situation only happens if the last character in a line * is a space character, in which case it absorbs all of the @@ -4572,8 +4581,8 @@ CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr, */ *widthPtr = maxX - *xPtr; - } else if ((ciPtr->chars[index] == '\t') - && (index == (ciPtr->numChars-1))) { + } else if ((ciPtr->chars[byteIndex] == '\t') + && (byteIndex == ciPtr->numBytes - 1)) { /* * The desired character is a tab character that terminates a * chunk; give it all the space left in the chunk. @@ -4582,7 +4591,7 @@ CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr, *widthPtr = maxX - *xPtr; } else { MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, - ciPtr->chars + index, 1, *xPtr, 1000000, 0, widthPtr); + ciPtr->chars + byteIndex, 1, *xPtr, -1, 0, widthPtr); if (*widthPtr > maxX) { *widthPtr = maxX - *xPtr; } else { @@ -4717,7 +4726,7 @@ AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr) continue; } ciPtr = (CharInfo *) chunkPtr2->clientData; - for (p = ciPtr->chars, i = 0; i < ciPtr->numChars; p++, i++) { + for (p = ciPtr->chars, i = 0; i < ciPtr->numBytes; p++, i++) { if (isdigit(UCHAR(*p))) { gotDigit = 1; } else if ((*p == '.') || (*p == ',')) { @@ -4738,7 +4747,7 @@ AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr) ciPtr = (CharInfo *) decimalChunkPtr->clientData; MeasureChars(decimalChunkPtr->stylePtr->sValuePtr->tkfont, - ciPtr->chars, decimal, decimalChunkPtr->x, 1000000, 0, &curX); + ciPtr->chars, decimal, decimalChunkPtr->x, -1, 0, &curX); desired = tabX - (curX - x); goto update; } else { @@ -4763,7 +4772,7 @@ AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr) update: delta = desired - x; - MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth); + MeasureChars(textPtr->tkfont, " ", 1, 0, -1, 0, &spaceWidth); if (delta < spaceWidth) { delta = spaceWidth; } @@ -4868,7 +4877,7 @@ SizeOfTab(textPtr, tabArrayPtr, index, x, maxX) } done: - MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth); + MeasureChars(textPtr->tkfont, " ", 1, 0, -1, 0, &spaceWidth); if (result < spaceWidth) { result = spaceWidth; } @@ -4938,7 +4947,7 @@ NextTabStop(tkfont, x, tabOrigin) * is specified. * * Results: - * The return value is the number of characters from source + * The return value is the number of bytes from source * that fit in the span given by startX and maxX. *nextXPtr * is filled in with the x-coordinate at which the first * character that didn't fit would be drawn, if it were to @@ -4951,11 +4960,11 @@ NextTabStop(tkfont, x, tabOrigin) */ static int -MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr) +MeasureChars(tkfont, source, maxBytes, startX, maxX, tabOrigin, nextXPtr) Tk_Font tkfont; /* Font in which to draw characters. */ CONST char *source; /* Characters to be displayed. Need not * be NULL-terminated. */ - int maxChars; /* Maximum # of characters to consider from + int maxBytes; /* Maximum # of bytes to consider from * source. */ int startX; /* X-position at which first character will * be drawn. */ @@ -4972,7 +4981,7 @@ MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr) ch = 0; /* lint. */ curX = startX; special = source; - end = source + maxChars; + end = source + maxBytes; for (start = source; start < end; ) { if (start >= special) { /* @@ -4992,7 +5001,7 @@ MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr) * string). Process characters between start and special. */ - if (curX >= maxX) { + if ((maxX >= 0) && (curX >= maxX)) { break; } start += Tk_MeasureChars(tkfont, start, special - start, maxX - curX, diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index 06aff3c..b2d1923 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -5,12 +5,12 @@ * nested inside text widgets. It also implements the "image" * widget command for texts. * - * Copyright (c) 1996 Sun Microsystems, Inc. + * Copyright (c) 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextImage.c,v 1.2 1998/09/14 18:23:19 stanton Exp $ + * RCS: @(#) $Id: tkTextImage.c,v 1.3 1999/04/16 01:51:23 stanton Exp $ */ #include "tk.h" @@ -221,7 +221,7 @@ TkTextImageCmd(textPtr, interp, argc, argv) lineIndex = TkBTreeLineIndex(index.linePtr); if (lineIndex == TkBTreeNumLines(textPtr->tree)) { lineIndex--; - TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index); + TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index); } /* @@ -288,7 +288,7 @@ TkTextImageCmd(textPtr, interp, argc, argv) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message.. + * returned, then the interp's result contains an error message.. * * Side effects: * Configuration information for the embedded image changes, @@ -384,7 +384,7 @@ EmbImageConfigure(textPtr, eiPtr, argc, argv) Tcl_DStringAppend(&newName,name, -1); if (conflict) { - char buf[10]; + char buf[4 + TCL_INTEGER_SPACE]; sprintf(buf, "#%d",count+1); Tcl_DStringAppend(&newName,buf, -1); } @@ -604,8 +604,8 @@ EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars, * many characters. */ int noCharsYet; /* Non-zero means no characters have been * assigned to this line yet. */ - Tk_Uid wrapMode; /* Wrap mode to use for line: tkTextCharUid, - * tkTextNoneUid, or tkTextWordUid. */ + Tk_Uid wrapMode; /* Wrap mode to use for line: char, + * text, or word. */ register TkTextDispChunk *chunkPtr; /* Structure to fill in with information * about this chunk. The x field has already @@ -630,7 +630,7 @@ EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars, height += 2*eiPtr->body.ei.padY; } if ((width > (maxX - chunkPtr->x)) - && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) { + && !noCharsYet && (textPtr->wrapMode != Tk_GetUid("none"))) { return 0; } @@ -642,7 +642,7 @@ EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars, chunkPtr->undisplayProc = (Tk_ChunkUndisplayProc *) NULL; chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL; chunkPtr->bboxProc = EmbImageBboxProc; - chunkPtr->numChars = 1; + chunkPtr->numBytes = 1; if (eiPtr->body.ei.align == ALIGN_BASELINE) { chunkPtr->minAscent = height - eiPtr->body.ei.padY; chunkPtr->minDescent = eiPtr->body.ei.padY; @@ -857,7 +857,7 @@ TkTextImageIndex(textPtr, name, indexPtr) eiPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->tree; indexPtr->linePtr = eiPtr->body.ei.linePtr; - indexPtr->charIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr); + indexPtr->byteIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr); return 1; } @@ -893,6 +893,6 @@ EmbImageProc(clientData, x, y, width, height, imgWidth, imgHeight) index.tree = eiPtr->body.ei.textPtr->tree; index.linePtr = eiPtr->body.ei.linePtr; - index.charIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr); + index.byteIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr); TkTextChanged(eiPtr->body.ei.textPtr, &index, &index); } diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index 4d2ac8e..8376419 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -5,12 +5,12 @@ * text widgets. * * Copyright (c) 1992-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextIndex.c,v 1.2 1998/09/14 18:23:19 stanton Exp $ + * RCS: @(#) $Id: tkTextIndex.c,v 1.3 1999/04/16 01:51:24 stanton Exp $ */ #include "default.h" @@ -34,27 +34,118 @@ static char * StartEnd _ANSI_ARGS_(( char *string, TkTextIndex *indexPtr)); /* - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- * - * TkTextMakeIndex -- + * TkTextMakeByteIndex -- * - * Given a line index and a character index, look things up - * in the B-tree and fill in a TkTextIndex structure. + * Given a line index and a byte index, look things up in the B-tree + * and fill in a TkTextIndex structure. * * Results: - * The structure at *indexPtr is filled in with information - * about the character at lineIndex and charIndex (or the - * closest existing character, if the specified one doesn't - * exist), and indexPtr is returned as result. + * The structure at *indexPtr is filled in with information about the + * character at lineIndex and byteIndex (or the closest existing + * character, if the specified one doesn't exist), and indexPtr is + * returned as result. * * Side effects: * None. * - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- */ TkTextIndex * -TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr) +TkTextMakeByteIndex(tree, lineIndex, byteIndex, indexPtr) + TkTextBTree tree; /* Tree that lineIndex and charIndex refer + * to. */ + int lineIndex; /* Index of desired line (0 means first + * line of text). */ + int byteIndex; /* Byte index of desired character. */ + TkTextIndex *indexPtr; /* Structure to fill in. */ +{ + TkTextSegment *segPtr; + int index; + char *p, *start; + Tcl_UniChar ch; + + indexPtr->tree = tree; + if (lineIndex < 0) { + lineIndex = 0; + byteIndex = 0; + } + if (byteIndex < 0) { + byteIndex = 0; + } + indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex); + if (indexPtr->linePtr == NULL) { + indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree)); + byteIndex = 0; + } + if (byteIndex == 0) { + indexPtr->byteIndex = byteIndex; + return indexPtr; + } + + /* + * Verify that the index is within the range of the line and points + * to a valid character boundary. + */ + + index = 0; + for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) { + if (segPtr == NULL) { + /* + * Use the index of the last character in the line. Since + * the last character on the line is guaranteed to be a '\n', + * we can back up a constant sizeof(char) bytes. + */ + + indexPtr->byteIndex = index - sizeof(char); + break; + } + if (index + segPtr->size > byteIndex) { + indexPtr->byteIndex = byteIndex; + 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 + * falls in the middle of a UTF-8 character, it will be + * adjusted to the end of that UTF-8 character. + */ + + start = segPtr->body.chars + (byteIndex - index); + p = Tcl_UtfPrev(start, segPtr->body.chars); + p += Tcl_UtfToUniChar(p, &ch); + indexPtr->byteIndex += p - start; + } + break; + } + index += segPtr->size; + } + return indexPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * TkTextMakeCharIndex -- + * + * Given a line index and a character index, look things up in the + * B-tree and fill in a TkTextIndex structure. + * + * Results: + * The structure at *indexPtr is filled in with information about the + * character at lineIndex and charIndex (or the closest existing + * character, if the specified one doesn't exist), and indexPtr is + * returned as result. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +TkTextIndex * +TkTextMakeCharIndex(tree, lineIndex, charIndex, indexPtr) TkTextBTree tree; /* Tree that lineIndex and charIndex refer * to. */ int lineIndex; /* Index of desired line (0 means first @@ -63,7 +154,9 @@ TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr) TkTextIndex *indexPtr; /* Structure to fill in. */ { register TkTextSegment *segPtr; - int index; + char *p, *start, *end; + int index, offset; + Tcl_UniChar ch; indexPtr->tree = tree; if (lineIndex < 0) { @@ -84,53 +177,76 @@ TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr) * If not, just use the index of the last character in the line. */ - for (index = 0, segPtr = indexPtr->linePtr->segPtr; ; - segPtr = segPtr->nextPtr) { + index = 0; + for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) { if (segPtr == NULL) { - indexPtr->charIndex = index-1; + /* + * Use the index of the last character in the line. Since + * the last character on the line is guaranteed to be a '\n', + * we can back up a constant sizeof(char) bytes. + */ + + indexPtr->byteIndex = index - sizeof(char); break; } - index += segPtr->size; - if (index > charIndex) { - indexPtr->charIndex = charIndex; - break; + if (segPtr->typePtr == &tkTextCharType) { + /* + * Turn character offset into a byte offset. + */ + + start = segPtr->body.chars; + end = start + segPtr->size; + for (p = start; p < end; p += offset) { + if (charIndex == 0) { + indexPtr->byteIndex = index; + return indexPtr; + } + charIndex--; + offset = Tcl_UtfToUniChar(p, &ch); + index += offset; + } + } else { + if (charIndex < segPtr->size) { + indexPtr->byteIndex = index; + break; + } + charIndex -= segPtr->size; + index += segPtr->size; } } return indexPtr; } /* - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- * * TkTextIndexToSeg -- * - * Given an index, this procedure returns the segment and - * offset within segment for the index. + * Given an index, this procedure returns the segment and offset + * within segment for the index. * * Results: - * The return value is a pointer to the segment referred to - * by indexPtr; this will always be a segment with non-zero - * size. The variable at *offsetPtr is set to hold the - * integer offset within the segment of the character - * given by indexPtr. + * The return value is a pointer to the segment referred to by + * indexPtr; this will always be a segment with non-zero size. The + * variable at *offsetPtr is set to hold the integer offset within + * the segment of the character given by indexPtr. * * Side effects: * None. * - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- */ TkTextSegment * TkTextIndexToSeg(indexPtr, offsetPtr) - TkTextIndex *indexPtr; /* Text index. */ - int *offsetPtr; /* Where to store offset within - * segment, or NULL if offset isn't - * wanted. */ + CONST TkTextIndex *indexPtr;/* Text index. */ + int *offsetPtr; /* Where to store offset within segment, or + * NULL if offset isn't wanted. */ { - register TkTextSegment *segPtr; + TkTextSegment *segPtr; int offset; - for (offset = indexPtr->charIndex, segPtr = indexPtr->linePtr->segPtr; + for (offset = indexPtr->byteIndex, segPtr = indexPtr->linePtr->segPtr; offset >= segPtr->size; offset -= segPtr->size, segPtr = segPtr->nextPtr) { /* Empty loop body. */ @@ -142,30 +258,29 @@ TkTextIndexToSeg(indexPtr, offsetPtr) } /* - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- * * TkTextSegToOffset -- * - * Given a segment pointer and the line containing it, this - * procedure returns the offset of the segment within its - * line. + * Given a segment pointer and the line containing it, this procedure + * returns the offset of the segment within its line. * * Results: - * The return value is the offset (within its line) of the - * first character in segPtr. + * The return value is the offset (within its line) of the first + * character in segPtr. * * Side effects: * None. * - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- */ int TkTextSegToOffset(segPtr, linePtr) - TkTextSegment *segPtr; /* Segment whose offset is desired. */ - TkTextLine *linePtr; /* Line containing segPtr. */ + CONST TkTextSegment *segPtr;/* Segment whose offset is desired. */ + CONST TkTextLine *linePtr; /* Line containing segPtr. */ { - TkTextSegment *segPtr2; + CONST TkTextSegment *segPtr2; int offset; offset = 0; @@ -177,23 +292,22 @@ TkTextSegToOffset(segPtr, linePtr) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * TkTextGetIndex -- * - * Given a string, return the line and character indices that - * it describes. + * Given a string, return the index that is described. * * Results: - * The return value is a standard Tcl return result. If - * TCL_OK is returned, then everything went well and the index - * at *indexPtr is filled in; otherwise TCL_ERROR is returned - * and an error message is left in interp->result. + * The return value is a standard Tcl return result. If TCL_OK is + * returned, then everything went well and the index at *indexPtr is + * filled in; otherwise TCL_ERROR is returned and an error message + * is left in the interp's result. * * Side effects: * None. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ int @@ -203,8 +317,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) char *string; /* Textual description of position. */ TkTextIndex *indexPtr; /* Index structure to fill in. */ { - register char *p; - char *end, *endOfBase; + char *p, *end, *endOfBase; Tcl_HashEntry *hPtr; TkTextTag *tagPtr; TkTextSearch search; @@ -259,8 +372,8 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) goto tryxy; } tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr); - TkTextMakeIndex(textPtr->tree, 0, 0, &first); - TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, + TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &last); TkBTreeStartSearch(&first, &last, tagPtr, &search); if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) { @@ -324,7 +437,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) } endOfBase = end; } - TkTextMakeIndex(textPtr->tree, lineIndex, charIndex, indexPtr); + TkTextMakeCharIndex(textPtr->tree, lineIndex, charIndex, indexPtr); goto gotBase; } @@ -353,7 +466,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) * Base position is end of text. */ - TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, indexPtr); goto gotBase; } else { @@ -420,13 +533,12 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * TkTextPrintIndex -- - * * - * This procedure generates a string description of an index, - * suitable for reading in again later. + * This procedure generates a string description of an index, suitable + * for reading in again later. * * Results: * The characters pointed to by string are modified. @@ -434,49 +546,69 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) * Side effects: * None. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ void TkTextPrintIndex(indexPtr, string) - TkTextIndex *indexPtr; /* Pointer to index. */ + CONST TkTextIndex *indexPtr;/* Pointer to index. */ char *string; /* Place to store the position. Must have * at least TK_POS_CHARS characters. */ { + TkTextSegment *segPtr; + int numBytes, charIndex; + + numBytes = indexPtr->byteIndex; + charIndex = 0; + for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) { + if (numBytes <= segPtr->size) { + break; + } + if (segPtr->typePtr == &tkTextCharType) { + charIndex += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size); + } else { + charIndex += segPtr->size; + } + numBytes -= segPtr->size; + } + if (segPtr->typePtr == &tkTextCharType) { + charIndex += Tcl_NumUtfChars(segPtr->body.chars, numBytes); + } else { + charIndex += numBytes; + } sprintf(string, "%d.%d", TkBTreeLineIndex(indexPtr->linePtr) + 1, - indexPtr->charIndex); + charIndex); } /* - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- * * TkTextIndexCmp -- * - * Compare two indices to see which one is earlier in - * the text. + * Compare two indices to see which one is earlier in the text. * * Results: - * The return value is 0 if index1Ptr and index2Ptr refer - * to the same position in the file, -1 if index1Ptr refers - * to an earlier position than index2Ptr, and 1 otherwise. + * The return value is 0 if index1Ptr and index2Ptr refer to the same + * position in the file, -1 if index1Ptr refers to an earlier position + * than index2Ptr, and 1 otherwise. * * Side effects: * None. * - *-------------------------------------------------------------- + *--------------------------------------------------------------------------- */ int TkTextIndexCmp(index1Ptr, index2Ptr) - TkTextIndex *index1Ptr; /* First index. */ - TkTextIndex *index2Ptr; /* Second index. */ + CONST TkTextIndex *index1Ptr; /* First index. */ + CONST TkTextIndex *index2Ptr; /* Second index. */ { int line1, line2; if (index1Ptr->linePtr == index2Ptr->linePtr) { - if (index1Ptr->charIndex < index2Ptr->charIndex) { + if (index1Ptr->byteIndex < index2Ptr->byteIndex) { return -1; - } else if (index1Ptr->charIndex > index2Ptr->charIndex) { + } else if (index1Ptr->byteIndex > index2Ptr->byteIndex) { return 1; } else { return 0; @@ -494,23 +626,23 @@ TkTextIndexCmp(index1Ptr, index2Ptr) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * ForwBack -- * - * This procedure handles +/- modifiers for indices to adjust - * the index forwards or backwards. + * This procedure handles +/- modifiers for indices to adjust the + * index forwards or backwards. * * Results: - * If the modifier in string is successfully parsed then the - * return value is the address of the first character after the - * modifier, and *indexPtr is updated to reflect the modifier. - * If there is a syntax error in the modifier then NULL is returned. + * If the modifier in string is successfully parsed then the return + * value is the address of the first character after the modifier, + * and *indexPtr is updated to reflect the modifier. If there is a + * syntax error in the modifier then NULL is returned. * * Side effects: * None. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ static char * @@ -550,7 +682,7 @@ ForwBack(string, indexPtr) */ units = p; - while ((*p != 0) && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) { + while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) { p++; } length = p - units; @@ -578,7 +710,18 @@ ForwBack(string, indexPtr) lineIndex = 0; } } - TkTextMakeIndex(indexPtr->tree, lineIndex, indexPtr->charIndex, + /* + * This doesn't work quite right if using a proportional font or + * UTF-8 characters with varying numbers of bytes. The cursor will + * bop around, keeping a constant number of bytes (not characters) + * from the left edge (but making sure not to split any UTF-8 + * characters), regardless of the x-position the index corresponds + * to. The proper way to do this is to get the x-position of the + * index and then pick the character at the same x-position in the + * new line. + */ + + TkTextMakeByteIndex(indexPtr->tree, lineIndex, indexPtr->byteIndex, indexPtr); } else { return NULL; @@ -587,44 +730,42 @@ ForwBack(string, indexPtr) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * - * TkTextIndexForwChars -- + * TkTextIndexForwBytes -- * - * Given an index for a text widget, this procedure creates a - * new index that points "count" characters ahead of the source - * index. + * Given an index for a text widget, this procedure creates a new + * index that points "count" bytes ahead of the source index. * * Results: - * *dstPtr is modified to refer to the character "count" characters - * after srcPtr, or to the last character in the file if there aren't - * "count" characters left in the file. + * *dstPtr is modified to refer to the character "count" bytes after + * srcPtr, or to the last character in the TkText if there aren't + * "count" bytes left. * * Side effects: * None. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ - /* ARGSUSED */ void -TkTextIndexForwChars(srcPtr, count, dstPtr) - TkTextIndex *srcPtr; /* Source index. */ - int count; /* How many characters forward to - * move. May be negative. */ - TkTextIndex *dstPtr; /* Destination index: gets modified. */ +TkTextIndexForwBytes(srcPtr, byteCount, dstPtr) + CONST TkTextIndex *srcPtr; /* Source index. */ + int byteCount; /* How many bytes forward to move. May be + * negative. */ + TkTextIndex *dstPtr; /* Destination index: gets modified. */ { TkTextLine *linePtr; TkTextSegment *segPtr; int lineLength; - if (count < 0) { - TkTextIndexBackChars(srcPtr, -count, dstPtr); + if (byteCount < 0) { + TkTextIndexBackBytes(srcPtr, -byteCount, dstPtr); return; } *dstPtr = *srcPtr; - dstPtr->charIndex += count; + dstPtr->byteIndex += byteCount; while (1) { /* * Compute the length of the current line. @@ -641,13 +782,13 @@ TkTextIndexForwChars(srcPtr, count, dstPtr) * Otherwise go on to the next line. */ - if (dstPtr->charIndex < lineLength) { + if (dstPtr->byteIndex < lineLength) { return; } - dstPtr->charIndex -= lineLength; + dstPtr->byteIndex -= lineLength; linePtr = TkBTreeNextLine(dstPtr->linePtr); if (linePtr == NULL) { - dstPtr->charIndex = lineLength - 1; + dstPtr->byteIndex = lineLength - 1; return; } dstPtr->linePtr = linePtr; @@ -655,44 +796,133 @@ TkTextIndexForwChars(srcPtr, count, dstPtr) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * - * TkTextIndexBackChars -- + * TkTextIndexForwChars -- * - * Given an index for a text widget, this procedure creates a - * new index that points "count" characters earlier than the - * source index. + * Given an index for a text widget, this procedure creates a new + * index that points "count" characters ahead of the source index. * * Results: * *dstPtr is modified to refer to the character "count" characters - * before srcPtr, or to the first character in the file if there aren't - * "count" characters earlier than srcPtr. + * after srcPtr, or to the last character in the TkText if there + * aren't "count" characters left in the file. * * Side effects: * None. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- + */ + +void +TkTextIndexForwChars(srcPtr, charCount, dstPtr) + CONST TkTextIndex *srcPtr; /* Source index. */ + int charCount; /* How many characters forward to move. + * May be negative. */ + TkTextIndex *dstPtr; /* Destination index: gets modified. */ +{ + TkTextLine *linePtr; + TkTextSegment *segPtr; + int byteOffset; + char *start, *end, *p; + Tcl_UniChar ch; + + if (charCount < 0) { + TkTextIndexBackChars(srcPtr, -charCount, dstPtr); + return; + } + + *dstPtr = *srcPtr; + + /* + * Find seg that contains src byteIndex. + * Move forward specified number of chars. + */ + + segPtr = TkTextIndexToSeg(dstPtr, &byteOffset); + while (1) { + /* + * Go through each segment in line looking for specified character + * index. + */ + + for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr == &tkTextCharType) { + start = segPtr->body.chars + byteOffset; + end = segPtr->body.chars + segPtr->size; + for (p = start; p < end; p += Tcl_UtfToUniChar(p, &ch)) { + if (charCount == 0) { + dstPtr->byteIndex += (p - start); + return; + } + charCount--; + } + } else { + if (charCount < segPtr->size - byteOffset) { + dstPtr->byteIndex += charCount; + return; + } + charCount -= segPtr->size - byteOffset; + } + dstPtr->byteIndex += segPtr->size - byteOffset; + byteOffset = 0; + } + + /* + * Go to the next line. If we are at the end of the text item, + * back up one byte (for the terminal '\n' character) and return + * that index. + */ + + linePtr = TkBTreeNextLine(dstPtr->linePtr); + if (linePtr == NULL) { + dstPtr->byteIndex -= sizeof(char); + return; + } + dstPtr->linePtr = linePtr; + dstPtr->byteIndex = 0; + segPtr = dstPtr->linePtr->segPtr; + } +} + +/* + *--------------------------------------------------------------------------- + * + * TkTextIndexBackBytes -- + * + * Given an index for a text widget, this procedure creates a new + * index that points "count" bytes earlier than the source index. + * + * Results: + * *dstPtr is modified to refer to the character "count" bytes before + * srcPtr, or to the first character in the TkText if there aren't + * "count" bytes earlier than srcPtr. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- */ void -TkTextIndexBackChars(srcPtr, count, dstPtr) - TkTextIndex *srcPtr; /* Source index. */ - int count; /* How many characters backward to - * move. May be negative. */ - TkTextIndex *dstPtr; /* Destination index: gets modified. */ +TkTextIndexBackBytes(srcPtr, byteCount, dstPtr) + CONST TkTextIndex *srcPtr; /* Source index. */ + int byteCount; /* How many bytes backward to move. May be + * negative. */ + TkTextIndex *dstPtr; /* Destination index: gets modified. */ { TkTextSegment *segPtr; int lineIndex; - if (count < 0) { - TkTextIndexForwChars(srcPtr, -count, dstPtr); + if (byteCount < 0) { + TkTextIndexForwBytes(srcPtr, -byteCount, dstPtr); return; } *dstPtr = *srcPtr; - dstPtr->charIndex -= count; + dstPtr->byteIndex -= byteCount; lineIndex = -1; - while (dstPtr->charIndex < 0) { + while (dstPtr->byteIndex < 0) { /* * Move back one line in the text. If we run off the beginning * of the file then just return the first character in the text. @@ -702,7 +932,7 @@ TkTextIndexBackChars(srcPtr, count, dstPtr) lineIndex = TkBTreeLineIndex(dstPtr->linePtr); } if (lineIndex == 0) { - dstPtr->charIndex = 0; + dstPtr->byteIndex = 0; return; } lineIndex--; @@ -714,8 +944,124 @@ TkTextIndexBackChars(srcPtr, count, dstPtr) for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { - dstPtr->charIndex += segPtr->size; + dstPtr->byteIndex += segPtr->size; + } + } +} + +/* + *--------------------------------------------------------------------------- + * + * TkTextIndexBackChars -- + * + * Given an index for a text widget, this procedure creates a new + * index that points "count" characters earlier than the source index. + * + * Results: + * *dstPtr is modified to refer to the character "count" characters + * before srcPtr, or to the first character in the file if there + * aren't "count" characters earlier than srcPtr. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +void +TkTextIndexBackChars(srcPtr, charCount, dstPtr) + CONST TkTextIndex *srcPtr; /* Source index. */ + int charCount; /* How many characters backward to move. + * May be negative. */ + TkTextIndex *dstPtr; /* Destination index: gets modified. */ +{ + TkTextSegment *segPtr, *oldPtr; + int lineIndex, segSize; + char *p, *start, *end; + + if (charCount <= 0) { + TkTextIndexForwChars(srcPtr, -charCount, dstPtr); + return; + } + + *dstPtr = *srcPtr; + + /* + * Find offset within seg that contains byteIndex. + * Move backward specified number of chars. + */ + + lineIndex = -1; + + segSize = dstPtr->byteIndex; + for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) { + if (segSize <= segPtr->size) { + break; + } + segSize -= segPtr->size; + } + while (1) { + if (segPtr->typePtr == &tkTextCharType) { + start = segPtr->body.chars; + end = segPtr->body.chars + segSize; + for (p = end; ; p = Tcl_UtfPrev(p, start)) { + if (charCount == 0) { + dstPtr->byteIndex -= (end - p); + return; + } + if (p == start) { + break; + } + charCount--; + } + } else { + if (charCount <= segSize) { + dstPtr->byteIndex -= charCount; + return; + } + charCount -= segSize; + } + dstPtr->byteIndex -= segSize; + + /* + * Move back into previous segment. + */ + + oldPtr = segPtr; + segPtr = dstPtr->linePtr->segPtr; + if (segPtr != oldPtr) { + for ( ; segPtr->nextPtr != oldPtr; segPtr = segPtr->nextPtr) { + /* Empty body. */ + } + segSize = segPtr->size; + continue; + } + + /* + * Move back to previous line. + */ + + if (lineIndex < 0) { + lineIndex = TkBTreeLineIndex(dstPtr->linePtr); + } + if (lineIndex == 0) { + dstPtr->byteIndex = 0; + return; + } + lineIndex--; + dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex); + + /* + * Compute the length of the line and add that to dstPtr->byteIndex. + */ + + oldPtr = dstPtr->linePtr->segPtr; + for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { + dstPtr->byteIndex += segPtr->size; + oldPtr = segPtr; } + segPtr = oldPtr; + segSize = segPtr->size; } } @@ -762,15 +1108,15 @@ StartEnd(string, indexPtr) length = p-string; if ((*string == 'l') && (strncmp(string, "lineend", length) == 0) && (length >= 5)) { - indexPtr->charIndex = 0; + indexPtr->byteIndex = 0; for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { - indexPtr->charIndex += segPtr->size; + indexPtr->byteIndex += segPtr->size; } - indexPtr->charIndex -= 1; + indexPtr->byteIndex -= sizeof(char); } else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0) && (length >= 5)) { - indexPtr->charIndex = 0; + indexPtr->byteIndex = 0; } else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0) && (length >= 5)) { int firstChar = 1; @@ -791,7 +1137,7 @@ StartEnd(string, indexPtr) firstChar = 0; } offset += 1; - indexPtr->charIndex += 1; + indexPtr->byteIndex += sizeof(char); if (offset >= segPtr->size) { segPtr = TkTextIndexToSeg(indexPtr, &offset); } @@ -820,10 +1166,10 @@ StartEnd(string, indexPtr) firstChar = 0; } offset -= 1; - indexPtr->charIndex -= 1; + indexPtr->byteIndex -= sizeof(char); if (offset < 0) { - if (indexPtr->charIndex < 0) { - indexPtr->charIndex = 0; + if (indexPtr->byteIndex < 0) { + indexPtr->byteIndex = 0; goto done; } segPtr = TkTextIndexToSeg(indexPtr, &offset); diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 07094f1..209a33b 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextMark.c,v 1.2 1998/09/14 18:23:19 stanton Exp $ + * RCS: @(#) $Id: tkTextMark.c,v 1.3 1999/04/16 01:51:24 stanton Exp $ */ #include "tkInt.h" @@ -134,9 +134,9 @@ TkTextMarkCmd(textPtr, interp, argc, argv) markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); if (argc == 4) { if (markPtr->typePtr == &tkTextRightMarkType) { - interp->result = "right"; + Tcl_SetResult(interp, "right", TCL_STATIC); } else { - interp->result = "left"; + Tcl_SetResult(interp, "left", TCL_STATIC); } return TCL_OK; } @@ -319,10 +319,10 @@ TkTextMarkSegToIndex(textPtr, markPtr, indexPtr) indexPtr->tree = textPtr->tree; indexPtr->linePtr = markPtr->body.mark.linePtr; - indexPtr->charIndex = 0; + indexPtr->byteIndex = 0; for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr; segPtr = segPtr->nextPtr) { - indexPtr->charIndex += segPtr->size; + indexPtr->byteIndex += segPtr->size; } } @@ -468,7 +468,7 @@ MarkLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars, chunkPtr->undisplayProc = InsertUndisplayProc; chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL; chunkPtr->bboxProc = (Tk_ChunkBboxProc *) NULL; - chunkPtr->numChars = 0; + chunkPtr->numBytes = 0; chunkPtr->minAscent = 0; chunkPtr->minDescent = 0; chunkPtr->minHeight = 0; @@ -669,7 +669,7 @@ MarkFindNext(interp, textPtr, string) return TCL_ERROR; } for (offset = 0, segPtr = index.linePtr->segPtr; - segPtr != NULL && offset < index.charIndex; + segPtr != NULL && offset < index.byteIndex; offset += segPtr->size, segPtr = segPtr->nextPtr) { /* Empty loop body */ ; } @@ -692,7 +692,7 @@ MarkFindNext(interp, textPtr, string) if (index.linePtr == (TkTextLine *) NULL) { return TCL_OK; } - index.charIndex = 0; + index.byteIndex = 0; segPtr = index.linePtr->segPtr; } } @@ -742,7 +742,7 @@ MarkFindPrev(interp, textPtr, string) return TCL_ERROR; } for (offset = 0, segPtr = index.linePtr->segPtr; - segPtr != NULL && offset < index.charIndex; + segPtr != NULL && offset < index.byteIndex; offset += segPtr->size, segPtr = segPtr->nextPtr) { /* Empty loop body */ ; } diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index c3e1c5d..9827f92 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -6,12 +6,12 @@ * related to tags. * * Copyright (c) 1992-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextTag.c,v 1.2 1998/09/14 18:23:19 stanton Exp $ + * RCS: @(#) $Id: tkTextTag.c,v 1.3 1999/04/16 01:51:24 stanton Exp $ */ #include "default.h" @@ -235,9 +235,22 @@ TkTextTagCmd(textPtr, interp, argc, argv) command = Tk_GetBinding(interp, textPtr->bindingTable, (ClientData) tagPtr, argv[4]); if (command == NULL) { - return TCL_ERROR; + char *string = Tcl_GetStringResult(interp); + + /* + * Ignore missing binding errors. This is a special hack + * that relies on the error message returned by FindSequence + * in tkBind.c. + */ + + if (string[0] != '\0') { + return TCL_ERROR; + } else { + Tcl_ResetResult(interp); + } + } else { + Tcl_SetResult(interp, command, TCL_STATIC); } - interp->result = command; } else { Tk_GetAllBindings(interp, textPtr->bindingTable, (ClientData) tagPtr); @@ -379,9 +392,9 @@ TkTextTagCmd(textPtr, interp, argc, argv) } } if ((tagPtr->wrapMode != NULL) - && (tagPtr->wrapMode != tkTextCharUid) - && (tagPtr->wrapMode != tkTextNoneUid) - && (tagPtr->wrapMode != tkTextWordUid)) { + && (tagPtr->wrapMode != Tk_GetUid("char")) + && (tagPtr->wrapMode != Tk_GetUid("none")) + && (tagPtr->wrapMode != Tk_GetUid("word"))) { Tcl_AppendResult(interp, "bad wrap mode \"", tagPtr->wrapMode, "\": must be char, none, or word", (char *) NULL); tagPtr->wrapMode = NULL; @@ -448,10 +461,10 @@ TkTextTagCmd(textPtr, interp, argc, argv) TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL, tagPtr, 1); } - TkBTreeTag(TkTextMakeIndex(textPtr->tree, 0, 0, &first), - TkTextMakeIndex(textPtr->tree, - TkBTreeNumLines(textPtr->tree), 0, &last), - tagPtr, 0); + TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + 0, &last), + TkBTreeTag(&first, &last, tagPtr, 0); Tcl_DeleteHashEntry(hPtr); if (textPtr->bindingTable != NULL) { Tk_DeleteAllBindings(textPtr->bindingTable, @@ -552,7 +565,7 @@ TkTextTagCmd(textPtr, interp, argc, argv) if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) { return TCL_ERROR; } - TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &last); if (argc == 5) { index2 = last; @@ -582,7 +595,7 @@ TkTextTagCmd(textPtr, interp, argc, argv) * skip to the end of this tagged range. */ - for (segPtr = index1.linePtr->segPtr, offset = index1.charIndex; + for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex; offset >= 0; offset -= segPtr->size, segPtr = segPtr->nextPtr) { if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType) @@ -631,7 +644,7 @@ TkTextTagCmd(textPtr, interp, argc, argv) return TCL_ERROR; } if (argc == 5) { - TkTextMakeIndex(textPtr->tree, 0, 0, &index2); + TkTextMakeByteIndex(textPtr->tree, 0, 0, &index2); } else if (TkTextGetIndex(interp, textPtr, argv[5], &index2) != TCL_OK) { return TCL_ERROR; @@ -651,7 +664,7 @@ TkTextTagCmd(textPtr, interp, argc, argv) } if (tSearch.segPtr->typePtr == &tkTextToggleOnType) { TkTextPrintIndex(&tSearch.curIndex, position1); - TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &last); TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch); TkBTreeNextTag(&tSearch); @@ -711,8 +724,8 @@ TkTextTagCmd(textPtr, interp, argc, argv) if (tagPtr == NULL) { return TCL_OK; } - TkTextMakeIndex(textPtr->tree, 0, 0, &first); - TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &last); TkBTreeStartSearch(&first, &last, tagPtr, &tSearch); if (TkBTreeCharTagged(&first, tagPtr)) { @@ -828,7 +841,7 @@ TkTextCreateTag(textPtr, tagName) * Results: * If tagName is defined in textPtr, a pointer to its TkTextTag * structure is returned. Otherwise NULL is returned and an - * error message is recorded in interp->result unless interp + * error message is recorded in the interp's result unless interp * is NULL. * * Side effects: diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index a799da4..ef28b44 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -6,12 +6,12 @@ * widget command for texts. * * Copyright (c) 1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextWind.c,v 1.2 1998/09/14 18:23:19 stanton Exp $ + * RCS: @(#) $Id: tkTextWind.c,v 1.3 1999/04/16 01:51:24 stanton Exp $ */ #include "tk.h" @@ -244,7 +244,7 @@ TkTextWindowCmd(textPtr, interp, argc, argv) lineIndex = TkBTreeLineIndex(index.linePtr); if (lineIndex == TkBTreeNumLines(textPtr->tree)) { lineIndex--; - TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index); + TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index); } /* @@ -311,7 +311,7 @@ TkTextWindowCmd(textPtr, interp, argc, argv) * * Results: * The return value is a standard Tcl result. If TCL_ERROR is - * returned, then interp->result contains an error message.. + * returned, then the interp's result contains an error message.. * * Side effects: * Configuration information for the embedded window changes, @@ -541,7 +541,7 @@ EmbWinStructureProc(clientData, eventPtr) ewPtr->body.ew.tkwin = NULL; index.tree = ewPtr->body.ew.textPtr->tree; index.linePtr = ewPtr->body.ew.linePtr; - index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr); + index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr); TkTextChanged(ewPtr->body.ew.textPtr, &index, &index); } @@ -575,7 +575,7 @@ EmbWinRequestProc(clientData, tkwin) index.tree = ewPtr->body.ew.textPtr->tree; index.linePtr = ewPtr->body.ew.linePtr; - index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr); + index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr); TkTextChanged(ewPtr->body.ew.textPtr, &index, &index); } @@ -620,7 +620,7 @@ EmbWinLostSlaveProc(clientData, tkwin) ewPtr->body.ew.tkwin = NULL; index.tree = ewPtr->body.ew.textPtr->tree; index.linePtr = ewPtr->body.ew.linePtr; - index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr); + index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr); TkTextChanged(ewPtr->body.ew.textPtr, &index, &index); } @@ -778,7 +778,7 @@ EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars, goto gotWindow; } Tcl_DStringInit(&name); - Tcl_DStringAppend(&name, textPtr->interp->result, -1); + Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1); Tcl_ResetResult(textPtr->interp); ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp, Tcl_DStringValue(&name), textPtr->tkwin); @@ -835,7 +835,7 @@ EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars, height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY; } if ((width > (maxX - chunkPtr->x)) - && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) { + && !noCharsYet && (textPtr->wrapMode != Tk_GetUid("none"))) { return 0; } @@ -847,7 +847,7 @@ EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars, chunkPtr->undisplayProc = EmbWinUndisplayProc; chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL; chunkPtr->bboxProc = EmbWinBboxProc; - chunkPtr->numChars = 1; + chunkPtr->numBytes = 1; if (ewPtr->body.ew.align == ALIGN_BASELINE) { chunkPtr->minAscent = height - ewPtr->body.ew.padY; chunkPtr->minDescent = ewPtr->body.ew.padY; @@ -1171,6 +1171,6 @@ TkTextWindowIndex(textPtr, name, indexPtr) ewPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->tree; indexPtr->linePtr = ewPtr->body.ew.linePtr; - indexPtr->charIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr); + indexPtr->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr); return 1; } diff --git a/generic/tkTrig.c b/generic/tkTrig.c index 920bcc0..d0afe90 100644 --- a/generic/tkTrig.c +++ b/generic/tkTrig.c @@ -7,12 +7,12 @@ * used by canvases. * * Copyright (c) 1992-1994 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTrig.c,v 1.2 1998/09/14 18:23:20 stanton Exp $ + * RCS: @(#) $Id: tkTrig.c,v 1.3 1999/04/16 01:51:24 stanton Exp $ */ #include <stdio.h> @@ -1195,7 +1195,7 @@ TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints) * * Results: * None. Postscript commands to generate the path are appended - * to interp->result. + * to the interp's result. * * Side effects: * None. diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 547fd16..3124f68 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -6,16 +6,30 @@ * a focus highlight. * * Copyright (c) 1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUtil.c,v 1.2 1998/09/14 18:23:20 stanton Exp $ + * RCS: @(#) $Id: tkUtil.c,v 1.3 1999/04/16 01:51:24 stanton Exp $ */ #include "tkInt.h" #include "tkPort.h" + +/* + * The structure below defines the implementation of the "statekey" + * Tcl object, used for quickly finding a mapping in a TkStateMap. + */ + +static Tcl_ObjType stateKeyType = { + "statekey", /* name */ + (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ + (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ + (Tcl_UpdateStringProc *) NULL, /* updateStringProc */ + (Tcl_SetFromAnyProc *) NULL /* setFromAnyProc */ +}; + /* *---------------------------------------------------------------------- @@ -132,7 +146,7 @@ Tk_DrawFocusHighlight(tkwin, gc, width, drawable) * took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the * desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS, * *intPtr is filled in with the number of lines to move (may be - * negative); if TK_SCROLL_ERROR, interp->result contains an + * negative); if TK_SCROLL_ERROR, the interp's result contains an * error message. * * Side effects: @@ -197,6 +211,85 @@ Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr) } /* + *---------------------------------------------------------------------- + * + * Tk_GetScrollInfoObj -- + * + * This procedure is invoked to parse "xview" and "yview" + * scrolling commands for widgets using the new scrolling + * command syntax ("moveto" or "scroll" options). + * + * Results: + * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES, + * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether + * the command was successfully parsed and what form the command + * took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the + * desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS, + * *intPtr is filled in with the number of lines to move (may be + * negative); if TK_SCROLL_ERROR, the interp's result contains an + * error message. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetScrollInfoObj(interp, objc, objv, dblPtr, intPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + int objc; /* # 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 to scroll, if any. */ +{ + int c; + size_t length; + char *arg2, *arg4; + + arg2 = Tcl_GetString(objv[2]); + length = strlen(arg2); + c = arg2[0]; + if ((c == 'm') && (strncmp(arg2, "moveto", length) == 0)) { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction"); + return TK_SCROLL_ERROR; + } + if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) { + return TK_SCROLL_ERROR; + } + return TK_SCROLL_MOVETO; + } else if ((c == 's') + && (strncmp(arg2, "scroll", length) == 0)) { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages"); + return TK_SCROLL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) { + return TK_SCROLL_ERROR; + } + arg4 = Tcl_GetString(objv[4]); + length = (strlen(arg4)); + c = arg4[0]; + if ((c == 'p') && (strncmp(arg4, "pages", length) == 0)) { + return TK_SCROLL_PAGES; + } else if ((c == 'u') + && (strncmp(arg4, "units", length) == 0)) { + return TK_SCROLL_UNITS; + } else { + Tcl_AppendResult(interp, "bad argument \"", arg4, + "\": must be units or pages", (char *) NULL); + return TK_SCROLL_ERROR; + } + } + Tcl_AppendResult(interp, "unknown option \"", arg2, + "\": must be moveto or scroll", (char *) NULL); + return TK_SCROLL_ERROR; +} + +/* *--------------------------------------------------------------------------- * * TkComputeAnchor -- @@ -310,7 +403,7 @@ TkFindStateString(mapPtr, numKey) * Returns the numKey associated with the last element (the NULL * string one) in the table if strKey was not equal to any of the * string keys in the table. In that case, an error message is - * also left in interp->result (if interp is not NULL). + * also left in the interp's result (if interp is not NULL). * * Side effects. * None. @@ -319,29 +412,70 @@ TkFindStateString(mapPtr, numKey) */ int -TkFindStateNum(interp, field, mapPtr, strKey) +TkFindStateNum(interp, option, mapPtr, strKey) Tcl_Interp *interp; /* Interp for error reporting. */ - CONST char *field; /* String to use when constructing error. */ + CONST char *option; /* String to use when constructing error. */ CONST TkStateMap *mapPtr; /* Lookup table. */ CONST char *strKey; /* String to try to find in lookup table. */ { CONST TkStateMap *mPtr; - if (mapPtr->strKey == NULL) { - panic("TkFindStateNum: no choices in lookup table"); + for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) { + if (strcmp(strKey, mPtr->strKey) == 0) { + return mPtr->numKey; + } + } + if (interp != NULL) { + mPtr = mapPtr; + Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, + "\": must be ", mPtr->strKey, (char *) NULL); + for (mPtr++; mPtr->strKey != NULL; mPtr++) { + Tcl_AppendResult(interp, + ((mPtr[1].strKey != NULL) ? ", " : ", or "), + mPtr->strKey, (char *) NULL); + } + } + return mPtr->numKey; +} + +int +TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr) + Tcl_Interp *interp; /* Interp for error reporting. */ + Tcl_Obj *optionPtr; /* String to use when constructing error. */ + CONST TkStateMap *mapPtr; /* Lookup table. */ + Tcl_Obj *keyPtr; /* String key to find in lookup table. */ +{ + CONST TkStateMap *mPtr; + CONST char *key; + CONST Tcl_ObjType *typePtr; + + if ((keyPtr->typePtr == &stateKeyType) + && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) { + return (int) keyPtr->internalRep.twoPtrValue.ptr2; } + key = Tcl_GetStringFromObj(keyPtr, NULL); for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) { - if (strcmp(strKey, mPtr->strKey) == 0) { + if (strcmp(key, mPtr->strKey) == 0) { + typePtr = keyPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(keyPtr); + } + keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr; + keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey; + keyPtr->typePtr = &stateKeyType; return mPtr->numKey; } } if (interp != NULL) { mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", field, " value \"", strKey, + Tcl_AppendResult(interp, "bad ", + Tcl_GetStringFromObj(optionPtr, NULL), " value \"", key, "\": must be ", mPtr->strKey, (char *) NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { - Tcl_AppendResult(interp, ", ", mPtr->strKey, (char *) NULL); + Tcl_AppendResult(interp, + ((mPtr[1].strKey != NULL) ? ", " : ", or "), + mPtr->strKey, (char *) NULL); } } return mPtr->numKey; diff --git a/generic/tkVisual.c b/generic/tkVisual.c index 96a2979..39b627a 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -6,12 +6,12 @@ * prototype implementation by Paul Mackerras. * * Copyright (c) 1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkVisual.c,v 1.2 1998/09/14 18:23:20 stanton Exp $ + * RCS: @(#) $Id: tkVisual.c,v 1.3 1999/04/16 01:51:25 stanton Exp $ */ #include "tkInt.h" @@ -74,7 +74,7 @@ struct TkColormap { * Results: * The return value is normally a pointer to a visual. If an * error occurred in looking up the visual, NULL is returned and - * an error message is left in interp->result. The depth of the + * an error message is left in the interp's result. The depth of the * visual is returned to *depthPtr under normal returns. If * colormapPtr is non-NULL, then this procedure also finds a * suitable colormap for use with the visual in tkwin, and it @@ -243,7 +243,8 @@ Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr) visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template, &numVisuals); if (visInfoList == NULL) { - interp->result = "couldn't find an appropriate visual"; + Tcl_SetResult(interp, "couldn't find an appropriate visual", + TCL_STATIC); return NULL; } @@ -352,7 +353,7 @@ Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr) * Results: * The return value is normally the X resource identifier for the * colormap. If an error occurs, None is returned and an error - * message is placed in interp->result. + * message is placed in the interp's result. * * Side effects: * A reference count is incremented for the colormap, so diff --git a/generic/tkWindow.c b/generic/tkWindow.c index d904658..ad2e4e1 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWindow.c,v 1.5 1999/03/10 07:04:44 stanton Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.6 1999/04/16 01:51:25 stanton Exp $ */ #include "tkPort.h" @@ -22,38 +22,26 @@ #include "tkUnixInt.h" #endif -/* - * Count of number of main windows currently open in this process. - */ - -static int numMainWindows; - -/* - * First in list of all main windows managed by this process. - */ - -TkMainInfo *tkMainWindowList = NULL; - -/* - * List of all displays currently in use. - */ - -TkDisplay *tkDisplayList = NULL; - -/* - * Have statics in this module been initialized? - */ -static int initialized = 0; +typedef struct ThreadSpecificData { + int numMainWindows; /* Count of numver of main windows currently + * open in this thread. */ + TkMainInfo *mainWindowList; + /* First in list of all main windows managed + * by this thread. */ + TkDisplay *displayList; + /* List of all displays currently in use by + * the current thread. */ + int initialized; /* 0 means the structures above need + * initializing. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; -/* - * The variables below hold several uid's that are used in many places - * in the toolkit. +/* + * The Mutex below is used to lock access to the Tk_Uids above. */ -Tk_Uid tkDisabledUid = NULL; -Tk_Uid tkActiveUid = NULL; -Tk_Uid tkNormalUid = NULL; +TCL_DECLARE_MUTEX(windowMutex) /* * Default values for "changes" and "atts" fields of TkWindows. Note @@ -98,6 +86,10 @@ typedef struct { int isSafe; /* If !0, this command will be exposed in * a safe interpreter. Otherwise it will be * hidden in a safe interpreter. */ + int passMainWindow; /* 0 means provide NULL clientData to + * command procedure; 1 means pass main + * window as clientData to command + * procedure. */ } TkCmd; static TkCmd commands[] = { @@ -105,62 +97,67 @@ static TkCmd commands[] = { * Commands that are part of the intrinsics: */ - {"bell", NULL, Tk_BellObjCmd, 0}, - {"bind", Tk_BindCmd, NULL, 1}, - {"bindtags", Tk_BindtagsCmd, NULL, 1}, - {"clipboard", Tk_ClipboardCmd, NULL, 0}, - {"destroy", Tk_DestroyCmd, NULL, 1}, - {"event", Tk_EventCmd, NULL, 1}, - {"focus", Tk_FocusCmd, NULL, 1}, - {"font", NULL, Tk_FontObjCmd, 1}, - {"grab", Tk_GrabCmd, NULL, 0}, - {"grid", Tk_GridCmd, NULL, 1}, - {"image", Tk_ImageCmd, NULL, 1}, - {"lower", Tk_LowerCmd, NULL, 1}, - {"option", Tk_OptionCmd, NULL, 1}, - {"pack", Tk_PackCmd, NULL, 1}, - {"place", Tk_PlaceCmd, NULL, 1}, - {"raise", Tk_RaiseCmd, NULL, 1}, - {"selection", Tk_SelectionCmd, NULL, 0}, - {"tk", NULL, Tk_TkObjCmd, 0}, - {"tkwait", Tk_TkwaitCmd, NULL, 1}, - {"tk_chooseColor", Tk_ChooseColorCmd, NULL, 0}, - {"tk_getOpenFile", Tk_GetOpenFileCmd, NULL, 0}, - {"tk_getSaveFile", Tk_GetSaveFileCmd, NULL, 0}, - {"tk_messageBox", Tk_MessageBoxCmd, NULL, 0}, - {"update", Tk_UpdateCmd, NULL, 1}, - {"winfo", NULL, Tk_WinfoObjCmd, 1}, - {"wm", Tk_WmCmd, NULL, 0}, + {"bell", NULL, Tk_BellObjCmd, 0, 1}, + {"bind", Tk_BindCmd, NULL, 1, 1}, + {"bindtags", Tk_BindtagsCmd, NULL, 1, 1}, + {"clipboard", Tk_ClipboardCmd, NULL, 0, 1}, + {"destroy", Tk_DestroyCmd, NULL, 1, 1}, + {"event", NULL, Tk_EventObjCmd, 1, 1}, + {"focus", NULL, Tk_FocusObjCmd, 1, 1}, + {"font", NULL, Tk_FontObjCmd, 1, 1}, + {"grab", Tk_GrabCmd, NULL, 0, 1}, + {"grid", Tk_GridCmd, NULL, 1, 1}, + {"image", Tk_ImageCmd, NULL, 1, 1}, + {"lower", Tk_LowerCmd, NULL, 1, 1}, + {"option", Tk_OptionCmd, NULL, 1, 1}, + {"pack", Tk_PackCmd, NULL, 1, 1}, + {"place", Tk_PlaceCmd, NULL, 1, 1}, + {"raise", Tk_RaiseCmd, NULL, 1, 1}, + {"selection", Tk_SelectionCmd, NULL, 0, 1}, + {"tk", NULL, Tk_TkObjCmd, 0, 1}, + {"tkwait", Tk_TkwaitCmd, NULL, 1, 1}, +#if defined(__WIN32__) || defined(MAC_TCL) + {"tk_chooseColor", NULL, Tk_ChooseColorObjCmd, 0, 1}, + {"tk_chooseDirectory", NULL, Tk_ChooseDirectoryObjCmd, 0, 1}, + {"tk_getOpenFile", NULL, Tk_GetOpenFileObjCmd, 0, 1}, + {"tk_getSaveFile", NULL, Tk_GetSaveFileObjCmd, 0, 1}, +#endif +#ifdef __WIN32__ + {"tk_messageBox", NULL, Tk_MessageBoxObjCmd, 0, 1}, +#endif + {"update", NULL, Tk_UpdateObjCmd, 1, 1}, + {"winfo", NULL, Tk_WinfoObjCmd, 1, 1}, + {"wm", Tk_WmCmd, NULL, 0, 1}, /* * Widget class commands. */ - {"button", Tk_ButtonCmd, NULL, 1}, - {"canvas", Tk_CanvasCmd, NULL, 1}, - {"checkbutton", Tk_CheckbuttonCmd, NULL, 1}, - {"entry", Tk_EntryCmd, NULL, 1}, - {"frame", Tk_FrameCmd, NULL, 1}, - {"label", Tk_LabelCmd, NULL, 1}, - {"listbox", Tk_ListboxCmd, NULL, 1}, - {"menu", Tk_MenuCmd, NULL, 0}, - {"menubutton", Tk_MenubuttonCmd, NULL, 1}, - {"message", Tk_MessageCmd, NULL, 1}, - {"radiobutton", Tk_RadiobuttonCmd, NULL, 1}, - {"scale", Tk_ScaleCmd, NULL, 1}, - {"scrollbar", Tk_ScrollbarCmd, NULL, 1}, - {"text", Tk_TextCmd, NULL, 1}, - {"toplevel", Tk_ToplevelCmd, NULL, 0}, + + {"button", NULL, Tk_ButtonObjCmd, 1, 0}, + {"canvas", Tk_CanvasCmd, NULL, 1, 1}, + {"checkbutton", NULL, Tk_CheckbuttonObjCmd, 1, 0}, + {"entry", NULL, Tk_EntryObjCmd, 1, 0}, + {"frame", Tk_FrameCmd, NULL, 1, 1}, + {"label", NULL, Tk_LabelObjCmd, 1, 0}, + {"listbox", Tk_ListboxCmd, NULL, 1, 1}, + {"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0}, + {"message", Tk_MessageCmd, NULL, 1, 1}, + {"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0}, + {"scale", NULL, Tk_ScaleObjCmd, 1, 0}, + {"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1}, + {"text", Tk_TextCmd, NULL, 1, 1}, + {"toplevel", Tk_ToplevelCmd, NULL, 0, 1}, /* * Misc. */ #ifdef MAC_TCL - {"unsupported1", TkUnsupported1Cmd, NULL, 1}, + {"unsupported1", TkUnsupported1Cmd, NULL, 1, 1}, #endif {(char *) NULL, (int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **))) NULL, NULL, 0} }; - + /* * The variables and table below are used to parse arguments from * the "argv" variable in Tk_Init. @@ -225,7 +222,7 @@ static void UnlinkWindow _ANSI_ARGS_((TkWindow *winPtr)); * The return value is a token for the new window, or NULL if * an error prevented the new window from being created. If * NULL is returned, an error message will be left in - * interp->result. + * the interp's result. * * Side effects: * A new window structure is allocated locally. An X @@ -253,12 +250,11 @@ CreateTopLevelWindow(interp, parent, name, screenName) register TkWindow *winPtr; register TkDisplay *dispPtr; int screenId; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (!initialized) { - initialized = 1; - tkActiveUid = Tk_GetUid("active"); - tkDisabledUid = Tk_GetUid("disabled"); - tkNormalUid = Tk_GetUid("normal"); + if (!tsdPtr->initialized) { + tsdPtr->initialized = 1; /* * Create built-in image types. @@ -335,7 +331,7 @@ CreateTopLevelWindow(interp, parent, name, screenName) * Results: * The return value is a pointer to information about the display, * or NULL if the display couldn't be opened. In this case, an - * error message is left in interp->result. The location at + * error message is left in the interp's result. The location at * *screenPtr is overwritten with the screen number parsed from * screenName. * @@ -358,6 +354,8 @@ GetScreen(interp, screenName, screenPtr) char *p; int screenId; size_t length; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Separate the screen number from the rest of the display @@ -368,8 +366,9 @@ GetScreen(interp, screenName, screenPtr) screenName = TkGetDefaultScreenName(interp, screenName); if (screenName == NULL) { - interp->result = - "no display name and no $DISPLAY environment variable"; + Tcl_SetResult(interp, + "no display name and no $DISPLAY environment variable", + TCL_STATIC); return (TkDisplay *) NULL; } length = strlen(screenName); @@ -388,7 +387,7 @@ GetScreen(interp, screenName, screenPtr) * then open a new connection. */ - for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) { + for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) { if (dispPtr == NULL) { dispPtr = TkpOpenDisplay(screenName); if (dispPtr == NULL) { @@ -396,29 +395,35 @@ GetScreen(interp, screenName, screenPtr) screenName, "\"", (char *) NULL); return (TkDisplay *) NULL; } - dispPtr->nextPtr = tkDisplayList; + dispPtr->nextPtr = TkGetDisplayList(); dispPtr->name = (char *) ckalloc((unsigned) (length+1)); dispPtr->lastEventTime = CurrentTime; - strncpy(dispPtr->name, screenName, length); - dispPtr->name[length] = '\0'; + dispPtr->borderInit = 0; + dispPtr->atomInit = 0; dispPtr->bindInfoStale = 1; dispPtr->modeModMask = 0; dispPtr->metaModMask = 0; dispPtr->altModMask = 0; dispPtr->numModKeyCodes = 0; dispPtr->modKeyCodes = NULL; - OpenIM(dispPtr); + dispPtr->bitmapInit = 0; + dispPtr->bitmapAutoNumber = 0; + dispPtr->numIdSearches = 0; + dispPtr->numSlowSearches = 0; + dispPtr->colorInit = 0; + dispPtr->stressPtr = NULL; + dispPtr->cursorInit = 0; + dispPtr->cursorString[0] = '\0'; + dispPtr->cursorFont = None; dispPtr->errorPtr = NULL; dispPtr->deleteCount = 0; - dispPtr->commTkwin = NULL; - dispPtr->selectionInfoPtr = NULL; - dispPtr->multipleAtom = None; - dispPtr->clipWindow = NULL; - dispPtr->clipboardActive = 0; - dispPtr->clipboardAppPtr = NULL; - dispPtr->clipTargetPtr = NULL; - dispPtr->atomInit = 0; - dispPtr->cursorFont = None; + dispPtr->delayedMotionPtr = NULL; + dispPtr->focusDebug = 0; + dispPtr->implicitWinPtr = NULL; + dispPtr->focusPtr = NULL; + dispPtr->gcInit = 0; + dispPtr->geomInit = 0; + dispPtr->uidInit = 0; dispPtr->grabWinPtr = NULL; dispPtr->eventualGrabWinPtr = NULL; dispPtr->buttonWinPtr = NULL; @@ -426,18 +431,32 @@ GetScreen(interp, screenName, screenPtr) dispPtr->firstGrabEventPtr = NULL; dispPtr->lastGrabEventPtr = NULL; dispPtr->grabFlags = 0; - TkInitXId(dispPtr); + dispPtr->gridInit = 0; + dispPtr->imageId = 0; + dispPtr->packInit = 0; + dispPtr->placeInit = 0; + dispPtr->selectionInfoPtr = NULL; + dispPtr->multipleAtom = None; + dispPtr->clipWindow = NULL; + dispPtr->clipboardActive = 0; + dispPtr->clipboardAppPtr = NULL; + dispPtr->clipTargetPtr = NULL; + dispPtr->commTkwin = NULL; + dispPtr->wmTracing = 0; + dispPtr->firstWmPtr = NULL; + dispPtr->foregroundWmPtr = NULL; dispPtr->destroyCount = 0; dispPtr->lastDestroyRequest = 0; dispPtr->cmapPtr = NULL; - dispPtr->implicitWinPtr = NULL; - dispPtr->focusPtr = NULL; - dispPtr->stressPtr = NULL; - dispPtr->delayedMotionPtr = NULL; Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS); + dispPtr->refCount = 0; - - tkDisplayList = dispPtr; + strncpy(dispPtr->name, screenName, length); + dispPtr->name[length] = '\0'; + OpenIM(dispPtr); + TkInitXId(dispPtr); + + tsdPtr->displayList = dispPtr; break; } if ((strncmp(dispPtr->name, screenName, length) == 0) @@ -446,7 +465,10 @@ GetScreen(interp, screenName, screenPtr) } } if (screenId >= ScreenCount(dispPtr->display)) { - sprintf(interp->result, "bad screen number \"%d\"", screenId); + char buf[32 + TCL_INTEGER_SPACE]; + + sprintf(buf, "bad screen number \"%d\"", screenId); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return (TkDisplay *) NULL; } *screenPtr = screenId; @@ -476,8 +498,10 @@ TkGetDisplay(display) Display *display; /* X's display pointer */ { TkDisplay *dispPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - for (dispPtr = tkDisplayList; dispPtr != NULL; + for (dispPtr = tsdPtr->displayList; dispPtr != NULL; dispPtr = dispPtr->nextPtr) { if (dispPtr->display == display) { break; @@ -489,6 +513,58 @@ TkGetDisplay(display) /* *-------------------------------------------------------------- * + * TkGetDisplayList -- + * + * This procedure returns a pointer to the thread-local + * list of TkDisplays corresponding to the open displays. + * + * Results: + * The return value is a pointer to the first TkDisplay + * structure in thread-local-storage. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ +TkDisplay * +TkGetDisplayList() +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->displayList; +} + +/* + *-------------------------------------------------------------- + * + * TkGetMainInfoList -- + * + * This procedure returns a pointer to the list of structures + * containing information about all main windows for the + * current thread. + * + * Results: + * The return value is a pointer to the first TkMainInfo + * structure in thread local storage. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ +TkMainInfo * +TkGetMainInfoList() +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->mainWindowList; +} +/* + *-------------------------------------------------------------- + * * TkAllocWindow -- * * This procedure creates and initializes a TkWindow structure. @@ -679,7 +755,7 @@ NameWindow(interp, winPtr, parentPtr, name) * The return value is a token for the new window, or NULL if * an error prevented the new window from being created. If * NULL is returned, an error message will be left in - * interp->result. + * the interp's result. * * Side effects: * A new window structure is allocated locally; "interp" is @@ -707,6 +783,9 @@ TkCreateMainWindow(interp, screenName, baseName) register TkMainInfo *mainPtr; register TkWindow *winPtr; register TkCmd *cmdPtr; + ClientData clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Panic if someone updated the TkWindow structure without @@ -738,6 +817,7 @@ TkCreateMainWindow(interp, screenName, baseName) mainPtr->refCount = 1; mainPtr->interp = interp; Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS); + TkEventInit(); TkBindInit(mainPtr); TkFontPkgInit(mainPtr); mainPtr->tlFocusPtr = NULL; @@ -749,8 +829,8 @@ TkCreateMainWindow(interp, screenName, baseName) TCL_LINK_BOOLEAN) != TCL_OK) { Tcl_ResetResult(interp); } - mainPtr->nextPtr = tkMainWindowList; - tkMainWindowList = mainPtr; + mainPtr->nextPtr = tsdPtr->mainWindowList; + tsdPtr->mainWindowList = mainPtr; winPtr->mainPtr = mainPtr; hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy); Tcl_SetHashValue(hPtr, winPtr); @@ -778,12 +858,17 @@ TkCreateMainWindow(interp, screenName, baseName) if ((cmdPtr->cmdProc == NULL) && (cmdPtr->objProc == NULL)) { panic("TkCreateMainWindow: builtin command with NULL string and object procs"); } + if (cmdPtr->passMainWindow) { + clientData = (ClientData) tkwin; + } else { + clientData = (ClientData) NULL; + } if (cmdPtr->cmdProc != NULL) { Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc, - (ClientData) tkwin, (void (*) _ANSI_ARGS_((ClientData))) NULL); + clientData, (void (*) _ANSI_ARGS_((ClientData))) NULL); } else { Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc, - (ClientData) tkwin, NULL); + clientData, NULL); } if (isSafe) { if (!(cmdPtr->isSafe)) { @@ -792,6 +877,8 @@ TkCreateMainWindow(interp, screenName, baseName) } } + TkCreateMenuCmd(interp); + /* * Set variables for the intepreter. */ @@ -799,7 +886,7 @@ TkCreateMainWindow(interp, screenName, baseName) Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY); - numMainWindows++; + tsdPtr->numMainWindows++; return tkwin; } @@ -815,7 +902,7 @@ TkCreateMainWindow(interp, screenName, baseName) * The return value is a token for the new window. This * is not the same as X's token for the window. If an error * occurred in creating the window (e.g. no such display or - * screen), then an error message is left in interp->result and + * screen), then an error message is left in the interp's result and * NULL is returned. * * Side effects: @@ -829,7 +916,7 @@ TkCreateMainWindow(interp, screenName, baseName) Tk_Window Tk_CreateWindow(interp, parent, name, screenName) Tcl_Interp *interp; /* Interpreter to use for error reporting. - * Interp->result is assumed to be + * the interp's result is assumed to be * initialized by the caller. */ Tk_Window parent; /* Token for parent of new window. */ char *name; /* Name for new window. Must be unique @@ -882,7 +969,7 @@ Tk_CreateWindow(interp, parent, name, screenName) * The return value is a token for the new window. This * is not the same as X's token for the window. If an error * occurred in creating the window (e.g. no such display or - * screen), then an error message is left in interp->result and + * screen), then an error message is left in the interp's result and * NULL is returned. * * Side effects: @@ -896,7 +983,7 @@ Tk_CreateWindow(interp, parent, name, screenName) Tk_Window Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName) Tcl_Interp *interp; /* Interpreter to use for error reporting. - * Interp->result is assumed to be + * the interp's result is assumed to be * initialized by the caller. */ Tk_Window tkwin; /* Token for any window in application * that is to contain new window. */ @@ -1015,6 +1102,8 @@ Tk_DestroyWindow(tkwin) TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; XEvent event; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->flags & TK_ALREADY_DEAD) { /* @@ -1058,19 +1147,19 @@ Tk_DestroyWindow(tkwin) if (winPtr->mainPtr->winPtr == winPtr) { dispPtr->refCount--; - if (tkMainWindowList == winPtr->mainPtr) { - tkMainWindowList = winPtr->mainPtr->nextPtr; + if (tsdPtr->mainWindowList == winPtr->mainPtr) { + tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr; } else { TkMainInfo *prevPtr; - for (prevPtr = tkMainWindowList; + for (prevPtr = tsdPtr->mainWindowList; prevPtr->nextPtr != winPtr->mainPtr; prevPtr = prevPtr->nextPtr) { /* Empty loop body. */ } prevPtr->nextPtr = winPtr->mainPtr->nextPtr; } - numMainWindows--; + tsdPtr->numMainWindows--; } /* @@ -1226,8 +1315,8 @@ Tk_DestroyWindow(tkwin) Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable); TkBindFree(winPtr->mainPtr); - TkFontPkgFree(winPtr->mainPtr); TkDeleteAllImages(winPtr->mainPtr); + TkFontPkgFree(winPtr->mainPtr); /* * When embedding Tk into other applications, make sure @@ -1261,7 +1350,7 @@ Tk_DestroyWindow(tkwin) * Splice this display out of the list of displays. */ - for (theDispPtr = tkDisplayList, backDispPtr = NULL; + for (theDispPtr = displayList, backDispPtr = NULL; (theDispPtr != winPtr->dispPtr) && (theDispPtr != NULL); theDispPtr = theDispPtr->nextPtr) { @@ -1271,7 +1360,7 @@ Tk_DestroyWindow(tkwin) panic("could not find display to close!"); } if (backDispPtr == NULL) { - tkDisplayList = theDispPtr->nextPtr; + displayList = theDispPtr->nextPtr; } else { backDispPtr->nextPtr = theDispPtr->nextPtr; } @@ -1997,7 +2086,7 @@ TkSetClassProcs(tkwin, procs, instanceData) * Results: * The return result is either a token for the window corresponding * to "name", or else NULL to indicate that there is no such - * window. In this case, an error message is left in interp->result. + * window. In this case, an error message is left in the interp's result. * * Side effects: * None. @@ -2052,7 +2141,7 @@ Tk_IdToWindow(display, window) TkDisplay *dispPtr; Tcl_HashEntry *hPtr; - for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) { + for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) { if (dispPtr == NULL) { return NULL; } @@ -2278,7 +2367,7 @@ Tk_RestackWindow(tkwin, aboveBelow, other) * Results: * If interp has a Tk application associated with it, the main * window for the application is returned. Otherwise NULL is - * returned and an error message is left in interp->result. + * returned and an error message is left in the interp's result. * * Side effects: * None. @@ -2293,14 +2382,16 @@ Tk_MainWindow(interp) * reporting also. */ { TkMainInfo *mainPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - for (mainPtr = tkMainWindowList; mainPtr != NULL; + for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL; mainPtr = mainPtr->nextPtr) { if (mainPtr->interp == interp) { return (Tk_Window) mainPtr->winPtr; } } - interp->result = "this isn't a Tk application"; + Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC); return NULL; } @@ -2411,7 +2502,10 @@ OpenIM(dispPtr) int Tk_GetNumMainWindows() { - return numMainWindows; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->numMainWindows; } /* @@ -2437,8 +2531,10 @@ DeleteWindowsExitProc(clientData) { TkDisplay *displayPtr, *nextPtr; Tcl_Interp *interp; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - while (tkMainWindowList != NULL) { + while (tsdPtr->mainWindowList != NULL) { /* * We must protect the interpreter while deleting the window, * because of <Destroy> bindings which could destroy the interpreter @@ -2446,14 +2542,14 @@ DeleteWindowsExitProc(clientData) * the call stack pointing at deleted memory, causing core dumps. */ - interp = tkMainWindowList->winPtr->mainPtr->interp; + interp = tsdPtr->mainWindowList->winPtr->mainPtr->interp; Tcl_Preserve((ClientData) interp); - Tk_DestroyWindow((Tk_Window) tkMainWindowList->winPtr); + Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr); Tcl_Release((ClientData) interp); } - displayPtr = tkDisplayList; - tkDisplayList = NULL; + displayPtr = tsdPtr->displayList; + tsdPtr->displayList = NULL; /* * Iterate destroying the displays until no more displays remain. @@ -2462,9 +2558,9 @@ DeleteWindowsExitProc(clientData) * as well as the old ones. */ - for (displayPtr = tkDisplayList; + for (displayPtr = tsdPtr->displayList; displayPtr != NULL; - displayPtr = tkDisplayList) { + displayPtr = tsdPtr->displayList) { /* * Now iterate over the current list of open displays, and first @@ -2475,7 +2571,8 @@ DeleteWindowsExitProc(clientData) * if it needs to dispatch a message. */ - for (tkDisplayList = NULL; displayPtr != NULL; displayPtr = nextPtr) { + for (tsdPtr->displayList = NULL; displayPtr != NULL; + displayPtr = nextPtr) { nextPtr = displayPtr->nextPtr; if (displayPtr->name != (char *) NULL) { ckfree(displayPtr->name); @@ -2485,12 +2582,9 @@ DeleteWindowsExitProc(clientData) } } - numMainWindows = 0; - tkMainWindowList = NULL; - initialized = 0; - tkDisabledUid = NULL; - tkActiveUid = NULL; - tkNormalUid = NULL; + tsdPtr->numMainWindows = 0; + tsdPtr->mainWindowList = NULL; + tsdPtr->initialized = 0; } /* @@ -2508,7 +2602,7 @@ DeleteWindowsExitProc(clientData) * the arguments that are extracted). * * Results: - * Returns a standard Tcl completion code and sets interp->result + * Returns a standard Tcl completion code and sets the interp's result * if there is an error. * * Side effects: @@ -2533,7 +2627,7 @@ Tk_Init(interp) * invokes the internal procedure that does the real work. * * Results: - * Returns a standard Tcl completion code and sets interp->result + * Returns a standard Tcl completion code and sets the interp's result * if there is an error. * * Side effects: @@ -2586,6 +2680,9 @@ Tk_SafeInit(interp) return Initialize(interp); } + +extern TkStubs tkStubs; + /* *---------------------------------------------------------------------- * @@ -2593,8 +2690,8 @@ Tk_SafeInit(interp) * * * Results: - * A standard Tcl result. Also leaves an error message in interp->result - * if there was an error. + * A standard Tcl result. Also leaves an error message in the interp's + * result if there was an error. * * Side effects: * Depends on the initialization scripts that are invoked. @@ -2610,8 +2707,8 @@ Initialize(interp) int argc, code; char **argv, *args[20]; Tcl_DString class; - char buffer[30]; - + ThreadSpecificData *tsdPtr; + /* * Ensure that we are getting the matching version of Tcl. This is * really only an issue when Tk is loaded dynamically. @@ -2620,13 +2717,17 @@ Initialize(interp) if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { return TCL_ERROR; } - + + tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + /* * Start by initializing all the static variables to default acceptable * values so that no information is leaked from a previous run of this * code. */ + Tcl_MutexLock(&windowMutex); synchronize = 0; name = NULL; display = NULL; @@ -2661,6 +2762,7 @@ Initialize(interp) if (master == NULL) { Tcl_DStringFree(&ds); Tcl_AppendResult(interp, "NULL master", (char *) NULL); + Tcl_MutexUnlock(&windowMutex); return TCL_ERROR; } if (!Tcl_IsSafe(master)) { @@ -2674,6 +2776,7 @@ Initialize(interp) if (Tcl_GetInterpPath(master, interp) != TCL_OK) { Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", (char *) NULL); + Tcl_MutexUnlock(&windowMutex); return TCL_ERROR; } /* @@ -2697,6 +2800,7 @@ Initialize(interp) Tcl_AppendResult(interp, "not allowed to start Tk by master's safe::TkInit", (char *) NULL); + Tcl_MutexUnlock(&windowMutex); return TCL_ERROR; } Tcl_DStringFree(&ds); @@ -2718,10 +2822,13 @@ Initialize(interp) } argv = NULL; if (p != NULL) { + char buffer[TCL_INTEGER_SPACE]; + if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) { argError: Tcl_AddErrorInfo(interp, "\n (processing arguments in argv variable)"); + Tcl_MutexUnlock(&windowMutex); return TCL_ERROR; } if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, @@ -2754,8 +2861,8 @@ Initialize(interp) } p = Tcl_DStringValue(&class); - if (islower(UCHAR(*p))) { - *p = toupper(UCHAR(*p)); + if (*p) { + Tcl_UtfToTitle(p); } /* @@ -2779,7 +2886,7 @@ Initialize(interp) * that it will be available to subprocesses created by us. */ - if (numMainWindows == 0) { + if (tsdPtr->numMainWindows == 0) { Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); } } @@ -2826,6 +2933,8 @@ Initialize(interp) } geometry = NULL; } + Tcl_MutexUnlock(&windowMutex); + if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) { code = TCL_ERROR; goto done; @@ -2835,11 +2944,17 @@ Initialize(interp) * Provide Tk and its stub table. */ - code = Tcl_PkgProvideEx(interp, "Tk", TK_VERSION, (ClientData) tkStubsPtr); + code = Tcl_PkgProvideEx(interp, "Tk", TK_VERSION, (ClientData) &tkStubs); if (code != TCL_OK) { goto done; } +#ifdef Tk_InitStubs +#undef Tk_InitStubs +#endif + + Tk_InitStubs(interp, TK_VERSION, 1); + /* * Invoke platform-specific initialization. */ diff --git a/library/bgerror.tcl b/library/bgerror.tcl index f809545..5f799c9 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -4,7 +4,7 @@ # posts a dialog box with the error message and gives the user a chance # to see a more detailed stack trace. # -# RCS: @(#) $Id: bgerror.tcl,v 1.4 1999/01/04 19:25:27 rjohnson Exp $ +# RCS: @(#) $Id: bgerror.tcl,v 1.5 1999/04/16 01:51:25 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -35,7 +35,7 @@ proc bgerror err { # code from the tkerror trial, other ret codes are passed back # to our caller (tcl background error handler) so the called "tkerror" # can still use return -code break, to skip remaining messages - # in the error queue for instance) + # in the error queue for instance) set ret [catch {tkerror $err} msg]; if {$ret != 1} {return -code $ret $msg} @@ -62,7 +62,7 @@ proc bgerror err { wm title $w "Stack Trace for Error" wm iconname $w "Stack Trace" button $w.ok -text OK -command "destroy $w" -default active - if {$tcl_platform(platform) == "macintosh"} { + if {![string compare $tcl_platform(platform) "macintosh"]} { text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \ -yscrollcommand "$w.scroll set" -width 60 -height 20 } else { @@ -94,7 +94,7 @@ proc bgerror err { # screen, since they could make it impossible for the user # to interact with the stack trace. - if {[grab current .] != ""} { + if {[string compare [grab current .] ""]} { grab release [grab current .] } } diff --git a/library/button.tcl b/library/button.tcl index 4214a8a..d70916a 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -4,7 +4,7 @@ # checkbutton, and radiobutton widgets and provides procedures # that help in implementing those bindings. # -# RCS: @(#) $Id: button.tcl,v 1.3 1998/09/14 18:23:22 stanton Exp $ +# RCS: @(#) $Id: button.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -17,7 +17,7 @@ # The code below creates the default class bindings for buttons. #------------------------------------------------------------------------- -if {$tcl_platform(platform) == "macintosh"} { +if {[string match "macintosh" $tcl_platform(platform)]} { bind Radiobutton <Enter> { tkButtonEnter %W } @@ -37,7 +37,7 @@ if {$tcl_platform(platform) == "macintosh"} { tkButtonUp %W } } -if {$tcl_platform(platform) == "windows"} { +if {[string match "windows" $tcl_platform(platform)]} { bind Checkbutton <equal> { tkCheckRadioInvoke %W select } @@ -67,7 +67,7 @@ if {$tcl_platform(platform) == "windows"} { tkCheckRadioEnter %W } } -if {$tcl_platform(platform) == "unix"} { +if {[string match "unix" $tcl_platform(platform)]} { bind Checkbutton <Return> { if {!$tk_strictMotif} { tkCheckRadioInvoke %W @@ -126,7 +126,7 @@ bind Radiobutton <Leave> { tkButtonLeave %W } -if {$tcl_platform(platform) == "windows"} { +if {[string match "windows" $tcl_platform(platform)]} { ######################### # Windows implementation @@ -142,8 +142,8 @@ if {$tcl_platform(platform) == "windows"} { proc tkButtonEnter w { global tkPriv - if {[$w cget -state] != "disabled"} { - if {$tkPriv(buttonWindow) == $w} { + if {[string compare [$w cget -state] "disabled"]} { + if {![string compare $tkPriv(buttonWindow) $w]} { $w configure -state active -relief sunken } } @@ -162,10 +162,10 @@ proc tkButtonEnter w { proc tkButtonLeave w { global tkPriv - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { $w config -state normal } - if {$w == $tkPriv(buttonWindow)} { + if {![string compare $tkPriv(buttonWindow) $w]} { $w configure -relief $tkPriv(relief) } set tkPriv(window) "" @@ -182,8 +182,8 @@ proc tkButtonLeave w { proc tkCheckRadioEnter w { global tkPriv - if {[$w cget -state] != "disabled"} { - if {$tkPriv(buttonWindow) == $w} { + if {[string compare [$w cget -state] "disabled"]} { + if {![string compare $tkPriv(buttonWindow) $w]} { $w configure -state active } } @@ -202,7 +202,7 @@ proc tkCheckRadioEnter w { proc tkButtonDown w { global tkPriv set tkPriv(relief) [lindex [$w conf -relief] 4] - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { set tkPriv(buttonWindow) $w $w config -relief sunken -state active } @@ -220,7 +220,7 @@ proc tkButtonDown w { proc tkCheckRadioDown w { global tkPriv set tkPriv(relief) [lindex [$w conf -relief] 4] - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { set tkPriv(buttonWindow) $w $w config -state active } @@ -236,10 +236,10 @@ proc tkCheckRadioDown w { proc tkButtonUp w { global tkPriv - if {$w == $tkPriv(buttonWindow)} { + if {![string compare $tkPriv(buttonWindow) $w]} { set tkPriv(buttonWindow) "" - if {($w == $tkPriv(window)) - && ([$w cget -state] != "disabled")} { + if {![string compare $tkPriv(window) $w] + && [string compare [$w cget -state] "disabled"]} { $w config -relief $tkPriv(relief) -state normal uplevel #0 [list $w invoke] } @@ -248,7 +248,7 @@ proc tkButtonUp w { } -if {$tcl_platform(platform) == "unix"} { +if {[string match "unix" $tcl_platform(platform)]} { ##################### # Unix implementation @@ -264,9 +264,9 @@ if {$tcl_platform(platform) == "unix"} { proc tkButtonEnter {w} { global tkPriv - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { $w config -state active - if {$tkPriv(buttonWindow) == $w} { + if {![string compare $tkPriv(buttonWindow) $w]} { $w configure -state active -relief sunken } } @@ -285,10 +285,10 @@ proc tkButtonEnter {w} { proc tkButtonLeave w { global tkPriv - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { $w config -state normal } - if {$w == $tkPriv(buttonWindow)} { + if {![string compare $tkPriv(buttonWindow) $w]} { $w configure -relief $tkPriv(relief) } set tkPriv(window) "" @@ -306,7 +306,7 @@ proc tkButtonLeave w { proc tkButtonDown w { global tkPriv set tkPriv(relief) [lindex [$w config -relief] 4] - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { set tkPriv(buttonWindow) $w $w config -relief sunken } @@ -322,11 +322,11 @@ proc tkButtonDown w { proc tkButtonUp w { global tkPriv - if {$w == $tkPriv(buttonWindow)} { + if {![string compare $w $tkPriv(buttonWindow)]} { set tkPriv(buttonWindow) "" $w config -relief $tkPriv(relief) - if {($w == $tkPriv(window)) - && ([$w cget -state] != "disabled")} { + if {![string compare $w $tkPriv(window)] + && [string compare [$w cget -state] "disabled"]} { uplevel #0 [list $w invoke] } } @@ -334,7 +334,7 @@ proc tkButtonUp w { } -if {$tcl_platform(platform) == "macintosh"} { +if {[string match "macintosh" $tcl_platform(platform)]} { #################### # Mac implementation @@ -350,8 +350,8 @@ if {$tcl_platform(platform) == "macintosh"} { proc tkButtonEnter {w} { global tkPriv - if {[$w cget -state] != "disabled"} { - if {$tkPriv(buttonWindow) == $w} { + if {[string compare [$w cget -state] "disabled"]} { + if {![string compare $w $tkPriv(buttonWindow)]} { $w configure -state active } } @@ -370,7 +370,7 @@ proc tkButtonEnter {w} { proc tkButtonLeave w { global tkPriv - if {$w == $tkPriv(buttonWindow)} { + if {![string compare $w $tkPriv(buttonWindow)]} { $w configure -state normal } set tkPriv(window) "" @@ -387,7 +387,7 @@ proc tkButtonLeave w { proc tkButtonDown w { global tkPriv - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { set tkPriv(buttonWindow) $w $w config -state active } @@ -403,11 +403,11 @@ proc tkButtonDown w { proc tkButtonUp w { global tkPriv - if {$w == $tkPriv(buttonWindow)} { + if {![string compare $w $tkPriv(buttonWindow)]} { $w config -state normal set tkPriv(buttonWindow) "" - if {($w == $tkPriv(window)) - && ([$w cget -state] != "disabled")} { + if {![string compare $w $tkPriv(window)] + && [string compare [$w cget -state] "disabled"]} { uplevel #0 [list $w invoke] } } @@ -427,7 +427,7 @@ proc tkButtonUp w { # w - The name of the widget. proc tkButtonInvoke w { - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { set oldRelief [$w cget -relief] set oldState [$w cget -state] $w configure -state active -relief sunken @@ -449,7 +449,7 @@ proc tkButtonInvoke w { # cmd - The subcommand to invoke (one of invoke, select, or deselect). proc tkCheckRadioInvoke {w {cmd invoke}} { - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { uplevel #0 [list $w $cmd] } } diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 7e56626..8f08324 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -3,7 +3,7 @@ # Color selection dialog for platforms that do not support a # standard color selection dialog. # -# RCS: @(#) $Id: clrpick.tcl,v 1.3 1998/09/14 18:23:22 stanton Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -84,7 +84,7 @@ proc tkColorDialog {args} { set oldFocus [focus] set oldGrab [grab current $w] - if {$oldGrab != ""} { + if {[string compare $oldGrab ""]} { set grabStatus [grab status $oldGrab] } grab $w @@ -101,8 +101,8 @@ proc tkColorDialog {args} { grab release $w destroy $w unset data - if {$oldGrab != ""} { - if {$grabStatus == "global"} { + if {[string compare $oldGrab ""]} { + if {![string compare $grabStatus "global"]} { grab -global $oldGrab } else { grab $oldGrab diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 2f7ba83..a8a9fdb 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -3,7 +3,7 @@ # Some functions needed for the common dialog boxes. Probably need to go # in a different file. # -# RCS: @(#) $Id: comdlg.tcl,v 1.3 1998/09/14 18:23:22 stanton Exp $ +# RCS: @(#) $Id: comdlg.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -52,13 +52,12 @@ proc tclParseConfigSpec {w specs flags argList} { set verproc($cmdsw) [lindex $spec 4] } - if {([llength $argList]%2) != 0} { - foreach {cmdsw value} $argList { - if {![info exists cmd($cmdsw)]} { - error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]" - } + if {[llength $argList] & 1} { + set cmdsw [lindex $argList end] + if {![info exists cmd($cmdsw)]} { + error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } - error "value for \"[lindex $argList end]\" missing" + error "value for \"$cmdsw\" missing" } # 2: set the default values @@ -71,7 +70,7 @@ proc tclParseConfigSpec {w specs flags argList} { # foreach {cmdsw value} $argList { if {![info exists cmd($cmdsw)]} { - error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]" + error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } set data($cmdsw) $value } @@ -90,7 +89,7 @@ proc tclListValidFlags {v} { append errormsg "$separator$cmdsw" incr i if {$i == $len} { - set separator " or " + set separator ", or " } else { set separator ", " } diff --git a/library/console.tcl b/library/console.tcl index 7ce1e91..602f32d 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -4,7 +4,7 @@ # can be used by non-unix systems that do not have built-in support # for shells. # -# RCS: @(#) $Id: console.tcl,v 1.3 1998/09/14 18:23:22 stanton Exp $ +# RCS: @(#) $Id: console.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # @@ -23,14 +23,14 @@ proc tkConsoleInit {} { global tcl_platform - if {! [consoleinterp eval {set tcl_interactive}]} { + if {![consoleinterp eval {set tcl_interactive}]} { wm withdraw . } - if {"$tcl_platform(platform)" == "macintosh"} { - set mod "Cmd" - } else { + if {[string compare $tcl_platform(platform) "macintosh"]} { set mod "Ctrl" + } else { + set mod "Cmd" } menu .menubar @@ -42,10 +42,10 @@ proc tkConsoleInit {} { -command tkConsoleSource .menubar.file add command -label "Hide Console" -underline 0 \ -command {wm withdraw .} - if {"$tcl_platform(platform)" == "macintosh"} { - .menubar.file add command -label "Quit" -command exit -accel Cmd-Q - } else { + if {[string compare $tcl_platform(platform) "macintosh"]} { .menubar.file add command -label "Exit" -underline 1 -command exit + } else { + .menubar.file add command -label "Quit" -command exit -accel Cmd-Q } menu .menubar.edit -tearoff 0 @@ -56,7 +56,10 @@ proc tkConsoleInit {} { .menubar.edit add command -label "Paste" -underline 1 \ -command { event generate .console <<Paste>> } -accel "$mod+V" - if {"$tcl_platform(platform)" == "windows"} { + if {[string compare $tcl_platform(platform) "windows"]} { + .menubar.edit add command -label "Clear" -underline 2 \ + -command { event generate .console <<Clear>> } + } else { .menubar.edit add command -label "Delete" -underline 0 \ -command { event generate .console <<Clear>> } -accel "Del" @@ -64,9 +67,6 @@ proc tkConsoleInit {} { menu .menubar.help -tearoff 0 .menubar.help add command -label "About..." -underline 0 \ -command tkConsoleAbout - } else { - .menubar.edit add command -label "Clear" -underline 2 \ - -command { event generate .console <<Clear>> } } . conf -menu .menubar @@ -75,7 +75,7 @@ proc tkConsoleInit {} { scrollbar .sb -command ".console yview" pack .sb -side right -fill both pack .console -fill both -expand 1 -side left - if {$tcl_platform(platform) == "macintosh"} { + if {![string compare $tcl_platform(platform) "macintosh"]} { .console configure -font {Monaco 9 normal} -highlightthickness 0 } @@ -106,7 +106,7 @@ proc tkConsoleSource {} { set filename [tk_getOpenFile -defaultextension .tcl -parent . \ -title "Select a file to source" \ -filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}] - if {"$filename" != ""} { + if {[string compare $filename ""]} { set cmd [list source $filename] if {[catch {consoleinterp eval $cmd} result]} { tkConsoleOutput stderr "$result\n" @@ -125,23 +125,23 @@ proc tkConsoleSource {} { proc tkConsoleInvoke {args} { set ranges [.console tag ranges input] set cmd "" - if {$ranges != ""} { + if {[llength $ranges]} { set pos 0 - while {[lindex $ranges $pos] != ""} { + while {[string compare [lindex $ranges $pos] ""]} { set start [lindex $ranges $pos] set end [lindex $ranges [incr pos]] append cmd [.console get $start $end] incr pos } } - if {$cmd == ""} { + if {![string compare $cmd ""]} { tkConsolePrompt } elseif {[info complete $cmd]} { .console mark set output end .console tag delete input set result [consoleinterp record $cmd] - if {$result != ""} { - .console insert insert "$result\n" + if {[string compare $result ""]} { + puts $result } tkConsoleHistory reset tkConsolePrompt @@ -189,7 +189,7 @@ proc tkConsoleHistory {cmd} { } else { set cmd "history event $histNum" } - if {$cmd != ""} { + if {[string compare $cmd ""]} { catch {consoleinterp eval $cmd} cmd } .console delete promptEnd end @@ -210,7 +210,7 @@ proc tkConsoleHistory {cmd} { # partial - Flag to specify which prompt to print. proc tkConsolePrompt {{partial normal}} { - if {$partial == "normal"} { + if {![string compare $partial "normal"]} { set temp [.console index "end - 1 char"] .console mark set output end if {[consoleinterp eval "info exists tcl_prompt1"]} { @@ -268,7 +268,7 @@ proc tkConsoleBind {win} { break } bind $win <Delete> { - if {[%W tag nextrange sel 1.0 end] != ""} { + if {[string compare [%W tag nextrange sel 1.0 end] ""]} { %W tag remove sel sel.first promptEnd } else { if {[%W compare insert < promptEnd]} { @@ -277,7 +277,7 @@ proc tkConsoleBind {win} { } } bind $win <BackSpace> { - if {[%W tag nextrange sel 1.0 end] != ""} { + if {[string compare [%W tag nextrange sel 1.0 end] ""]} { %W tag remove sel sel.first promptEnd } else { if {[%W compare insert <= promptEnd]} { @@ -368,7 +368,7 @@ proc tkConsoleBind {win} { } bind $win <F9> { eval destroy [winfo child .] - if {$tcl_platform(platform) == "macintosh"} { + if {![string compare $tcl_platform(platform) "macintosh"]} { source -rsrc Console } else { source [file join $tk_library console.tcl] @@ -416,7 +416,7 @@ proc tkConsoleBind {win} { # s - The string to insert (usually just a single character) proc tkConsoleInsert {w s} { - if {$s == ""} { + if {![string compare $s ""]} { return } catch { diff --git a/library/dialog.tcl b/library/dialog.tcl index 5b3439f..be5a81e 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -3,7 +3,7 @@ # This file defines the procedure tk_dialog, which creates a dialog # box containing a bitmap, a message, and one or more buttons. # -# RCS: @(#) $Id: dialog.tcl,v 1.3 1998/09/14 18:23:22 stanton Exp $ +# RCS: @(#) $Id: dialog.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -47,13 +47,13 @@ proc tk_dialog {w title text bitmap default args} { # even though its grab keeps the rest of the application from being used. wm transient $w [winfo toplevel [winfo parent $w]] - if {$tcl_platform(platform) == "macintosh"} { + if {![string compare $tcl_platform(platform) "macintosh"]} { unsupported1 style $w dBoxProc } frame $w.bot frame $w.top - if {$tcl_platform(platform) == "unix"} { + if {![string compare $tcl_platform(platform) "unix"]} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } @@ -61,19 +61,20 @@ proc tk_dialog {w title text bitmap default args} { pack $w.top -side top -fill both -expand 1 # 2. Fill the top part with bitmap and message (use the option - # database for -wraplength so that it can be overridden by - # the caller). + # database for -wraplength and -font so that they can be + # overridden by the caller). option add *Dialog.msg.wrapLength 3i widgetDefault - label $w.msg -justify left -text $text - if {$tcl_platform(platform) == "macintosh"} { - $w.msg configure -font system + if {![string compare $tcl_platform(platform) "macintosh"]} { + option add *Dialog.msg.font system widgetDefault } else { - $w.msg configure -font {Times 18} + option add *Dialog.msg.font {Times 18} widgetDefault } + + label $w.msg -justify left -text $text pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m - if {$bitmap != ""} { - if {($tcl_platform(platform) == "macintosh") && ($bitmap == "error")} { + if {[string compare $bitmap ""]} { + if {![string compare $tcl_platform(platform) "macintosh"] && ![string compare $bitmap "error"]} { set bitmap "stop" } label $w.bitmap -bitmap $bitmap @@ -93,9 +94,9 @@ proc tk_dialog {w title text bitmap default args} { grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10 grid columnconfigure $w.bot $i # We boost the size of some Mac buttons for l&f - if {$tcl_platform(platform) == "macintosh"} { + if {![string compare $tcl_platform(platform) "macintosh"]} { set tmp [string tolower $but] - if {($tmp == "ok") || ($tmp == "cancel")} { + if {![string compare $tmp "ok"] || ![string compare $tmp "cancel"]} { grid columnconfigure $w.bot $i -minsize [expr 59 + 20] } } @@ -107,7 +108,7 @@ proc tk_dialog {w title text bitmap default args} { if {$default >= 0} { bind $w <Return> " - $w.button$default configure -state active -relief sunken + [list $w.button$default] configure -state active -relief sunken update idletasks after 100 set tkPriv(button) $default @@ -137,7 +138,7 @@ proc tk_dialog {w title text bitmap default args} { set oldFocus [focus] set oldGrab [grab current $w] - if {$oldGrab != ""} { + if {[string compare $oldGrab ""]} { set grabStatus [grab status $oldGrab] } grab $w @@ -163,11 +164,11 @@ proc tk_dialog {w title text bitmap default args} { bind $w <Destroy> {} destroy $w } - if {$oldGrab != ""} { - if {$grabStatus == "global"} { - grab -global $oldGrab - } else { + if {[string compare $oldGrab ""]} { + if {[string compare $grabStatus "global"]} { grab $oldGrab + } else { + grab -global $oldGrab } } return $tkPriv(button) diff --git a/library/entry.tcl b/library/entry.tcl index 1b817f4..e7141b1 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk entry widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: entry.tcl,v 1.5 1998/09/14 18:23:23 stanton Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.6 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -32,16 +32,14 @@ # The code below creates the default class bindings for entries. #------------------------------------------------------------------------- bind Entry <<Cut>> { - if {![catch {set data [string range [%W get] [%W index sel.first]\ - [expr {[%W index sel.last] - 1}]]}]} { + if {![catch {set data [tkEntryGetSelection %W]}]} { clipboard clear -displayof %W clipboard append -displayof %W $data %W delete sel.first sel.last } } bind Entry <<Copy>> { - if {![catch {set data [string range [%W get] [%W index sel.first]\ - [expr {[%W index sel.last] - 1}]]}]} { + if {![catch {set data [tkEntryGetSelection %W]}]} { clipboard clear -displayof %W clipboard append -displayof %W $data } @@ -49,7 +47,7 @@ bind Entry <<Copy>> { bind Entry <<Paste>> { global tcl_platform catch { - if {"$tcl_platform(platform)" != "unix"} { + if {[string compare $tcl_platform(platform) "unix"]} { catch { %W delete sel.first sel.last } @@ -201,13 +199,13 @@ bind Entry <Escape> {# nothing} bind Entry <Return> {# nothing} bind Entry <KP_Enter> {# nothing} bind Entry <Tab> {# nothing} -if {$tcl_platform(platform) == "macintosh"} { +if {![string compare $tcl_platform(platform) "macintosh"]} { bind Entry <Command-KeyPress> {# 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. -if {$tcl_platform(platform) != "windows"} { +if {[string compare $tcl_platform(platform) "windows"]} { bind Entry <Insert> { catch {tkEntryInsert %W [selection get -displayof %W]} } @@ -335,7 +333,7 @@ proc tkEntryButton1 {w x} { set tkPriv(pressX) $x $w icursor [tkEntryClosestGap $w $x] $w selection from insert - if {[lindex [$w configure -state] 4] == "normal"} {focus $w} + if {![string compare [$w cget -state] "normal"]} {focus $w} } # tkEntryMouseSelect -- @@ -405,7 +403,7 @@ proc tkEntryPaste {w x} { $w icursor [tkEntryClosestGap $w $x] catch {$w insert insert [selection get -displayof $w]} - if {[lindex [$w configure -state] 4] == "normal"} {focus $w} + if {![string compare [$w cget -state] "normal"]} {focus $w} } # tkEntryAutoScan -- @@ -462,7 +460,7 @@ proc tkEntryKeySelect {w new} { # s - The string to insert (usually just a single character) proc tkEntryInsert {w s} { - if {$s == ""} { + if {![string compare $s ""]} { return } catch { @@ -570,7 +568,7 @@ proc tkEntryTranspose w { # w - The entry window in which the cursor is to move. # start - Position at which to start search. -if {$tcl_platform(platform) == "windows"} { +if {![string compare $tcl_platform(platform) "windows"]} { proc tkEntryNextWord {w start} { set pos [tcl_endOfWord [$w get] [$w index $start]] if {$pos >= 0} { @@ -607,4 +605,18 @@ proc tkEntryPreviousWord {w start} { } return $pos } +# tkEntryGetSelection -- +# +# Returns the selected text of the entry with respect to the -show option. +# +# Arguments: +# w - The entry window from which the text to get +proc tkEntryGetSelection {w} { + set entryString [string range [$w get] [$w index sel.first] \ + [expr [$w index sel.last] - 1]] + if {[$w cget -show] != ""} { + regsub -all . $entryString [string index [$w cget -show] 0] entryString + } + return $entryString +} diff --git a/library/focus.tcl b/library/focus.tcl index 276d518..5ece432 100644 --- a/library/focus.tcl +++ b/library/focus.tcl @@ -3,7 +3,7 @@ # This file defines several procedures for managing the input # focus. # -# RCS: @(#) $Id: focus.tcl,v 1.3 1998/09/14 18:23:23 stanton Exp $ +# RCS: @(#) $Id: focus.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1994-1995 Sun Microsystems, Inc. # @@ -38,7 +38,7 @@ proc tk_focusNext w { incr i if {$i < [llength $children]} { set cur [lindex $children $i] - if {[winfo toplevel $cur] == $cur} { + if {![string compare [winfo toplevel $cur] $cur]} { continue } else { break @@ -50,14 +50,14 @@ proc tk_focusNext w { # look for its next sibling. set cur $parent - if {[winfo toplevel $cur] == $cur} { + if {![string compare [winfo toplevel $cur] $cur]} { break } set parent [winfo parent $parent] set children [winfo children $parent] set i [lsearch -exact $children $cur] } - if {($cur == $w) || [tkFocusOK $cur]} { + if {![string compare $w $cur] || [tkFocusOK $cur]} { return $cur } } @@ -81,8 +81,8 @@ proc tk_focusPrev w { # Collect information about the current window's position # among its siblings. Also, if the window is a top-level, # then reposition to just after the last child of the window. - - if {[winfo toplevel $cur] == $cur} { + + if {![string compare [winfo toplevel $cur] $cur]} { set parent $cur set children [winfo children $cur] set i [llength $children] @@ -100,7 +100,7 @@ proc tk_focusPrev w { while {$i > 0} { incr i -1 set cur [lindex $children $i] - if {[winfo toplevel $cur] == $cur} { + if {![string compare [winfo toplevel $cur] $cur]} { continue } set parent $cur @@ -108,7 +108,7 @@ proc tk_focusPrev w { set i [llength $children] } set cur $parent - if {($cur == $w) || [tkFocusOK $cur]} { + if {![string compare $w $cur] || [tkFocusOK $cur]} { return $cur } } @@ -130,14 +130,14 @@ proc tk_focusPrev w { proc tkFocusOK w { set code [catch {$w cget -takefocus} value] - if {($code == 0) && ($value != "")} { + if {($code == 0) && [string compare $value ""]} { if {$value == 0} { return 0 } elseif {$value == 1} { return [winfo viewable $w] } else { set value [uplevel #0 $value $w] - if {$value != ""} { + if {[string compare $value ""]} { return $value } } @@ -146,7 +146,7 @@ proc tkFocusOK w { return 0 } set code [catch {$w cget -state} value] - if {($code == 0) && ($value == "disabled")} { + if {($code == 0) && ![string compare $value "disabled"]} { return 0 } regexp Key|Focus "[bind $w] [bind [winfo class $w]]" @@ -165,14 +165,15 @@ proc tkFocusOK w { proc tk_focusFollowsMouse {} { set old [bind all <Enter>] set script { - if {("%d" == "NotifyAncestor") || ("%d" == "NotifyNonlinear") - || ("%d" == "NotifyInferior")} { - if {[tkFocusOK %W]} { - focus %W - } + if {![string compare "%d" "NotifyAncestor"] + || ![string compare "%d" "NotifyNonlinear"] + || ![string compare "%d" "NotifyInferior"]} { + if {[tkFocusOK %W]} { + focus %W + } } } - if {$old != ""} { + if {[string compare $old ""]} { bind all <Enter> "$old; $script" } else { bind all <Enter> $script diff --git a/library/images/logo.eps b/library/images/logo.eps new file mode 100644 index 0000000..0d05d34 --- /dev/null +++ b/library/images/logo.eps @@ -0,0 +1,2091 @@ +%!PS-Adobe-3.0 EPSF-3.0 +%%Creator: Adobe Illustrator(TM) 5.5 +%%For: (Bud Northern) (Mark Anderson Design) +%%Title: (TCL/TK LOGO.ILLUS) +%%CreationDate: (8/1/96) (4:58 PM) +%%BoundingBox: 251 331 371 512 +%%HiResBoundingBox: 251.3386 331.5616 370.5213 511.775 +%%DocumentProcessColors: Cyan Magenta Yellow +%%DocumentSuppliedResources: procset Adobe_level2_AI5 1.0 0 +%%+ procset Adobe_IllustratorA_AI5 1.0 0 +%AI5_FileFormat 1.2 +%AI3_ColorUsage: Color +%%DocumentCustomColors: (TCL RED) +%%CMYKCustomColor: 0 0.45 1 0 (Orange) +%%+ 0 0.25 1 0 (Orange Yellow) +%%+ 0 0.79 0.91 0 (TCL RED) +%AI3_TemplateBox: 306 396 306 396 +%AI3_TileBox: 12 12 600 780 +%AI3_DocumentPreview: Macintosh_ColorPic +%AI5_ArtSize: 612 792 +%AI5_RulerUnits: 0 +%AI5_ArtFlags: 1 0 0 1 0 0 1 1 0 +%AI5_TargetResolution: 800 +%AI5_NumLayers: 1 +%AI5_OpenToView: 90 576 2 938 673 18 1 1 2 40 +%AI5_OpenViewLayers: 7 +%%EndComments +%%BeginProlog +%%BeginResource: procset Adobe_level2_AI5 1.0 0 +%%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation) +%%Version: 1.0 +%%CreationDate: (04/10/93) () +%%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved) +userdict /Adobe_level2_AI5 21 dict dup begin + put + /packedarray where not + { + userdict begin + /packedarray + { + array astore readonly + } bind def + /setpacking /pop load def + /currentpacking false def + end + 0 + } if + pop + userdict /defaultpacking currentpacking put true setpacking + /initialize + { + Adobe_level2_AI5 begin + } bind def + /terminate + { + currentdict Adobe_level2_AI5 eq + { + end + } if + } bind def + mark + /setcustomcolor where not + { + /findcmykcustomcolor + { + 5 packedarray + } bind def + /setcustomcolor + { + exch aload pop pop + 4 + { + 4 index mul 4 1 roll + } repeat + 5 -1 roll pop + setcmykcolor + } + def + } if + + /gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def + userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put + userdict /level2? + systemdict /languagelevel known dup + { + pop systemdict /languagelevel get 2 ge + } if + put + level2? not + { + /setcmykcolor where not + { + /setcmykcolor + { + exch .11 mul add exch .59 mul add exch .3 mul add + 1 exch sub setgray + } def + } if + /currentcmykcolor where not + { + /currentcmykcolor + { + 0 0 0 1 currentgray sub + } def + } if + /setoverprint where not + { + /setoverprint /pop load def + } if + /selectfont where not + { + /selectfont + { + exch findfont exch + dup type /arraytype eq + { + makefont + } + { + scalefont + } ifelse + setfont + } bind def + } if + /cshow where not + { + /cshow + { + [ + 0 0 5 -1 roll aload pop + ] cvx bind forall + } bind def + } if + } if + cleartomark + /anyColor? + { + add add add 0 ne + } bind def + /testColor + { + gsave + setcmykcolor currentcmykcolor + grestore + } bind def + /testCMYKColorThrough + { + testColor anyColor? + } bind def + userdict /composite? + level2? + { + gsave 1 1 1 1 setcmykcolor currentcmykcolor grestore + add add add 4 eq + } + { + 1 0 0 0 testCMYKColorThrough + 0 1 0 0 testCMYKColorThrough + 0 0 1 0 testCMYKColorThrough + 0 0 0 1 testCMYKColorThrough + and and and + } ifelse + put + composite? not + { + userdict begin + gsave + /cyan? 1 0 0 0 testCMYKColorThrough def + /magenta? 0 1 0 0 testCMYKColorThrough def + /yellow? 0 0 1 0 testCMYKColorThrough def + /black? 0 0 0 1 testCMYKColorThrough def + grestore + /isCMYKSep? cyan? magenta? yellow? black? or or or def + /customColor? isCMYKSep? not def + end + } if + end defaultpacking setpacking +%%EndResource +%%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0 +%%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog) +%%Version: 1.1 +%%CreationDate: (3/7/1994) () +%%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved) +currentpacking true setpacking +userdict /Adobe_IllustratorA_AI5_vars 70 dict dup begin +put +/_lp /none def +/_pf +{ +} def +/_ps +{ +} def +/_psf +{ +} def +/_pss +{ +} def +/_pjsf +{ +} def +/_pjss +{ +} def +/_pola 0 def +/_doClip 0 def +/cf currentflat def +/_tm matrix def +/_renderStart +[ +/e0 /r0 /a0 /o0 /e1 /r1 /a1 /i0 +] def +/_renderEnd +[ +null null null null /i1 /i1 /i1 /i1 +] def +/_render -1 def +/_rise 0 def +/_ax 0 def +/_ay 0 def +/_cx 0 def +/_cy 0 def +/_leading +[ +0 0 +] def +/_ctm matrix def +/_mtx matrix def +/_sp 16#020 def +/_hyphen (-) def +/_fScl 0 def +/_cnt 0 def +/_hs 1 def +/_nativeEncoding 0 def +/_useNativeEncoding 0 def +/_tempEncode 0 def +/_pntr 0 def +/_tDict 2 dict def +/_wv 0 def +/Tx +{ +} def +/Tj +{ +} def +/CRender +{ +} def +/_AI3_savepage +{ +} def +/_gf null def +/_cf 4 array def +/_if null def +/_of false def +/_fc +{ +} def +/_gs null def +/_cs 4 array def +/_is null def +/_os false def +/_sc +{ +} def +/discardSave null def +/buffer 256 string def +/beginString null def +/endString null def +/endStringLength null def +/layerCnt 1 def +/layerCount 1 def +/perCent (%) 0 get def +/perCentSeen? false def +/newBuff null def +/newBuffButFirst null def +/newBuffLast null def +/clipForward? false def +end +userdict /Adobe_IllustratorA_AI5 74 dict dup begin +put +/initialize +{ + Adobe_IllustratorA_AI5 dup begin + Adobe_IllustratorA_AI5_vars begin + discardDict + { + bind pop pop + } forall + dup /nc get begin + { + dup xcheck 1 index type /operatortype ne and + { + bind + } if + pop pop + } forall + end + newpath +} def +/terminate +{ + end + end +} def +/_ +null def +/ddef +{ + Adobe_IllustratorA_AI5_vars 3 1 roll put +} def +/xput +{ + dup load dup length exch maxlength eq + { + dup dup load dup + length 2 mul dict copy def + } if + load begin + def + end +} def +/npop +{ + { + pop + } repeat +} def +/sw +{ + dup length exch stringwidth + exch 5 -1 roll 3 index mul add + 4 1 roll 3 1 roll mul add +} def +/swj +{ + dup 4 1 roll + dup length exch stringwidth + exch 5 -1 roll 3 index mul add + 4 1 roll 3 1 roll mul add + 6 2 roll /_cnt 0 ddef + { + 1 index eq + { + /_cnt _cnt 1 add ddef + } if + } forall + pop + exch _cnt mul exch _cnt mul 2 index add 4 1 roll 2 index add 4 1 roll pop pop +} def +/ss +{ + 4 1 roll + { + 2 npop + (0) exch 2 copy 0 exch put pop + gsave + false charpath currentpoint + 4 index setmatrix + stroke + grestore + moveto + 2 copy rmoveto + } exch cshow + 3 npop +} def +/jss +{ + 4 1 roll + { + 2 npop + (0) exch 2 copy 0 exch put + gsave + _sp eq + { + exch 6 index 6 index 6 index 5 -1 roll widthshow + currentpoint + } + { + false charpath currentpoint + 4 index setmatrix stroke + } ifelse + grestore + moveto + 2 copy rmoveto + } exch cshow + 6 npop +} def +/sp +{ + { + 2 npop (0) exch + 2 copy 0 exch put pop + false charpath + 2 copy rmoveto + } exch cshow + 2 npop +} def +/jsp +{ + { + 2 npop + (0) exch 2 copy 0 exch put + _sp eq + { + exch 5 index 5 index 5 index 5 -1 roll widthshow + } + { + false charpath + } ifelse + 2 copy rmoveto + } exch cshow + 5 npop +} def +/pl +{ + transform + 0.25 sub round 0.25 add exch + 0.25 sub round 0.25 add exch + itransform +} def +/setstrokeadjust where +{ + pop true setstrokeadjust + /c + { + curveto + } def + /C + /c load def + /v + { + currentpoint 6 2 roll curveto + } def + /V + /v load def + /y + { + 2 copy curveto + } def + /Y + /y load def + /l + { + lineto + } def + /L + /l load def + /m + { + moveto + } def +} +{ + /c + { + pl curveto + } def + /C + /c load def + /v + { + currentpoint 6 2 roll pl curveto + } def + /V + /v load def + /y + { + pl 2 copy curveto + } def + /Y + /y load def + /l + { + pl lineto + } def + /L + /l load def + /m + { + pl moveto + } def +} ifelse +/d +{ + setdash +} def +/cf +{ +} def +/i +{ + dup 0 eq + { + pop cf + } if + setflat +} def +/j +{ + setlinejoin +} def +/J +{ + setlinecap +} def +/M +{ + setmiterlimit +} def +/w +{ + setlinewidth +} def +/H +{ +} def +/h +{ + closepath +} def +/N +{ + _pola 0 eq + { + _doClip 1 eq + { + clip /_doClip 0 ddef + } if + newpath + } + { + /CRender + { + N + } ddef + } ifelse +} def +/n +{ + N +} def +/F +{ + _pola 0 eq + { + _doClip 1 eq + { + gsave _pf grestore clip newpath /_lp /none ddef _fc + /_doClip 0 ddef + } + { + _pf + } ifelse + } + { + /CRender + { + F + } ddef + } ifelse +} def +/f +{ + closepath + F +} def +/S +{ + _pola 0 eq + { + _doClip 1 eq + { + gsave _ps grestore clip newpath /_lp /none ddef _sc + /_doClip 0 ddef + } + { + _ps + } ifelse + } + { + /CRender + { + S + } ddef + } ifelse +} def +/s +{ + closepath + S +} def +/B +{ + _pola 0 eq + { + _doClip 1 eq + gsave F grestore + { + gsave S grestore clip newpath /_lp /none ddef _sc + /_doClip 0 ddef + } + { + S + } ifelse + } + { + /CRender + { + B + } ddef + } ifelse +} def +/b +{ + closepath + B +} def +/W +{ + /_doClip 1 ddef +} def +/* +{ + count 0 ne + { + dup type /stringtype eq + { + pop + } if + } if + newpath +} def +/u +{ +} def +/U +{ +} def +/q +{ + _pola 0 eq + { + gsave + } if +} def +/Q +{ + _pola 0 eq + { + grestore + } if +} def +/*u +{ + _pola 1 add /_pola exch ddef +} def +/*U +{ + _pola 1 sub /_pola exch ddef + _pola 0 eq + { + CRender + } if +} def +/D +{ + pop +} def +/*w +{ +} def +/*W +{ +} def +/` +{ + /_i save ddef + clipForward? + { + nulldevice + } if + 6 1 roll 4 npop + concat pop + userdict begin + /showpage + { + } def + 0 setgray + 0 setlinecap + 1 setlinewidth + 0 setlinejoin + 10 setmiterlimit + [] 0 setdash + /setstrokeadjust where {pop false setstrokeadjust} if + newpath + 0 setgray + false setoverprint +} def +/~ +{ + end + _i restore +} def +/O +{ + 0 ne + /_of exch ddef + /_lp /none ddef +} def +/R +{ + 0 ne + /_os exch ddef + /_lp /none ddef +} def +/g +{ + /_gf exch ddef + /_fc + { + _lp /fill ne + { + _of setoverprint + _gf setgray + /_lp /fill ddef + } if + } ddef + /_pf + { + _fc + fill + } ddef + /_psf + { + _fc + ashow + } ddef + /_pjsf + { + _fc + awidthshow + } ddef + /_lp /none ddef +} def +/G +{ + /_gs exch ddef + /_sc + { + _lp /stroke ne + { + _os setoverprint + _gs setgray + /_lp /stroke ddef + } if + } ddef + /_ps + { + _sc + stroke + } ddef + /_pss + { + _sc + ss + } ddef + /_pjss + { + _sc + jss + } ddef + /_lp /none ddef +} def +/k +{ + _cf astore pop + /_fc + { + _lp /fill ne + { + _of setoverprint + _cf aload pop setcmykcolor + /_lp /fill ddef + } if + } ddef + /_pf + { + _fc + fill + } ddef + /_psf + { + _fc + ashow + } ddef + /_pjsf + { + _fc + awidthshow + } ddef + /_lp /none ddef +} def +/K +{ + _cs astore pop + /_sc + { + _lp /stroke ne + { + _os setoverprint + _cs aload pop setcmykcolor + /_lp /stroke ddef + } if + } ddef + /_ps + { + _sc + stroke + } ddef + /_pss + { + _sc + ss + } ddef + /_pjss + { + _sc + jss + } ddef + /_lp /none ddef +} def +/x +{ + /_gf exch ddef + findcmykcustomcolor + /_if exch ddef + /_fc + { + _lp /fill ne + { + _of setoverprint + _if _gf 1 exch sub setcustomcolor + /_lp /fill ddef + } if + } ddef + /_pf + { + _fc + fill + } ddef + /_psf + { + _fc + ashow + } ddef + /_pjsf + { + _fc + awidthshow + } ddef + /_lp /none ddef +} def +/X +{ + /_gs exch ddef + findcmykcustomcolor + /_is exch ddef + /_sc + { + _lp /stroke ne + { + _os setoverprint + _is _gs 1 exch sub setcustomcolor + /_lp /stroke ddef + } if + } ddef + /_ps + { + _sc + stroke + } ddef + /_pss + { + _sc + ss + } ddef + /_pjss + { + _sc + jss + } ddef + /_lp /none ddef +} def +/A +{ + pop +} def +/annotatepage +{ +userdict /annotatepage 2 copy known {get exec} {pop pop} ifelse +} def +/discard +{ + save /discardSave exch store + discardDict begin + /endString exch store + gt38? + { + 2 add + } if + load + stopped + pop + end + discardSave restore +} bind def +userdict /discardDict 7 dict dup begin +put +/pre38Initialize +{ + /endStringLength endString length store + /newBuff buffer 0 endStringLength getinterval store + /newBuffButFirst newBuff 1 endStringLength 1 sub getinterval store + /newBuffLast newBuff endStringLength 1 sub 1 getinterval store +} def +/shiftBuffer +{ + newBuff 0 newBuffButFirst putinterval + newBuffLast 0 + currentfile read not + { + stop + } if + put +} def +0 +{ + pre38Initialize + mark + currentfile newBuff readstring exch pop + { + { + newBuff endString eq + { + cleartomark stop + } if + shiftBuffer + } loop + } + { + stop + } ifelse +} def +1 +{ + pre38Initialize + /beginString exch store + mark + currentfile newBuff readstring exch pop + { + { + newBuff beginString eq + { + /layerCount dup load 1 add store + } + { + newBuff endString eq + { + /layerCount dup load 1 sub store + layerCount 0 eq + { + cleartomark stop + } if + } if + } ifelse + shiftBuffer + } loop + } + { + stop + } ifelse +} def +2 +{ + mark + { + currentfile buffer readline not + { + stop + } if + endString eq + { + cleartomark stop + } if + } loop +} def +3 +{ + /beginString exch store + /layerCnt 1 store + mark + { + currentfile buffer readline not + { + stop + } if + dup beginString eq + { + pop /layerCnt dup load 1 add store + } + { + endString eq + { + layerCnt 1 eq + { + cleartomark stop + } + { + /layerCnt dup load 1 sub store + } ifelse + } if + } ifelse + } loop +} def +end +userdict /clipRenderOff 15 dict dup begin +put +{ + /n /N /s /S /f /F /b /B +} +{ + { + _doClip 1 eq + { + /_doClip 0 ddef clip + } if + newpath + } def +} forall +/Tr /pop load def +/Bb {} def +/BB /pop load def +/Bg {12 npop} def +/Bm {6 npop} def +/Bc /Bm load def +/Bh {4 npop} def +end +/Lb +{ + 4 npop + 6 1 roll + pop + 4 1 roll + pop pop pop + 0 eq + { + 0 eq + { + (%AI5_BeginLayer) 1 (%AI5_EndLayer--) discard + } + { + /clipForward? true def + + /Tx /pop load def + /Tj /pop load def + currentdict end clipRenderOff begin begin + } ifelse + } + { + 0 eq + { + save /discardSave exch store + } if + } ifelse +} bind def +/LB +{ + discardSave dup null ne + { + restore + } + { + pop + clipForward? + { + currentdict + end + end + begin + + /clipForward? false ddef + } if + } ifelse +} bind def +/Pb +{ + pop pop + 0 (%AI5_EndPalette) discard +} bind def +/Np +{ + 0 (%AI5_End_NonPrinting--) discard +} bind def +/Ln /pop load def +/Ap +/pop load def +/Ar +{ + 72 exch div + 0 dtransform dup mul exch dup mul add sqrt + dup 1 lt + { + pop 1 + } if + setflat +} def +/Mb +{ + q +} def +/Md +{ +} def +/MB +{ + Q +} def +/nc 3 dict def +nc begin +/setgray +{ + pop +} bind def +/setcmykcolor +{ + 4 npop +} bind def +/setcustomcolor +{ + 2 npop +} bind def +currentdict readonly pop +end +currentdict readonly pop +end +setpacking +%%EndResource +%%EndProlog +%%BeginSetup +Adobe_level2_AI5 /initialize get exec +Adobe_IllustratorA_AI5 /initialize get exec +%AI5_Begin_NonPrinting +Np +%AI3_BeginPattern: (Yellow Stripe) +(Yellow Stripe) 8.4499 4.6 80.4499 76.6 [ +%AI3_Tile +(0 O 0 R 0 0.4 1 0 k 0 0.4 1 0 K) @ +( +800 Ar +0 J 0 j 3.6 w 4 M []0 d +%AI3_Note: +0 D +8.1999 8.1999 m +80.6999 8.1999 L +S +8.1999 22.6 m +80.6999 22.6 L +S +8.1999 37.0001 m +80.6999 37.0001 L +S +8.1999 51.3999 m +80.6999 51.3999 L +S +8.1999 65.8 m +80.6999 65.8 L +S +8.1999 15.3999 m +80.6999 15.3999 L +S +8.1999 29.8 m +80.6999 29.8 L +S +8.1999 44.1999 m +80.6999 44.1999 L +S +8.1999 58.6 m +80.6999 58.6 L +S +8.1999 73.0001 m +80.6999 73.0001 L +S +) & +] E +%AI3_EndPattern +%AI5_End_NonPrinting-- +%AI5_Begin_NonPrinting +Np +3 Bn +%AI5_BeginGradient: (Black & White) +(Black & White) 0 2 Bd +[ +< +FFFEFDFCFBFAF9F8F7F6F5F4F3F2F1F0EFEEEDECEBEAE9E8E7E6E5E4E3E2E1E0DFDEDDDCDBDAD9D8 +D7D6D5D4D3D2D1D0CFCECDCCCBCAC9C8C7C6C5C4C3C2C1C0BFBEBDBCBBBAB9B8B7B6B5B4B3B2B1B0 +AFAEADACABAAA9A8A7A6A5A4A3A2A1A09F9E9D9C9B9A999897969594939291908F8E8D8C8B8A8988 +87868584838281807F7E7D7C7B7A797877767574737271706F6E6D6C6B6A69686766656463626160 +5F5E5D5C5B5A595857565554535251504F4E4D4C4B4A494847464544434241403F3E3D3C3B3A3938 +37363534333231302F2E2D2C2B2A292827262524232221201F1E1D1C1B1A19181716151413121110 +0F0E0D0C0B0A09080706050403020100 +> +0 %_Br +[ +0 0 50 100 %_Bs +1 0 50 0 %_Bs +BD +%AI5_EndGradient +%AI5_BeginGradient: (Red & Yellow) +(Red & Yellow) 0 2 Bd +[ +0 +< +000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627 +28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F +505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677 +78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F +A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7 +C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF +F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF +> +< +FFFFFEFEFDFDFDFCFCFBFBFBFAFAF9F9F9F8F8F7F7F7F6F6F5F5F5F4F4F3F3F3F2F2F1F1F1F0F0EF +EFEFEEEEEDEDEDECECEBEBEBEAEAE9E9E9E8E8E7E7E7E6E6E5E5E5E4E4E3E3E3E2E2E1E1E1E0E0DF +DFDFDEDEDDDDDDDCDCDBDBDBDADAD9D9D9D8D8D7D7D7D6D6D5D5D5D4D4D3D3D3D2D2D1D1D1D0D0CF +CFCFCECECDCDCDCCCCCBCBCBCACAC9C9C9C8C8C7C7C7C6C6C5C5C5C4C4C3C3C3C2C2C1C1C1C0C0BF +BFBFBEBEBDBDBDBCBCBBBBBBBABAB9B9B9B8B8B7B7B7B6B6B5B5B5B4B4B3B3B3B2B2B1B1B1B0B0AF +AFAFAEAEADADADACACABABABAAAAA9A9A9A8A8A7A7A7A6A6A5A5A5A4A4A3A3A3A2A2A1A1A1A0A09F +9F9F9E9E9D9D9D9C9C9B9B9B9A9A9999 +> +0 +1 %_Br +[ +0 1 0.6 0 1 50 100 %_Bs +0 0 1 0 1 50 0 %_Bs +BD +%AI5_EndGradient +%AI5_BeginGradient: (Yellow & Blue Radial) +(Yellow & Blue Radial) 1 2 Bd +[ +< +000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627 +28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F +505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677 +78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F +A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7 +C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF +F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF +> +< +1415161718191A1B1C1D1E1F1F202122232425262728292A2A2B2C2D2E2F30313233343536363738 +393A3B3C3D3E3F40414142434445464748494A4B4C4D4D4E4F50515253545556575858595A5B5C5D +5E5F60616263646465666768696A6B6C6D6E6F6F707172737475767778797A7B7B7C7D7E7F808182 +83848586868788898A8B8C8D8E8F90919292939495969798999A9B9C9D9D9E9FA0A1A2A3A4A5A6A7 +A8A9A9AAABACADAEAFB0B1B2B3B4B4B5B6B7B8B9BABBBCBDBEBFC0C0C1C2C3C4C5C6C7C8C9CACBCB +CCCDCECFD0D1D2D3D4D5D6D7D7D8D9DADBDCDDDEDFE0E1E2E2E3E4E5E6E7E8E9EAEBECEDEEEEEFF0 +F1F2F3F4F5F6F7F8F9F9FAFBFCFDFEFF +> +< +ABAAAAA9A8A7A7A6A5A5A4A3A3A2A1A1A09F9F9E9D9D9C9B9B9A9999989797969595949393929191 +908F8F8E8D8D8C8B8B8A8989888787868585848383828181807F7F7E7D7D7C7B7B7A797978777776 +7575747373727171706F6F6E6D6D6C6B6B6A6969686767666565646362626160605F5E5E5D5C5C5B +5A5A5958585756565554545352525150504F4E4E4D4C4C4B4A4A4948484746464544444342424140 +403F3E3E3D3C3C3B3A3A3938383736363534343332323130302F2E2E2D2C2C2B2A2A292828272626 +25242423222121201F1F1E1D1D1C1B1B1A1919181717161515141313121111100F0F0E0D0D0C0B0B +0A090908070706050504030302010100 +> +0 +1 %_Br +[ +0 0.08 0.67 0 1 50 14 %_Bs +1 1 0 0 1 50 100 %_Bs +BD +%AI5_EndGradient +%AI5_End_NonPrinting-- +%AI5_BeginPalette +144 170 Pb +Pn +Pc +1 g +Pc +0 g +Pc +0 0 0 0 k +Pc +0.75 g +Pc +0.5 g +Pc +0.25 g +Pc +0 g +Pc +Bb +2 (Black & White) -4014 4716 0 0 1 0 0 1 0 0 Bg +0 BB +Pc +0.25 0 0 0 k +Pc +0.5 0 0 0 k +Pc +0.75 0 0 0 k +Pc +1 0 0 0 k +Pc +0.25 0.25 0 0 k +Pc +0.5 0.5 0 0 k +Pc +0.75 0.75 0 0 k +Pc +1 1 0 0 k +Pc +Bb +2 (Red & Yellow) -4014 4716 0 0 1 0 0 1 0 0 Bg +0 BB +Pc +0 0.25 0 0 k +Pc +0 0.5 0 0 k +Pc +0 0.75 0 0 k +Pc +0 1 0 0 k +Pc +0 0.25 0.25 0 k +Pc +0 0.5 0.5 0 k +Pc +0 0.75 0.75 0 k +Pc +0 1 1 0 k +Pc +Bb +0 0 0 0 Bh +2 (Yellow & Blue Radial) -4014 4716 0 0 1 0 0 1 0 0 Bg +0 BB +Pc +0 0 0.25 0 k +Pc +0 0 0.5 0 k +Pc +0 0 0.75 0 k +Pc +0 0 1 0 k +Pc +0.25 0 0.25 0 k +Pc +0.5 0 0.5 0 k +Pc +0.75 0 0.75 0 k +Pc +1 0 1 0 k +Pc +(Yellow Stripe) 0 0 1 1 0 0 0 0 0 [1 0 0 1 0 0] p +Pc +0.25 0.125 0 0 k +Pc +0.5 0.25 0 0 k +Pc +0.75 0.375 0 0 k +Pc +1 0.5 0 0 k +Pc +0.125 0.25 0 0 k +Pc +0.25 0.5 0 0 k +Pc +0.375 0.75 0 0 k +Pc +0.5 1 0 0 k +Pc +0.375 0.375 0.75 0 k +Pc +0 0.25 0.125 0 k +Pc +0 0.5 0.25 0 k +Pc +0 0.75 0.375 0 k +Pc +0 1 0.5 0 k +Pc +0 0.125 0.25 0 k +Pc +0 0.25 0.5 0 k +Pc +0 0.375 0.75 0 k +Pc +0 0.5 1 0 k +Pc +0 0.79 0.91 0 (TCL RED) 0 x +Pc +0.125 0 0.25 0 k +Pc +0.25 0 0.5 0 k +Pc +0.375 0 0.75 0 k +Pc +0.5 0 1 0 k +Pc +0.25 0 0.125 0 k +Pc +0.5 0 0.25 0 k +Pc +0.75 0 0.375 0 k +Pc +1 0 0.5 0 k +Pc +0.5 1 0 0 k +Pc +0.25 0.125 0.125 0 k +Pc +0.5 0.25 0.25 0 k +Pc +0.75 0.375 0.375 0 k +Pc +1 0.5 0.5 0 k +Pc +0.25 0.25 0.125 0 k +Pc +0.5 0.5 0.25 0 k +Pc +0.75 0.75 0.375 0 k +Pc +1 1 0.5 0 k +Pc +0 1 0.5 0 k +Pc +0.125 0.25 0.125 0 k +Pc +0.25 0.5 0.25 0 k +Pc +0.375 0.75 0.375 0 k +Pc +0.5 1 0.5 0 k +Pc +0.125 0.25 0.25 0 k +Pc +0.25 0.5 0.5 0 k +Pc +0.375 0.75 0.75 0 k +Pc +0.5 1 1 0 k +Pc +0.75 0.75 0.375 0 k +Pc +0.125 0.125 0.25 0 k +Pc +0.25 0.25 0.5 0 k +Pc +0.375 0.375 0.75 0 k +Pc +0.5 0.5 1 0 k +Pc +0.25 0.125 0.25 0 k +Pc +0.5 0.25 0.5 0 k +Pc +0.75 0.375 0.75 0 k +Pc +1 0.5 1 0 k +Pc +0 0.79 0.91 0 (TCL RED) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +1 0.5 0.5 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0.25 1 0 (Orange Yellow) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 1 0.5 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +1 0 0.5 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0.45 1 0 (Orange) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0.375 0.375 0.75 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0.79 0.91 0 (TCL RED) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +1 0.65 0 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0 1 0 k +Pc +PB +%AI5_EndPalette +%%EndSetup +%AI5_BeginLayer +1 1 1 1 0 0 0 79 128 255 Lb +(Layer 1) Ln +0 A +u +1 Ap +0 O +0 0.79 0.91 0 (TCL RED) 0 x +800 Ar +0 J 0 j 1.25 w 4 M []0 d +%AI3_Note: +0 D +294.5207 335.3041 m +368.2181 333.001 L +363.6121 423.9713 L +370.5213 507.1689 L +336.5513 505.4417 L +320.7179 511.775 L +251.3386 508.0325 L +254.7931 425.9866 L +251.3386 331.5616 L +294.5207 335.3041 L +f +u +0 Ap +1 0.65 0 0 k +1 w +318.1366 400.9627 m +311.8663 399.2526 l +315.2864 407.5177 l +318.7064 430.6032 l +314.4314 431.4581 l +319.5616 438.5832 l +325.9526 462.6014 l +314.7164 460.2436 l +320.6412 471.0911 326.9284 478.1557 v +318.7064 484.469 l +292.2183 472.8011 299.3434 434.8954 v +293.8679 435.8542 l +299.1189 396.1175 l +294.6797 394.9775 l +299.2277 385.6974 305.5963 381.2973 v +306.1744 380.8979 297.6162 412.3629 306.7363 443.7133 c +307.5914 441.7183 l +300.3238 408.3015 307.5914 381.2973 v +307.9261 380.656 311.5598 381.0836 v +318.1366 393.4813 318.1366 400.9627 v +f +u +*u +1 g +271.4311 372.5074 m +272.7184 372.5074 L +272.7184 375.1913 L +273.2858 375.1913 273.8313 375.1913 274.3768 375.2786 c +274.3768 372.5074 L +276.2969 372.5074 L +276.2969 372.0056 L +274.3768 372.0056 L +274.3768 365.3286 L +274.3768 364.9359 274.3768 364.3467 275.2059 364.3467 c +275.7733 364.3467 276.0787 364.7395 276.4279 365.1541 c +276.777 364.9141 L +276.3624 364.0849 275.2932 363.583 274.4204 363.583 c +272.8494 363.583 272.6748 364.434 272.6748 365.4814 c +272.6748 372.0056 L +271.4311 372.0056 L +271.4311 372.5074 l +f +*U +*u +290.5617 366.5724 m +290.0598 365.0232 289.187 363.6703 286.9178 363.583 c +283.5356 363.583 282.5101 366.3978 282.5101 367.9034 c +282.5101 371.7874 285.6304 372.7256 286.8741 372.7256 c +288.2924 372.7256 290.2999 372.071 290.2999 370.3909 c +290.2999 369.8018 289.9289 369.2344 289.318 369.2344 c +288.7288 369.2344 288.2924 369.6272 288.2924 370.26 c +288.2924 371.111 288.9907 371.2201 288.9907 371.4601 c +288.9907 372.0492 287.616 372.2892 287.136 372.2892 c +285.0412 372.2892 284.4957 370.7618 284.4957 367.9034 c +284.4957 366.5942 284.823 365.5905 284.9539 365.285 c +285.2812 364.5649 285.9577 364.1067 287.0923 364.0413 c +288.3579 363.9758 289.5798 365.0013 290.1035 366.5724 C +290.5617 366.5724 l +f +*U +*u +296.6 363.8667 m +296.6 364.3686 L +298.2802 364.3686 L +298.2802 378.3989 L +296.6 378.3989 L +296.6 378.9007 L +297.5383 378.9007 L +298.3457 378.9007 299.1966 378.9444 299.9822 379.0971 c +299.9822 364.3686 L +301.6623 364.3686 L +301.6623 363.8667 L +296.6 363.8667 l +f +*U +*u +317.4527 372.5074 m +318.7401 372.5074 L +318.7401 375.1913 L +319.3074 375.1913 319.8529 375.1913 320.3984 375.2786 c +320.3984 372.5074 L +322.3186 372.5074 L +322.3186 372.0056 L +320.3984 372.0056 L +320.3984 365.3286 L +320.3984 364.9359 320.3984 364.3467 321.2276 364.3467 c +321.7949 364.3467 322.1004 364.7395 322.4495 365.1541 c +322.7986 364.9141 L +322.384 364.0849 321.3148 363.583 320.442 363.583 c +318.871 363.583 318.6964 364.434 318.6964 365.4814 c +318.6964 372.0056 L +317.4527 372.0056 L +317.4527 372.5074 l +f +*U +*u +333.7467 372.0056 m +333.7467 372.5074 L +337.3252 372.5074 L +337.3252 372.0056 L +335.9942 372.0056 L +332.983 369.3872 L +337.1288 364.3686 L +338.0453 364.3686 L +338.0453 363.8667 L +333.8995 363.8667 L +333.8995 364.3686 L +334.9905 364.3686 L +331.3465 368.798 L +335.0341 371.9401 L +335.0341 372.0056 L +333.7467 372.0056 l +f +328.4881 363.8667 m +328.4881 364.3686 L +329.6227 364.3686 L +329.6227 378.3989 L +328.4881 378.3989 L +328.4881 378.9007 L +328.8809 378.9007 L +329.6882 378.9007 330.5392 378.9444 331.3247 379.0971 c +331.3247 364.3686 L +332.6339 364.3686 L +332.6339 363.8667 L +328.4881 363.8667 l +f +*U +u +309.5341 446.5364 m +305.6878 429.3874 306.7947 401.5837 v +307.1266 393.2441 308.0387 385.5779 309.1527 378.9301 C +309.1587 378.9297 L +309.8832 373.0923 310.3679 370.9791 312.2568 363.9454 C +312.1466 359.4091 L +297.0216 407.7015 309.5341 446.5364 V +f +318.8187 461.4058 m +322.2203 463.1 327.0966 463.7165 v +332.427 453.9463 319.3087 437.2655 v +327.1346 454.735 325.2889 460.2079 v +323.225 461.4903 318.8187 461.4058 v +f +317.2065 432.0795 m +320.2613 431.3723 321.7279 432.5601 v +318.8383 421.2839 319.5958 415.0813 v +320.3533 408.8787 314.8881 404.9079 y +319.5435 410.7982 318.0802 415.5959 v +317.0657 418.9214 318.2006 427.4326 319.4809 430.1349 c +318.2853 430.3025 317.2065 432.0795 v +f +314.1861 402.3703 m +319.2343 402.9744 319.7646 405.5244 v +320.3824 390.2725 313.3689 383.9873 v +318.7204 392.3347 317.8807 400.9697 v +314.1861 402.3703 l +f +299.9864 396.0219 m +298.3586 394.1986 293.4739 398.2203 v +295.0301 387.9694 304.6978 383.2767 v +298.0444 388.2897 296.2519 393.7045 v +298.6029 394.3966 299.9864 396.0219 v +f +298.4281 399.9096 m +291.8229 416.6749 293.2382 439.3286 v +294.7808 435.2261 299.738 433.7875 v +297.4026 433.3101 296.0372 433.517 v +292.5816 423.9535 298.4281 399.9096 v +f +326.1736 477.812 m +323.6983 496.0028 308.2122 477.6066 v +295.8813 462.9582 297.3508 450.5217 298.1072 443.5831 c +298.3007 441.8079 295.8131 462.1138 309.3231 475.4768 c +322.8328 488.8398 325.8846 478.5879 326.1736 477.812 c +f +U +0 0 1 0 k +303.3623 493.3274 m +291.211 496.7978 287.3437 456.5222 v +284.3599 468.9535 292.0777 486.5353 v +299.7955 504.1172 303.3623 493.3274 y +f +288.2873 496.2718 m +282.0897 486.9502 283.4958 477.0213 v +278.7953 495.712 288.2873 496.2718 v +f +333.8987 470.1328 m +341.2276 472.8361 330.7334 445.5571 v +336.1654 453.5292 339.5844 466.0531 v +341.7789 474.0903 333.8987 470.1328 y +f +345.752 472.2583 m +350.9334 467.5681 347.2615 461.3636 v +356.4779 471.0481 345.752 472.2583 v +f +U +*u +273.1765 354.3318 m +273.1765 353.7507 273.1305 353.2908 272.5159 353.2908 c +271.8846 353.2908 271.8554 353.7674 271.8554 354.3318 c +271.8554 356.485 L +272.148 356.485 L +272.148 354.3486 L +272.148 353.8259 272.1773 353.5751 272.5159 353.5751 c +272.8504 353.5751 272.8839 353.8259 272.8839 354.3486 c +272.8839 356.485 L +273.1765 356.485 L +273.1765 354.3318 l +f +*U +*u +277.1612 356.485 m +276.9062 356.485 L +276.9062 354.3862 l +276.9062 354.2482 276.9271 354.1061 276.9355 353.9681 C +276.9229 353.9681 l +276.8937 354.0768 276.8644 354.1855 276.8268 354.2942 C +276.1035 356.485 L +275.8484 356.485 L +275.8484 353.3326 L +276.1035 353.3326 L +276.1035 355.2474 l +276.1035 355.4523 276.0826 355.653 276.07 355.8579 C +276.0867 355.8579 l +276.1244 355.7241 276.1495 355.5819 276.1954 355.4523 C +276.9062 353.3326 L +277.1612 353.3326 l +277.1612 356.485 L +f +*U +*u +280.1421 353.3326 m +279.8494 353.3326 L +279.8494 356.485 L +280.1421 356.485 L +280.1421 353.3326 l +f +*U +*u +283.5141 353.3326 m +283.2549 353.3326 L +282.6194 356.485 L +282.9205 356.485 L +283.3344 354.1897 L +283.3511 354.1102 283.3678 353.9054 283.3845 353.7632 c +283.4013 353.7632 L +283.4138 353.9054 283.4305 354.1144 283.4431 354.1897 c +283.8528 356.485 L +284.1496 356.485 L +283.5141 353.3326 l +f +*U +*u +287.6238 356.2174 m +286.9256 356.2174 L +286.9256 355.1053 L +287.6029 355.1053 L +287.6029 354.8377 L +286.9256 354.8377 L +286.9256 353.6002 L +287.6238 353.6002 L +287.6238 353.3326 L +286.6329 353.3326 L +286.6329 356.485 L +287.6238 356.485 L +287.6238 356.2174 l +f +*U +*u +290.2278 353.3326 m +290.2278 356.485 L +290.5414 356.485 L +290.9804 356.485 291.4026 356.4515 291.4026 355.6823 c +291.4026 355.2809 291.3148 354.8879 290.8089 354.8712 c +291.5072 353.3326 L +291.1978 353.3326 L +290.5288 354.8753 L +290.5205 354.8753 L +290.5205 353.3326 L +290.2278 353.3326 l +f +290.5205 355.1137 m +290.625 355.1137 L +291.0347 355.1137 291.1016 355.2558 291.1016 355.6697 c +291.1016 356.1672 290.9511 356.2174 290.579 356.2174 c +290.5205 356.2174 L +290.5205 355.1137 l +f +*U +*u +295.0981 355.9875 m +294.9727 356.1296 294.8347 356.2425 294.634 356.2425 c +294.3414 356.2425 294.1783 356 294.1783 355.7324 c +294.1783 355.3645 294.4459 355.1931 294.7176 355.0091 c +294.9852 354.821 295.2528 354.6203 295.2528 354.1855 c +295.2528 353.7256 294.9559 353.2908 294.4626 353.2908 c +294.287 353.2908 294.1072 353.341 293.9651 353.4497 c +293.9651 353.8301 L +294.0989 353.688 294.2745 353.5751 294.4751 353.5751 c +294.7845 353.5751 294.9559 353.8468 294.9518 354.1311 c +294.9559 354.4991 294.6842 354.6621 294.4166 354.8503 c +294.149 355.0342 293.8773 355.2391 293.8773 355.6906 c +293.8773 356.1129 294.1365 356.5268 294.6006 356.5268 c +294.7887 356.5268 294.9476 356.4641 295.0981 356.3596 C +295.0981 355.9875 l +f +*U +*u +299.0865 353.3326 m +298.773 353.3326 L +298.6559 353.9806 L +297.9869 353.9806 L +297.8741 353.3326 L +297.5605 353.3326 L +298.1793 356.485 L +298.4552 356.485 L +299.0865 353.3326 l +f +298.6099 354.2357 m +298.4009 355.444 L +298.3632 355.6572 298.3465 355.8746 298.3214 356.0878 c +298.3047 356.0878 L +298.2754 355.8746 298.2545 355.6572 298.2211 355.444 c +298.0371 354.2357 L +298.6099 354.2357 l +f +*U +*u +301.8124 353.6002 m +302.4981 353.6002 L +302.4981 353.3326 L +301.5198 353.3326 L +301.5198 356.485 L +301.8124 356.485 L +301.8124 353.6002 l +f +*U +*u +309.0754 355.9875 m +308.95 356.1296 308.812 356.2425 308.6114 356.2425 c +308.3187 356.2425 308.1556 356 308.1556 355.7324 c +308.1556 355.3645 308.4232 355.1931 308.695 355.0091 c +308.9626 354.821 309.2301 354.6203 309.2301 354.1855 c +309.2301 353.7256 308.9333 353.2908 308.4399 353.2908 c +308.2643 353.2908 308.0846 353.341 307.9424 353.4497 c +307.9424 353.8301 L +308.0762 353.688 308.2518 353.5751 308.4525 353.5751 c +308.7619 353.5751 308.9333 353.8468 308.9291 354.1311 c +308.9333 354.4991 308.6615 354.6621 308.3939 354.8503 c +308.1264 355.0342 307.8546 355.2391 307.8546 355.6906 c +307.8546 356.1129 308.1138 356.5268 308.5779 356.5268 c +308.766 356.5268 308.9249 356.4641 309.0754 356.3596 C +309.0754 355.9875 l +f +*U +*u +312.9468 353.7172 m +312.8339 353.6378 312.7001 353.5751 312.558 353.5751 c +311.9977 353.5751 311.9977 354.5492 311.9977 354.9172 c +311.9977 355.5025 312.0688 356.2425 312.5789 356.2425 c +312.7252 356.2425 312.8297 356.184 312.9468 356.1045 C +312.9468 356.4265 l +312.8506 356.4975 312.6918 356.5268 312.5747 356.5268 c +311.7134 356.5268 311.6967 355.306 311.6967 354.7959 c +311.6967 354.2566 311.8054 353.2908 312.5454 353.2908 c +312.6834 353.2908 312.8381 353.3451 312.9468 353.4204 c +312.9468 353.7172 L +f +*U +*u +315.5053 353.3326 m +315.5053 356.485 L +315.8188 356.485 L +316.2578 356.485 316.6801 356.4515 316.6801 355.6823 c +316.6801 355.2809 316.5923 354.8879 316.0864 354.8712 c +316.7846 353.3326 L +316.4752 353.3326 L +315.8063 354.8753 L +315.7979 354.8753 L +315.7979 353.3326 L +315.5053 353.3326 l +f +315.7979 355.1137 m +315.9025 355.1137 L +316.3122 355.1137 316.3791 355.2558 316.3791 355.6697 c +316.3791 356.1672 316.2286 356.2174 315.8565 356.2174 c +315.7979 356.2174 L +315.7979 355.1137 l +f +*U +*u +319.5728 353.3326 m +319.2802 353.3326 L +319.2802 356.485 L +319.5728 356.485 L +319.5728 353.3326 l +f +*U +*u +322.2551 353.3326 m +322.2551 356.485 L +322.5812 356.485 L +323.0327 356.485 323.4341 356.4432 323.4341 355.6655 c +323.4341 355.0551 323.2209 354.8419 322.623 354.8419 c +322.5477 354.8419 L +322.5477 353.3326 L +322.2551 353.3326 l +f +322.5477 355.1095 m +322.6606 355.1095 L +323.0703 355.1095 323.1205 355.26 323.1331 355.6655 c +323.1331 356.1004 323.016 356.2174 322.6063 356.2174 c +322.5477 356.2174 L +322.5477 355.1095 l +f +*U +*u +326.9539 356.485 m +325.7164 356.485 L +325.7164 356.2174 L +326.1888 356.2174 L +326.1888 353.3326 L +326.4815 353.3326 L +326.4815 356.2174 L +326.9539 356.2174 l +326.9539 356.485 L +f +*U +*u +329.7077 353.3326 m +329.4151 353.3326 L +329.4151 356.485 L +329.7077 356.485 L +329.7077 353.3326 l +f +*U +*u +333.7028 353.3326 m +333.4477 353.3326 L +332.737 355.4523 L +332.691 355.5819 332.6659 355.7241 332.6283 355.8579 c +332.6116 355.8579 L +332.6241 355.653 332.645 355.4523 332.645 355.2474 c +332.645 353.3326 L +332.39 353.3326 L +332.39 356.485 L +332.645 356.485 L +333.3683 354.2942 L +333.4059 354.1855 333.4352 354.0768 333.4645 353.9681 c +333.477 353.9681 L +333.4686 354.1061 333.4477 354.2482 333.4477 354.3862 c +333.4477 356.485 L +333.7028 356.485 L +333.7028 353.3326 l +f +*U +*u +336.9846 354.9966 m +337.7037 354.9966 L +337.7037 354.4154 L +337.7037 353.9179 337.6787 353.2908 337.0264 353.2908 c +336.3617 353.2908 336.299 353.989 336.299 354.9841 c +336.299 355.7283 336.3868 356.5268 337.0557 356.5268 c +337.432 356.5268 337.6201 356.276 337.6996 355.9331 c +337.4111 355.8202 L +337.3776 356.0084 337.2982 356.2425 337.0682 356.2425 c +336.6334 356.2383 336.6 355.5652 336.6 355.0091 c +336.6 353.8427 336.7463 353.5751 337.0515 353.5751 c +337.3818 353.5751 337.4111 353.8176 337.4111 354.4907 c +337.4111 354.729 L +336.9846 354.729 L +336.9846 354.9966 l +f +*U +U +U +337.6667 -3924 m +(N) * +337.6667 4716 m +(N) * +LB +%AI5_EndLayer-- +%%PageTrailer +gsave annotatepage grestore showpage +%%Trailer +Adobe_IllustratorA_AI5 /terminate get exec +Adobe_level2_AI5 /terminate get exec +%%EOF diff --git a/library/images/pwrdLogo.eps b/library/images/pwrdLogo.eps new file mode 100644 index 0000000..e11d9e9 --- /dev/null +++ b/library/images/pwrdLogo.eps @@ -0,0 +1,1897 @@ +%!PS-Adobe-3.0 EPSF-3.0 +%%Creator: Adobe Illustrator(TM) 5.5 +%%For: (Bud Northern) (Mark Anderson Design) +%%Title: (TCL PWRD LOGO.ILLUS) +%%CreationDate: (8/1/96) (4:59 PM) +%%BoundingBox: 242 302 377 513 +%%HiResBoundingBox: 242.0523 302.5199 376.3322 512.5323 +%%DocumentProcessColors: Cyan Magenta Yellow +%%DocumentSuppliedResources: procset Adobe_level2_AI5 1.0 0 +%%+ procset Adobe_IllustratorA_AI5 1.0 0 +%AI5_FileFormat 1.2 +%AI3_ColorUsage: Color +%%CMYKCustomColor: 0 0.45 1 0 (Orange) +%%+ 0 0.25 1 0 (Orange Yellow) +%%+ 0 0.79 0.91 0 (PANTONE Warm Red CV) +%%+ 0 0.79 0.91 0 (TCL RED) +%AI3_TemplateBox: 306 396 306 396 +%AI3_TileBox: 12 12 600 780 +%AI3_DocumentPreview: Macintosh_ColorPic +%AI5_ArtSize: 612 792 +%AI5_RulerUnits: 0 +%AI5_ArtFlags: 1 0 0 1 0 0 1 1 0 +%AI5_TargetResolution: 800 +%AI5_NumLayers: 1 +%AI5_OpenToView: 102 564 2 938 673 18 1 1 2 40 +%AI5_OpenViewLayers: 7 +%%EndComments +%%BeginProlog +%%BeginResource: procset Adobe_level2_AI5 1.0 0 +%%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation) +%%Version: 1.0 +%%CreationDate: (04/10/93) () +%%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved) +userdict /Adobe_level2_AI5 21 dict dup begin + put + /packedarray where not + { + userdict begin + /packedarray + { + array astore readonly + } bind def + /setpacking /pop load def + /currentpacking false def + end + 0 + } if + pop + userdict /defaultpacking currentpacking put true setpacking + /initialize + { + Adobe_level2_AI5 begin + } bind def + /terminate + { + currentdict Adobe_level2_AI5 eq + { + end + } if + } bind def + mark + /setcustomcolor where not + { + /findcmykcustomcolor + { + 5 packedarray + } bind def + /setcustomcolor + { + exch aload pop pop + 4 + { + 4 index mul 4 1 roll + } repeat + 5 -1 roll pop + setcmykcolor + } + def + } if + + /gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def + userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put + userdict /level2? + systemdict /languagelevel known dup + { + pop systemdict /languagelevel get 2 ge + } if + put + level2? not + { + /setcmykcolor where not + { + /setcmykcolor + { + exch .11 mul add exch .59 mul add exch .3 mul add + 1 exch sub setgray + } def + } if + /currentcmykcolor where not + { + /currentcmykcolor + { + 0 0 0 1 currentgray sub + } def + } if + /setoverprint where not + { + /setoverprint /pop load def + } if + /selectfont where not + { + /selectfont + { + exch findfont exch + dup type /arraytype eq + { + makefont + } + { + scalefont + } ifelse + setfont + } bind def + } if + /cshow where not + { + /cshow + { + [ + 0 0 5 -1 roll aload pop + ] cvx bind forall + } bind def + } if + } if + cleartomark + /anyColor? + { + add add add 0 ne + } bind def + /testColor + { + gsave + setcmykcolor currentcmykcolor + grestore + } bind def + /testCMYKColorThrough + { + testColor anyColor? + } bind def + userdict /composite? + level2? + { + gsave 1 1 1 1 setcmykcolor currentcmykcolor grestore + add add add 4 eq + } + { + 1 0 0 0 testCMYKColorThrough + 0 1 0 0 testCMYKColorThrough + 0 0 1 0 testCMYKColorThrough + 0 0 0 1 testCMYKColorThrough + and and and + } ifelse + put + composite? not + { + userdict begin + gsave + /cyan? 1 0 0 0 testCMYKColorThrough def + /magenta? 0 1 0 0 testCMYKColorThrough def + /yellow? 0 0 1 0 testCMYKColorThrough def + /black? 0 0 0 1 testCMYKColorThrough def + grestore + /isCMYKSep? cyan? magenta? yellow? black? or or or def + /customColor? isCMYKSep? not def + end + } if + end defaultpacking setpacking +%%EndResource +%%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0 +%%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog) +%%Version: 1.1 +%%CreationDate: (3/7/1994) () +%%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved) +currentpacking true setpacking +userdict /Adobe_IllustratorA_AI5_vars 70 dict dup begin +put +/_lp /none def +/_pf +{ +} def +/_ps +{ +} def +/_psf +{ +} def +/_pss +{ +} def +/_pjsf +{ +} def +/_pjss +{ +} def +/_pola 0 def +/_doClip 0 def +/cf currentflat def +/_tm matrix def +/_renderStart +[ +/e0 /r0 /a0 /o0 /e1 /r1 /a1 /i0 +] def +/_renderEnd +[ +null null null null /i1 /i1 /i1 /i1 +] def +/_render -1 def +/_rise 0 def +/_ax 0 def +/_ay 0 def +/_cx 0 def +/_cy 0 def +/_leading +[ +0 0 +] def +/_ctm matrix def +/_mtx matrix def +/_sp 16#020 def +/_hyphen (-) def +/_fScl 0 def +/_cnt 0 def +/_hs 1 def +/_nativeEncoding 0 def +/_useNativeEncoding 0 def +/_tempEncode 0 def +/_pntr 0 def +/_tDict 2 dict def +/_wv 0 def +/Tx +{ +} def +/Tj +{ +} def +/CRender +{ +} def +/_AI3_savepage +{ +} def +/_gf null def +/_cf 4 array def +/_if null def +/_of false def +/_fc +{ +} def +/_gs null def +/_cs 4 array def +/_is null def +/_os false def +/_sc +{ +} def +/discardSave null def +/buffer 256 string def +/beginString null def +/endString null def +/endStringLength null def +/layerCnt 1 def +/layerCount 1 def +/perCent (%) 0 get def +/perCentSeen? false def +/newBuff null def +/newBuffButFirst null def +/newBuffLast null def +/clipForward? false def +end +userdict /Adobe_IllustratorA_AI5 74 dict dup begin +put +/initialize +{ + Adobe_IllustratorA_AI5 dup begin + Adobe_IllustratorA_AI5_vars begin + discardDict + { + bind pop pop + } forall + dup /nc get begin + { + dup xcheck 1 index type /operatortype ne and + { + bind + } if + pop pop + } forall + end + newpath +} def +/terminate +{ + end + end +} def +/_ +null def +/ddef +{ + Adobe_IllustratorA_AI5_vars 3 1 roll put +} def +/xput +{ + dup load dup length exch maxlength eq + { + dup dup load dup + length 2 mul dict copy def + } if + load begin + def + end +} def +/npop +{ + { + pop + } repeat +} def +/sw +{ + dup length exch stringwidth + exch 5 -1 roll 3 index mul add + 4 1 roll 3 1 roll mul add +} def +/swj +{ + dup 4 1 roll + dup length exch stringwidth + exch 5 -1 roll 3 index mul add + 4 1 roll 3 1 roll mul add + 6 2 roll /_cnt 0 ddef + { + 1 index eq + { + /_cnt _cnt 1 add ddef + } if + } forall + pop + exch _cnt mul exch _cnt mul 2 index add 4 1 roll 2 index add 4 1 roll pop pop +} def +/ss +{ + 4 1 roll + { + 2 npop + (0) exch 2 copy 0 exch put pop + gsave + false charpath currentpoint + 4 index setmatrix + stroke + grestore + moveto + 2 copy rmoveto + } exch cshow + 3 npop +} def +/jss +{ + 4 1 roll + { + 2 npop + (0) exch 2 copy 0 exch put + gsave + _sp eq + { + exch 6 index 6 index 6 index 5 -1 roll widthshow + currentpoint + } + { + false charpath currentpoint + 4 index setmatrix stroke + } ifelse + grestore + moveto + 2 copy rmoveto + } exch cshow + 6 npop +} def +/sp +{ + { + 2 npop (0) exch + 2 copy 0 exch put pop + false charpath + 2 copy rmoveto + } exch cshow + 2 npop +} def +/jsp +{ + { + 2 npop + (0) exch 2 copy 0 exch put + _sp eq + { + exch 5 index 5 index 5 index 5 -1 roll widthshow + } + { + false charpath + } ifelse + 2 copy rmoveto + } exch cshow + 5 npop +} def +/pl +{ + transform + 0.25 sub round 0.25 add exch + 0.25 sub round 0.25 add exch + itransform +} def +/setstrokeadjust where +{ + pop true setstrokeadjust + /c + { + curveto + } def + /C + /c load def + /v + { + currentpoint 6 2 roll curveto + } def + /V + /v load def + /y + { + 2 copy curveto + } def + /Y + /y load def + /l + { + lineto + } def + /L + /l load def + /m + { + moveto + } def +} +{ + /c + { + pl curveto + } def + /C + /c load def + /v + { + currentpoint 6 2 roll pl curveto + } def + /V + /v load def + /y + { + pl 2 copy curveto + } def + /Y + /y load def + /l + { + pl lineto + } def + /L + /l load def + /m + { + pl moveto + } def +} ifelse +/d +{ + setdash +} def +/cf +{ +} def +/i +{ + dup 0 eq + { + pop cf + } if + setflat +} def +/j +{ + setlinejoin +} def +/J +{ + setlinecap +} def +/M +{ + setmiterlimit +} def +/w +{ + setlinewidth +} def +/H +{ +} def +/h +{ + closepath +} def +/N +{ + _pola 0 eq + { + _doClip 1 eq + { + clip /_doClip 0 ddef + } if + newpath + } + { + /CRender + { + N + } ddef + } ifelse +} def +/n +{ + N +} def +/F +{ + _pola 0 eq + { + _doClip 1 eq + { + gsave _pf grestore clip newpath /_lp /none ddef _fc + /_doClip 0 ddef + } + { + _pf + } ifelse + } + { + /CRender + { + F + } ddef + } ifelse +} def +/f +{ + closepath + F +} def +/S +{ + _pola 0 eq + { + _doClip 1 eq + { + gsave _ps grestore clip newpath /_lp /none ddef _sc + /_doClip 0 ddef + } + { + _ps + } ifelse + } + { + /CRender + { + S + } ddef + } ifelse +} def +/s +{ + closepath + S +} def +/B +{ + _pola 0 eq + { + _doClip 1 eq + gsave F grestore + { + gsave S grestore clip newpath /_lp /none ddef _sc + /_doClip 0 ddef + } + { + S + } ifelse + } + { + /CRender + { + B + } ddef + } ifelse +} def +/b +{ + closepath + B +} def +/W +{ + /_doClip 1 ddef +} def +/* +{ + count 0 ne + { + dup type /stringtype eq + { + pop + } if + } if + newpath +} def +/u +{ +} def +/U +{ +} def +/q +{ + _pola 0 eq + { + gsave + } if +} def +/Q +{ + _pola 0 eq + { + grestore + } if +} def +/*u +{ + _pola 1 add /_pola exch ddef +} def +/*U +{ + _pola 1 sub /_pola exch ddef + _pola 0 eq + { + CRender + } if +} def +/D +{ + pop +} def +/*w +{ +} def +/*W +{ +} def +/` +{ + /_i save ddef + clipForward? + { + nulldevice + } if + 6 1 roll 4 npop + concat pop + userdict begin + /showpage + { + } def + 0 setgray + 0 setlinecap + 1 setlinewidth + 0 setlinejoin + 10 setmiterlimit + [] 0 setdash + /setstrokeadjust where {pop false setstrokeadjust} if + newpath + 0 setgray + false setoverprint +} def +/~ +{ + end + _i restore +} def +/O +{ + 0 ne + /_of exch ddef + /_lp /none ddef +} def +/R +{ + 0 ne + /_os exch ddef + /_lp /none ddef +} def +/g +{ + /_gf exch ddef + /_fc + { + _lp /fill ne + { + _of setoverprint + _gf setgray + /_lp /fill ddef + } if + } ddef + /_pf + { + _fc + fill + } ddef + /_psf + { + _fc + ashow + } ddef + /_pjsf + { + _fc + awidthshow + } ddef + /_lp /none ddef +} def +/G +{ + /_gs exch ddef + /_sc + { + _lp /stroke ne + { + _os setoverprint + _gs setgray + /_lp /stroke ddef + } if + } ddef + /_ps + { + _sc + stroke + } ddef + /_pss + { + _sc + ss + } ddef + /_pjss + { + _sc + jss + } ddef + /_lp /none ddef +} def +/k +{ + _cf astore pop + /_fc + { + _lp /fill ne + { + _of setoverprint + _cf aload pop setcmykcolor + /_lp /fill ddef + } if + } ddef + /_pf + { + _fc + fill + } ddef + /_psf + { + _fc + ashow + } ddef + /_pjsf + { + _fc + awidthshow + } ddef + /_lp /none ddef +} def +/K +{ + _cs astore pop + /_sc + { + _lp /stroke ne + { + _os setoverprint + _cs aload pop setcmykcolor + /_lp /stroke ddef + } if + } ddef + /_ps + { + _sc + stroke + } ddef + /_pss + { + _sc + ss + } ddef + /_pjss + { + _sc + jss + } ddef + /_lp /none ddef +} def +/x +{ + /_gf exch ddef + findcmykcustomcolor + /_if exch ddef + /_fc + { + _lp /fill ne + { + _of setoverprint + _if _gf 1 exch sub setcustomcolor + /_lp /fill ddef + } if + } ddef + /_pf + { + _fc + fill + } ddef + /_psf + { + _fc + ashow + } ddef + /_pjsf + { + _fc + awidthshow + } ddef + /_lp /none ddef +} def +/X +{ + /_gs exch ddef + findcmykcustomcolor + /_is exch ddef + /_sc + { + _lp /stroke ne + { + _os setoverprint + _is _gs 1 exch sub setcustomcolor + /_lp /stroke ddef + } if + } ddef + /_ps + { + _sc + stroke + } ddef + /_pss + { + _sc + ss + } ddef + /_pjss + { + _sc + jss + } ddef + /_lp /none ddef +} def +/A +{ + pop +} def +/annotatepage +{ +userdict /annotatepage 2 copy known {get exec} {pop pop} ifelse +} def +/discard +{ + save /discardSave exch store + discardDict begin + /endString exch store + gt38? + { + 2 add + } if + load + stopped + pop + end + discardSave restore +} bind def +userdict /discardDict 7 dict dup begin +put +/pre38Initialize +{ + /endStringLength endString length store + /newBuff buffer 0 endStringLength getinterval store + /newBuffButFirst newBuff 1 endStringLength 1 sub getinterval store + /newBuffLast newBuff endStringLength 1 sub 1 getinterval store +} def +/shiftBuffer +{ + newBuff 0 newBuffButFirst putinterval + newBuffLast 0 + currentfile read not + { + stop + } if + put +} def +0 +{ + pre38Initialize + mark + currentfile newBuff readstring exch pop + { + { + newBuff endString eq + { + cleartomark stop + } if + shiftBuffer + } loop + } + { + stop + } ifelse +} def +1 +{ + pre38Initialize + /beginString exch store + mark + currentfile newBuff readstring exch pop + { + { + newBuff beginString eq + { + /layerCount dup load 1 add store + } + { + newBuff endString eq + { + /layerCount dup load 1 sub store + layerCount 0 eq + { + cleartomark stop + } if + } if + } ifelse + shiftBuffer + } loop + } + { + stop + } ifelse +} def +2 +{ + mark + { + currentfile buffer readline not + { + stop + } if + endString eq + { + cleartomark stop + } if + } loop +} def +3 +{ + /beginString exch store + /layerCnt 1 store + mark + { + currentfile buffer readline not + { + stop + } if + dup beginString eq + { + pop /layerCnt dup load 1 add store + } + { + endString eq + { + layerCnt 1 eq + { + cleartomark stop + } + { + /layerCnt dup load 1 sub store + } ifelse + } if + } ifelse + } loop +} def +end +userdict /clipRenderOff 15 dict dup begin +put +{ + /n /N /s /S /f /F /b /B +} +{ + { + _doClip 1 eq + { + /_doClip 0 ddef clip + } if + newpath + } def +} forall +/Tr /pop load def +/Bb {} def +/BB /pop load def +/Bg {12 npop} def +/Bm {6 npop} def +/Bc /Bm load def +/Bh {4 npop} def +end +/Lb +{ + 4 npop + 6 1 roll + pop + 4 1 roll + pop pop pop + 0 eq + { + 0 eq + { + (%AI5_BeginLayer) 1 (%AI5_EndLayer--) discard + } + { + /clipForward? true def + + /Tx /pop load def + /Tj /pop load def + currentdict end clipRenderOff begin begin + } ifelse + } + { + 0 eq + { + save /discardSave exch store + } if + } ifelse +} bind def +/LB +{ + discardSave dup null ne + { + restore + } + { + pop + clipForward? + { + currentdict + end + end + begin + + /clipForward? false ddef + } if + } ifelse +} bind def +/Pb +{ + pop pop + 0 (%AI5_EndPalette) discard +} bind def +/Np +{ + 0 (%AI5_End_NonPrinting--) discard +} bind def +/Ln /pop load def +/Ap +/pop load def +/Ar +{ + 72 exch div + 0 dtransform dup mul exch dup mul add sqrt + dup 1 lt + { + pop 1 + } if + setflat +} def +/Mb +{ + q +} def +/Md +{ +} def +/MB +{ + Q +} def +/nc 3 dict def +nc begin +/setgray +{ + pop +} bind def +/setcmykcolor +{ + 4 npop +} bind def +/setcustomcolor +{ + 2 npop +} bind def +currentdict readonly pop +end +currentdict readonly pop +end +setpacking +%%EndResource +%%EndProlog +%%BeginSetup +Adobe_level2_AI5 /initialize get exec +Adobe_IllustratorA_AI5 /initialize get exec +%AI5_Begin_NonPrinting +Np +%AI3_BeginPattern: (Yellow Stripe) +(Yellow Stripe) 8.4499 4.6 80.4499 76.6 [ +%AI3_Tile +(0 O 0 R 0 0.4 1 0 k 0 0.4 1 0 K) @ +( +800 Ar +0 J 0 j 3.6 w 4 M []0 d +%AI3_Note: +0 D +8.1999 8.1999 m +80.6999 8.1999 L +S +8.1999 22.6 m +80.6999 22.6 L +S +8.1999 37.0001 m +80.6999 37.0001 L +S +8.1999 51.3999 m +80.6999 51.3999 L +S +8.1999 65.8 m +80.6999 65.8 L +S +8.1999 15.3999 m +80.6999 15.3999 L +S +8.1999 29.8 m +80.6999 29.8 L +S +8.1999 44.1999 m +80.6999 44.1999 L +S +8.1999 58.6 m +80.6999 58.6 L +S +8.1999 73.0001 m +80.6999 73.0001 L +S +) & +] E +%AI3_EndPattern +%AI5_End_NonPrinting-- +%AI5_Begin_NonPrinting +Np +3 Bn +%AI5_BeginGradient: (Black & White) +(Black & White) 0 2 Bd +[ +< +FFFEFDFCFBFAF9F8F7F6F5F4F3F2F1F0EFEEEDECEBEAE9E8E7E6E5E4E3E2E1E0DFDEDDDCDBDAD9D8 +D7D6D5D4D3D2D1D0CFCECDCCCBCAC9C8C7C6C5C4C3C2C1C0BFBEBDBCBBBAB9B8B7B6B5B4B3B2B1B0 +AFAEADACABAAA9A8A7A6A5A4A3A2A1A09F9E9D9C9B9A999897969594939291908F8E8D8C8B8A8988 +87868584838281807F7E7D7C7B7A797877767574737271706F6E6D6C6B6A69686766656463626160 +5F5E5D5C5B5A595857565554535251504F4E4D4C4B4A494847464544434241403F3E3D3C3B3A3938 +37363534333231302F2E2D2C2B2A292827262524232221201F1E1D1C1B1A19181716151413121110 +0F0E0D0C0B0A09080706050403020100 +> +0 %_Br +[ +0 0 50 100 %_Bs +1 0 50 0 %_Bs +BD +%AI5_EndGradient +%AI5_BeginGradient: (Red & Yellow) +(Red & Yellow) 0 2 Bd +[ +0 +< +000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627 +28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F +505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677 +78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F +A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7 +C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF +F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF +> +< +FFFFFEFEFDFDFDFCFCFBFBFBFAFAF9F9F9F8F8F7F7F7F6F6F5F5F5F4F4F3F3F3F2F2F1F1F1F0F0EF +EFEFEEEEEDEDEDECECEBEBEBEAEAE9E9E9E8E8E7E7E7E6E6E5E5E5E4E4E3E3E3E2E2E1E1E1E0E0DF +DFDFDEDEDDDDDDDCDCDBDBDBDADAD9D9D9D8D8D7D7D7D6D6D5D5D5D4D4D3D3D3D2D2D1D1D1D0D0CF +CFCFCECECDCDCDCCCCCBCBCBCACAC9C9C9C8C8C7C7C7C6C6C5C5C5C4C4C3C3C3C2C2C1C1C1C0C0BF +BFBFBEBEBDBDBDBCBCBBBBBBBABAB9B9B9B8B8B7B7B7B6B6B5B5B5B4B4B3B3B3B2B2B1B1B1B0B0AF +AFAFAEAEADADADACACABABABAAAAA9A9A9A8A8A7A7A7A6A6A5A5A5A4A4A3A3A3A2A2A1A1A1A0A09F +9F9F9E9E9D9D9D9C9C9B9B9B9A9A9999 +> +0 +1 %_Br +[ +0 1 0.6 0 1 50 100 %_Bs +0 0 1 0 1 50 0 %_Bs +BD +%AI5_EndGradient +%AI5_BeginGradient: (Yellow & Blue Radial) +(Yellow & Blue Radial) 1 2 Bd +[ +< +000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627 +28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F +505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677 +78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F +A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7 +C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF +F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF +> +< +1415161718191A1B1C1D1E1F1F202122232425262728292A2A2B2C2D2E2F30313233343536363738 +393A3B3C3D3E3F40414142434445464748494A4B4C4D4D4E4F50515253545556575858595A5B5C5D +5E5F60616263646465666768696A6B6C6D6E6F6F707172737475767778797A7B7B7C7D7E7F808182 +83848586868788898A8B8C8D8E8F90919292939495969798999A9B9C9D9D9E9FA0A1A2A3A4A5A6A7 +A8A9A9AAABACADAEAFB0B1B2B3B4B4B5B6B7B8B9BABBBCBDBEBFC0C0C1C2C3C4C5C6C7C8C9CACBCB +CCCDCECFD0D1D2D3D4D5D6D7D7D8D9DADBDCDDDEDFE0E1E2E2E3E4E5E6E7E8E9EAEBECEDEEEEEFF0 +F1F2F3F4F5F6F7F8F9F9FAFBFCFDFEFF +> +< +ABAAAAA9A8A7A7A6A5A5A4A3A3A2A1A1A09F9F9E9D9D9C9B9B9A9999989797969595949393929191 +908F8F8E8D8D8C8B8B8A8989888787868585848383828181807F7F7E7D7D7C7B7B7A797978777776 +7575747373727171706F6F6E6D6D6C6B6B6A6969686767666565646362626160605F5E5E5D5C5C5B +5A5A5958585756565554545352525150504F4E4E4D4C4C4B4A4A4948484746464544444342424140 +403F3E3E3D3C3C3B3A3A3938383736363534343332323130302F2E2E2D2C2C2B2A2A292828272626 +25242423222121201F1F1E1D1D1C1B1B1A1919181717161515141313121111100F0F0E0D0D0C0B0B +0A090908070706050504030302010100 +> +0 +1 %_Br +[ +0 0.08 0.67 0 1 50 14 %_Bs +1 1 0 0 1 50 100 %_Bs +BD +%AI5_EndGradient +%AI5_End_NonPrinting-- +%AI5_BeginPalette +144 161 Pb +Pn +Pc +1 g +Pc +0 g +Pc +0 0 0 0 k +Pc +0.75 g +Pc +0.5 g +Pc +0.25 g +Pc +0 g +Pc +Bb +2 (Black & White) -4014 4716 0 0 1 0 0 1 0 0 Bg +0 BB +Pc +0.25 0 0 0 k +Pc +0.5 0 0 0 k +Pc +0.75 0 0 0 k +Pc +1 0 0 0 k +Pc +0.25 0.25 0 0 k +Pc +0.5 0.5 0 0 k +Pc +0.75 0.75 0 0 k +Pc +1 1 0 0 k +Pc +Bb +2 (Red & Yellow) -4014 4716 0 0 1 0 0 1 0 0 Bg +0 BB +Pc +0 0.25 0 0 k +Pc +0 0.5 0 0 k +Pc +0 0.75 0 0 k +Pc +0 1 0 0 k +Pc +0 0.25 0.25 0 k +Pc +0 0.5 0.5 0 k +Pc +0 0.75 0.75 0 k +Pc +0 1 1 0 k +Pc +Bb +0 0 0 0 Bh +2 (Yellow & Blue Radial) -4014 4716 0 0 1 0 0 1 0 0 Bg +0 BB +Pc +0 0 0.25 0 k +Pc +0 0 0.5 0 k +Pc +0 0 0.75 0 k +Pc +0 0 1 0 k +Pc +0.25 0 0.25 0 k +Pc +0.5 0 0.5 0 k +Pc +0.75 0 0.75 0 k +Pc +1 0 1 0 k +Pc +(Yellow Stripe) 0 0 1 1 0 0 0 0 0 [1 0 0 1 0 0] p +Pc +0.25 0.125 0 0 k +Pc +0.5 0.25 0 0 k +Pc +0.75 0.375 0 0 k +Pc +1 0.5 0 0 k +Pc +0.125 0.25 0 0 k +Pc +0.25 0.5 0 0 k +Pc +0.375 0.75 0 0 k +Pc +0.5 1 0 0 k +Pc +0.375 0.375 0.75 0 k +Pc +0 0.25 0.125 0 k +Pc +0 0.5 0.25 0 k +Pc +0 0.75 0.375 0 k +Pc +0 1 0.5 0 k +Pc +0 0.125 0.25 0 k +Pc +0 0.25 0.5 0 k +Pc +0 0.375 0.75 0 k +Pc +0 0.5 1 0 k +Pc +0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x +Pc +0.125 0 0.25 0 k +Pc +0.25 0 0.5 0 k +Pc +0.375 0 0.75 0 k +Pc +0.5 0 1 0 k +Pc +0.25 0 0.125 0 k +Pc +0.5 0 0.25 0 k +Pc +0.75 0 0.375 0 k +Pc +1 0 0.5 0 k +Pc +0.5 1 0 0 k +Pc +0.25 0.125 0.125 0 k +Pc +0.5 0.25 0.25 0 k +Pc +0.75 0.375 0.375 0 k +Pc +1 0.5 0.5 0 k +Pc +0.25 0.25 0.125 0 k +Pc +0.5 0.5 0.25 0 k +Pc +0.75 0.75 0.375 0 k +Pc +1 1 0.5 0 k +Pc +0 1 0.5 0 k +Pc +0.125 0.25 0.125 0 k +Pc +0.25 0.5 0.25 0 k +Pc +0.375 0.75 0.375 0 k +Pc +0.5 1 0.5 0 k +Pc +0.125 0.25 0.25 0 k +Pc +0.25 0.5 0.5 0 k +Pc +0.375 0.75 0.75 0 k +Pc +0.5 1 1 0 k +Pc +0.75 0.75 0.375 0 k +Pc +0.125 0.125 0.25 0 k +Pc +0.25 0.25 0.5 0 k +Pc +0.375 0.375 0.75 0 k +Pc +0.5 0.5 1 0 k +Pc +0.25 0.125 0.25 0 k +Pc +0.5 0.25 0.5 0 k +Pc +0.75 0.375 0.75 0 k +Pc +1 0.5 1 0 k +Pc +0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +1 0.5 0.5 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0.25 1 0 (Orange Yellow) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 1 0.5 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +1 0 0.5 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0.45 1 0 (Orange) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0.375 0.375 0.75 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +1 0.65 0 0 k +Pc +0 0 0 0 k +Pc +Pc +Pc +Pc +Pc +Pc +Pc +Pc +0 0 1 0 k +Pc +PB +%AI5_EndPalette +%%EndSetup +%AI5_BeginLayer +1 1 1 1 0 0 0 79 128 255 Lb +(Layer 1) Ln +0 A +1 Ap +0 O +1 0.65 0 0 k +800 Ar +0 J 0 j 1 w 4 M []0 d +%AI3_Note: +0 D +285.0121 311.7976 m +357.5043 302.5199 L +361.6071 392.7105 L +376.3322 474.1377 L +342.6527 475.6628 L +327.6333 483.4165 L +258.8269 486.3189 L +254.4361 405.0427 L +242.0523 312.2099 L +285.0121 311.7976 L +f +0 0.79 0.91 0 k +1.25 w +295.4466 337.6172 m +368.4943 335.3343 L +363.9288 425.5026 L +370.7771 507.9667 L +337.1066 506.2547 L +321.4128 512.5323 L +252.6452 508.8228 L +256.0692 427.5002 L +252.6452 333.9077 L +295.4466 337.6172 L +f +u +0 Ap +1 0.65 0 0 k +1 w +320.532 390.6149 m +312.9017 388.534 l +317.0637 398.5921 l +321.2256 426.6854 l +316.0232 427.7258 l +322.2662 436.3965 l +330.0436 465.6249 l +316.3701 462.7557 l +323.5798 475.9563 331.2311 484.5534 v +321.2256 492.2363 l +288.9913 478.0373 297.6622 431.9088 v +290.9988 433.0755 l +297.3888 384.7188 l +291.9867 383.3315 l +297.5214 372.0383 305.2714 366.6837 v +305.9749 366.1976 295.5601 404.4882 306.6587 442.6395 c +307.6992 440.2117 l +298.855 399.5459 307.6992 366.6837 v +308.1064 365.9033 312.5286 366.4235 v +320.532 381.5106 320.532 390.6149 v +f +u +*u +1 g +263.6948 355.9856 m +265.2612 355.9856 L +265.2612 359.2513 L +265.9515 359.2513 266.6153 359.2513 267.2791 359.3575 c +267.2791 355.9856 L +269.6155 355.9856 L +269.6155 355.3749 L +267.2791 355.3749 L +267.2791 347.2505 L +267.2791 346.7726 267.2791 346.0558 268.288 346.0558 c +268.9783 346.0558 269.35 346.5337 269.7748 347.0381 c +270.1996 346.7461 L +269.6951 345.7372 268.3942 345.1265 267.3322 345.1265 c +265.4205 345.1265 265.2081 346.162 265.2081 347.4364 c +265.2081 355.3749 L +263.6948 355.3749 L +263.6948 355.9856 l +f +*U +*u +285.7796 348.7639 m +285.1689 346.8788 284.1069 345.2327 281.3457 345.1265 c +277.2304 345.1265 275.9825 348.5515 275.9825 350.3835 c +275.9825 355.1094 279.7792 356.2511 281.2926 356.2511 c +283.0184 356.2511 285.461 355.4546 285.461 353.4102 c +285.461 352.6934 285.0096 352.003 284.2662 352.003 c +283.5494 352.003 283.0184 352.481 283.0184 353.2509 c +283.0184 354.2864 283.868 354.4191 283.868 354.7112 c +283.868 355.428 282.1953 355.7201 281.6112 355.7201 c +279.0624 355.7201 278.3986 353.8616 278.3986 350.3835 c +278.3986 348.7905 278.7969 347.5691 278.9562 347.1974 c +279.3544 346.3213 280.1775 345.7637 281.5581 345.6841 c +283.098 345.6044 284.5848 346.8523 285.222 348.7639 C +285.7796 348.7639 l +f +*U +*u +291.9344 345.4717 m +291.9344 346.0823 L +293.9788 346.0823 L +293.9788 363.1542 L +291.9344 363.1542 L +291.9344 363.7648 L +293.0761 363.7648 L +294.0585 363.7648 295.0939 363.8179 296.0497 364.0038 c +296.0497 346.0823 L +298.0941 346.0823 L +298.0941 345.4717 L +291.9344 345.4717 l +f +*U +u +310.0634 446.075 m +305.3828 425.2059 306.7298 391.3708 v +307.1338 381.222 308.2436 371.8929 309.5993 363.8029 C +309.6066 363.8025 L +310.4883 356.6987 311.0781 354.1272 313.3768 345.5676 C +313.2426 340.0473 L +294.8367 398.8155 310.0634 446.075 V +f +321.3622 464.1699 m +325.5016 466.2317 331.4359 466.9819 v +337.9224 455.0924 321.9584 434.793 v +331.4821 456.0522 329.2358 462.7122 v +326.7243 464.2727 321.3622 464.1699 v +f +319.4002 428.4819 m +323.1177 427.6214 324.9024 429.0668 v +321.386 415.3445 322.3077 407.7964 v +323.2297 400.2483 316.5788 395.4159 y +322.2441 402.584 320.4635 408.4226 v +319.2289 412.4694 320.6101 422.8271 322.1681 426.1155 c +320.7131 426.3196 319.4002 428.4819 v +f +315.7246 392.3281 m +321.8677 393.0631 322.5131 396.1662 v +323.265 377.6058 314.7299 369.9571 v +321.2425 380.1152 320.2206 390.6235 v +315.7246 392.3281 l +f +298.4445 384.6023 m +296.4635 382.3836 290.5192 387.2778 v +292.4131 374.803 304.1781 369.0924 v +296.0814 375.1928 293.9 381.7824 v +296.7611 382.6245 298.4445 384.6023 v +f +296.5483 389.3335 m +288.5102 409.7356 290.2325 437.3036 v +292.1098 432.3112 298.1424 430.5604 v +295.3003 429.9794 293.6387 430.2313 v +289.4335 418.5932 296.5483 389.3335 v +f +330.3126 484.1353 m +327.3003 506.2722 308.4549 483.8853 v +293.4491 466.0592 295.2373 450.9247 296.1578 442.4811 c +296.3932 440.3206 293.366 465.0316 309.8067 481.2933 c +326.2471 497.5553 329.9609 485.0794 330.3126 484.1353 c +f +U +0 0 1 0 k +302.5528 503.0164 m +287.7656 507.2395 283.0593 458.227 v +279.4282 473.3549 288.8204 494.7509 v +298.2122 516.1468 302.5528 503.0164 y +f +284.2076 506.5994 m +276.6655 495.2557 278.3767 483.1729 v +272.6565 505.9183 284.2076 506.5994 v +f +339.7135 474.7902 m +348.6321 478.0799 335.8615 444.8834 v +342.4718 454.5848 346.6326 469.8253 v +349.303 479.6062 339.7135 474.7902 y +f +354.1382 477.3767 m +360.4435 471.669 355.9752 464.1187 v +367.1908 475.904 354.1382 477.3767 v +f +U +U +*u +1 g +258.2029 317.4593 m +256.6821 317.4593 L +256.6821 325.2598 L +258.7512 325.2598 L +260.3858 325.2598 261.4514 324.608 261.4514 322.839 c +261.4514 321.1837 260.5513 320.3767 258.9581 320.3767 c +258.2029 320.3767 L +258.2029 317.4593 l +f +1 D +258.2029 321.6389 m +258.5132 321.6389 L +259.4133 321.6389 259.8995 321.8354 259.8995 322.8493 c +259.8995 323.8528 259.3202 323.9976 258.4719 323.9976 c +258.2029 323.9976 L +258.2029 321.6389 l +f +*U +*u +0 D +269.0694 321.3699 m +269.0694 323.5528 270.6523 325.4667 272.9283 325.4667 c +275.2043 325.4667 276.7871 323.5528 276.7871 321.3699 c +276.7871 319.1353 275.2043 317.2524 272.9283 317.2524 c +270.6523 317.2524 269.0694 319.1353 269.0694 321.3699 c +f +1 D +270.6419 321.432 m +270.6419 320.2526 271.6351 318.7525 272.9283 318.7525 c +274.2215 318.7525 275.2146 320.2526 275.2146 321.432 c +275.2146 322.6941 274.2628 323.9666 272.9283 323.9666 c +271.5937 323.9666 270.6419 322.6941 270.6419 321.432 c +f +*U +*u +0 D +287.2943 319.9422 m +287.315 319.9422 L +288.8668 325.3632 L +289.7668 325.3632 L +291.3807 319.9422 L +291.4014 319.9422 L +292.9326 325.2598 L +294.5258 325.2598 L +291.8877 317.3041 L +290.7704 317.3041 L +289.2185 322.4044 L +289.1978 322.4044 L +287.7288 317.3041 L +286.6115 317.3041 L +284.1286 325.2598 L +285.7218 325.2598 L +287.2943 319.9422 l +f +*U +*u +303.7595 323.9356 m +303.7595 322.2182 L +306.1803 322.2182 L +306.1803 320.894 L +303.7595 320.894 L +303.7595 318.7835 L +306.2734 318.7835 L +306.2734 317.4593 L +302.2387 317.4593 L +302.2387 325.2598 L +306.2734 325.2598 L +306.2734 323.9356 L +303.7595 323.9356 l +f +*U +*u +319.8602 317.4593 m +318.0187 317.4593 L +316.1255 320.6043 L +316.1048 320.6043 L +316.1048 317.4593 L +314.5841 317.4593 L +314.5841 325.2598 L +316.6428 325.2598 L +318.1843 325.2598 319.2499 324.577 319.2499 322.9114 c +319.2499 321.9182 318.7015 320.925 317.6567 320.7492 C +319.8602 317.4593 l +f +1 D +316.1048 321.6699 m +316.3014 321.6699 L +317.1394 321.6699 317.7291 321.9182 317.7291 322.87 c +317.7291 323.8321 317.1187 324.0183 316.3117 324.0183 c +316.1048 324.0183 L +316.1048 321.6699 l +f +*U +*u +0 D +329.1754 323.9356 m +329.1754 322.2182 L +331.5962 322.2182 L +331.5962 320.894 L +329.1754 320.894 L +329.1754 318.7835 L +331.6894 318.7835 L +331.6894 317.4593 L +327.6546 317.4593 L +327.6546 325.2598 L +331.6894 325.2598 L +331.6894 323.9356 L +329.1754 323.9356 l +f +*U +*u +340 325.2598 m +342.1725 325.2598 L +344.4279 325.2598 345.9383 323.5735 345.9383 321.3492 c +345.9383 319.156 344.3865 317.4593 342.1622 317.4593 c +340 317.4593 L +340 325.2598 l +f +1 D +341.5208 318.7835 m +341.7691 318.7835 L +343.6416 318.7835 344.3658 319.8181 344.3658 321.3596 c +344.3658 323.0562 343.4968 323.9356 341.7691 323.9356 c +341.5208 323.9356 L +341.5208 318.7835 l +f +*U +LB +%AI5_EndLayer-- +%%PageTrailer +gsave annotatepage grestore showpage +%%Trailer +Adobe_IllustratorA_AI5 /terminate get exec +Adobe_level2_AI5 /terminate get exec +%%EOF diff --git a/library/images/pwrdLogo100.gif b/library/images/pwrdLogo100.gif Binary files differindex 42c5b30..eea4fba 100644 --- a/library/images/pwrdLogo100.gif +++ b/library/images/pwrdLogo100.gif diff --git a/library/images/pwrdLogo150.gif b/library/images/pwrdLogo150.gif Binary files differindex e2e6b7a..bf62548 100644 --- a/library/images/pwrdLogo150.gif +++ b/library/images/pwrdLogo150.gif diff --git a/library/images/pwrdLogo175.gif b/library/images/pwrdLogo175.gif Binary files differindex 67d9536..7733fdd 100644 --- a/library/images/pwrdLogo175.gif +++ b/library/images/pwrdLogo175.gif diff --git a/library/images/pwrdLogo200.gif b/library/images/pwrdLogo200.gif Binary files differindex 6bff472..965cb4b 100644 --- a/library/images/pwrdLogo200.gif +++ b/library/images/pwrdLogo200.gif diff --git a/library/images/pwrdLogo75.gif b/library/images/pwrdLogo75.gif Binary files differindex 1c6b11a..3a2b16e 100644 --- a/library/images/pwrdLogo75.gif +++ b/library/images/pwrdLogo75.gif diff --git a/library/images/tai-ku.gif b/library/images/tai-ku.gif Binary files differnew file mode 100644 index 0000000..a5aea47 --- /dev/null +++ b/library/images/tai-ku.gif diff --git a/library/listbox.tcl b/library/listbox.tcl index 45f0b9b..f77ecb3 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk listbox widgets # and provides procedures that help in implementing those bindings. # -# RCS: @(#) $Id: listbox.tcl,v 1.4 1998/10/10 00:30:36 rjohnson Exp $ +# RCS: @(#) $Id: listbox.tcl,v 1.5 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. @@ -120,6 +120,7 @@ bind Listbox <Control-Home> { %W see 0 %W selection clear 0 end %W selection set 0 + event generate %W <<ListboxSelect>> } bind Listbox <Shift-Control-Home> { tkListboxDataExtend %W 0 @@ -129,12 +130,13 @@ bind Listbox <Control-End> { %W see end %W selection clear 0 end %W selection set end + event generate %W <<ListboxSelect>> } bind Listbox <Shift-Control-End> { tkListboxDataExtend %W [%W index end] } bind Listbox <<Copy>> { - if {[selection own -displayof %W] == "%W"} { + if {![string compare [selection own -displayof %W] "%W"]} { clipboard clear -displayof %W clipboard append -displayof %W [selection get -displayof %W] } @@ -158,8 +160,9 @@ bind Listbox <Control-slash> { tkListboxSelectAll %W } bind Listbox <Control-backslash> { - if {[%W cget -selectmode] != "browse"} { + if {[string compare [%W cget -selectmode] "browse"]} { %W selection clear 0 end + event generate %W <<ListboxSelect>> } } @@ -177,7 +180,7 @@ bind Listbox <B2-Motion> { # on other platforms. bind Listbox <MouseWheel> { - %W yview scroll [expr - (%D / 120) * 4] units + %W yview scroll [expr {- (%D / 120) * 4}] units } # tkListboxBeginSelect -- @@ -194,7 +197,7 @@ bind Listbox <MouseWheel> { proc tkListboxBeginSelect {w el} { global tkPriv - if {[$w cget -selectmode] == "multiple"} { + if {![string compare [$w cget -selectmode] "multiple"]} { if {[$w selection includes $el]} { $w selection clear $el } else { @@ -207,6 +210,7 @@ proc tkListboxBeginSelect {w el} { set tkPriv(listboxSelection) {} set tkPriv(listboxPrev) $el } + event generate $w <<ListboxSelect>> } # tkListboxMotion -- @@ -230,6 +234,7 @@ proc tkListboxMotion {w el} { $w selection clear 0 end $w selection set $el set tkPriv(listboxPrev) $el + event generate $w <<ListboxSelect>> } extended { set i $tkPriv(listboxPrev) @@ -253,6 +258,7 @@ proc tkListboxMotion {w el} { incr i -1 } set tkPriv(listboxPrev) $el + event generate $w <<ListboxSelect>> } } } @@ -270,12 +276,11 @@ proc tkListboxMotion {w el} { # one under the pointer). Must be in numerical form. proc tkListboxBeginExtend {w el} { - if {[$w cget -selectmode] == "extended"} { + if {![string compare [$w cget -selectmode] "extended"]} { if {[$w selection includes anchor]} { tkListboxMotion $w $el } else { # No selection yet; simulate the begin-select operation. - tkListboxBeginSelect $w $el } } @@ -295,7 +300,7 @@ proc tkListboxBeginExtend {w el} { proc tkListboxBeginToggle {w el} { global tkPriv - if {[$w cget -selectmode] == "extended"} { + if {![string compare [$w cget -selectmode] "extended"]} { set tkPriv(listboxSelection) [$w curselection] set tkPriv(listboxPrev) $el $w selection anchor $el @@ -304,6 +309,7 @@ proc tkListboxBeginToggle {w el} { } else { $w selection set $el } + event generate $w <<ListboxSelect>> } } @@ -355,6 +361,7 @@ proc tkListboxUpDown {w amount} { browse { $w selection clear 0 end $w selection set active + event generate $w <<ListboxSelect>> } extended { $w selection clear 0 end @@ -362,6 +369,7 @@ proc tkListboxUpDown {w amount} { $w selection anchor active set tkPriv(listboxPrev) [$w index active] set tkPriv(listboxSelection) {} + event generate $w <<ListboxSelect>> } } } @@ -377,7 +385,7 @@ proc tkListboxUpDown {w amount} { # amount - +1 to move down one item, -1 to move back one item. proc tkListboxExtendUpDown {w amount} { - if {[$w cget -selectmode] != "extended"} { + if {[string compare [$w cget -selectmode] "extended"]} { return } $w activate [expr {[$w index active] + $amount}] @@ -398,13 +406,13 @@ proc tkListboxExtendUpDown {w amount} { proc tkListboxDataExtend {w el} { set mode [$w cget -selectmode] - if {$mode == "extended"} { + if {![string compare $mode "extended"]} { $w activate $el $w see $el if {[$w selection includes anchor]} { tkListboxMotion $w $el } - } elseif {$mode == "multiple"} { + } elseif {![string compare $mode "multiple"]} { $w activate $el $w see $el } @@ -422,7 +430,7 @@ proc tkListboxDataExtend {w el} { proc tkListboxCancel w { global tkPriv - if {[$w cget -selectmode] != "extended"} { + if {[string compare [$w cget -selectmode] "extended"]} { return } set first [$w index anchor] @@ -439,6 +447,7 @@ proc tkListboxCancel w { } incr first } + event generate $w <<ListboxSelect>> } # tkListboxSelectAll @@ -452,10 +461,11 @@ proc tkListboxCancel w { proc tkListboxSelectAll w { set mode [$w cget -selectmode] - if {($mode == "single") || ($mode == "browse")} { + if {![string compare $mode "single"] || ![string compare $mode "browse"]} { $w selection clear 0 end $w selection set active } else { $w selection set 0 end } + event generate $w <<ListboxSelect>> } diff --git a/library/menu.tcl b/library/menu.tcl index ce483ca..538e330 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -4,10 +4,11 @@ # It also implements keyboard traversal of menus and implements a few # other utility procedures related to menus. # -# RCS: @(#) $Id: menu.tcl,v 1.4 1999/02/04 20:58:40 stanton Exp $ +# RCS: @(#) $Id: menu.tcl,v 1.5 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -89,7 +90,7 @@ bind Menubutton <Leave> { tkMbLeave %W } bind Menubutton <1> { - if {$tkPriv(inMenubutton) != ""} { + if {[string compare $tkPriv(inMenubutton) ""]} { tkMbPost $tkPriv(inMenubutton) %X %Y } } @@ -118,9 +119,9 @@ bind Menu <FocusIn> {} bind Menu <Enter> { set tkPriv(window) %W - if {[%W cget -type] == "tearoff"} { - if {"%m" != "NotifyUngrab"} { - if {$tcl_platform(platform) == "unix"} { + if {![string compare [%W cget -type] "tearoff"]} { + if {[string compare "%m" "NotifyUngrab"]} { + if {![string compare $tcl_platform(platform) "unix"]} { tk_menuSetFocus %W } } @@ -168,7 +169,7 @@ bind Menu <KeyPress> { # The following bindings apply to all windows, and are used to # implement keyboard menu traversal. -if {$tcl_platform(platform) == "unix"} { +if {![string compare $tcl_platform(platform) "unix"]} { bind all <Alt-KeyPress> { tkTraverseToMenu %W %A } @@ -198,11 +199,11 @@ if {$tcl_platform(platform) == "unix"} { proc tkMbEnter w { global tkPriv - if {$tkPriv(inMenubutton) != ""} { + if {[string compare $tkPriv(inMenubutton) ""]} { tkMbLeave $tkPriv(inMenubutton) } set tkPriv(inMenubutton) $w - if {[$w cget -state] != "disabled"} { + if {[string compare [$w cget -state] "disabled"]} { $w configure -state active } } @@ -221,7 +222,7 @@ proc tkMbLeave w { if {![winfo exists $w]} { return } - if {[$w cget -state] == "active"} { + if {![string compare [$w cget -state] "active"]} { $w configure -state normal } } @@ -242,20 +243,21 @@ proc tkMbPost {w {x {}} {y {}}} { global tkPriv errorInfo global tcl_platform - if {([$w cget -state] == "disabled") || ($w == $tkPriv(postedMb))} { + if {![string compare [$w cget -state] "disabled"] || + ![string compare $w $tkPriv(postedMb)]} { return } set menu [$w cget -menu] - if {$menu == ""} { + if {![string compare $menu ""]} { return } - set tearoff [expr {($tcl_platform(platform) == "unix") \ - || ([$menu cget -type] == "tearoff")}] + set tearoff [expr {![string compare $tcl_platform(platform) "unix"] \ + || ![string compare [$menu cget -type] "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)" } set cur $tkPriv(postedMb) - if {$cur != ""} { + if {[string compare $cur ""]} { tkMenuUnpost {} } set tkPriv(cursor) [$w cget -cursor] @@ -299,7 +301,7 @@ proc tkMbPost {w {x {}} {y {}}} { } } $menu post $x $y - if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} { + if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} { $menu activate $entry tkGenerateMenuSelect $menu } @@ -318,14 +320,14 @@ proc tkMbPost {w {x {}} {y {}}} { } } $menu post $x $y - if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} { + if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} { $menu activate $entry tkGenerateMenuSelect $menu } } default { if {[$w cget -indicatoron]} { - if {$y == ""} { + if {![string compare $y {}]} { set x [expr {[winfo rootx $w] + [winfo width $w]/2}] set y [expr {[winfo rooty $w] + [winfo height $w]/2}] } @@ -385,17 +387,17 @@ proc tkMenuUnpost menu { # what was posted. catch { - if {$mb != ""} { + if {[string compare $mb ""]} { set menu [$mb cget -menu] $menu unpost set tkPriv(postedMb) {} $mb configure -cursor $tkPriv(cursor) $mb configure -relief $tkPriv(relief) - } elseif {$tkPriv(popup) != ""} { + } elseif {[string compare $tkPriv(popup) ""]} { $tkPriv(popup) unpost set tkPriv(popup) {} - } elseif {(!([$menu cget -type] == "menubar") - && !([$menu cget -type] == "tearoff"))} { + } elseif {[string compare [$menu cget -type] "menubar"] + && [string compare [$menu cget -type] "tearoff"]} { # We're in a cascaded sub-menu from a torn-off menu or popup. # Unpost all the menus up to the toplevel one (but not # including the top-level torn-off one) and deactivate the @@ -403,7 +405,7 @@ proc tkMenuUnpost menu { while 1 { set parent [winfo parent $menu] - if {([winfo class $parent] != "Menu") + if {[string compare [winfo class $parent] "Menu"] || ![winfo ismapped $parent]} { break } @@ -411,33 +413,33 @@ proc tkMenuUnpost menu { $parent postcascade none tkGenerateMenuSelect $parent set type [$parent cget -type] - if {($type == "menubar")|| ($type == "tearoff")} { + if {![string compare $type "menubar"] || + ![string compare $type "tearoff"]} { break } set menu $parent } - if {[$menu cget -type] != "menubar"} { + if {[string compare [$menu cget -type] "menubar"]} { $menu unpost } } } - if {($tkPriv(tearoff) != 0) || ($tkPriv(menuBar) != "")} { + if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} { # Release grab, if any, and restore the previous grab, if there # was one. - - if {$menu != ""} { + if {[string compare $menu ""]} { set grab [grab current $menu] - if {$grab != ""} { + if {[string compare $grab ""]} { grab release $grab } } tkRestoreOldGrab - if {$tkPriv(menuBar) != ""} { + if {[string compare $tkPriv(menuBar) ""]} { $tkPriv(menuBar) configure -cursor $tkPriv(cursor) set tkPriv(menuBar) {} } - if {$tcl_platform(platform) != "unix"} { + if {[string compare $tcl_platform(platform) "unix"]} { set tkPriv(tearoff) 0 } } @@ -457,19 +459,21 @@ proc tkMenuUnpost menu { proc tkMbMotion {w upDown rootx rooty} { global tkPriv - if {$tkPriv(inMenubutton) == $w} { + if {![string compare $tkPriv(inMenubutton) $w]} { return } set new [winfo containing $rootx $rooty] - if {($new != $tkPriv(inMenubutton)) && (($new == "") - || ([winfo toplevel $new] == [winfo toplevel $w]))} { - if {$tkPriv(inMenubutton) != ""} { + if {[string compare $new $tkPriv(inMenubutton)] + && (![string compare $new ""] + || ![string compare [winfo toplevel $new] [winfo toplevel $w]])} { + if {[string compare $tkPriv(inMenubutton) ""]} { tkMbLeave $tkPriv(inMenubutton) } - if {($new != "") && ([winfo class $new] == "Menubutton") + if {[string compare $new ""] + && ![string compare [winfo class $new] "Menubutton"] && ([$new cget -indicatoron] == 0) && ([$w cget -indicatoron] == 0)} { - if {$upDown == "down"} { + if {![string compare $upDown "down"]} { tkMbPost $new $rootx $rooty } else { tkMbEnter $new @@ -490,8 +494,9 @@ proc tkMbButtonUp w { global tkPriv global tcl_platform + set menu [$w cget -menu] set tearoff [expr {($tcl_platform(platform) == "unix") \ - || ([[$w cget -menu] cget -type] == "tearoff")}] + || (($menu != {}) && ([$menu cget -type] == "tearoff"))}] if {($tearoff != 0) && ($tkPriv(postedMb) == $w) && ($tkPriv(inMenubutton) == $w)} { tkMenuFirstEntry [$tkPriv(postedMb) cget -menu] @@ -515,10 +520,10 @@ proc tkMbButtonUp w { proc tkMenuMotion {menu x y state} { global tkPriv - if {$menu == $tkPriv(window)} { - if {[$menu cget -type] == "menubar"} { + if {![string compare $menu $tkPriv(window)]} { + if {![string compare [$menu cget -type] "menubar"]} { if {[info exists tkPriv(focus)] && \ - ([string compare $menu $tkPriv(focus)] != 0)} { + [string compare $menu $tkPriv(focus)]} { $menu activate @$x,$y tkGenerateMenuSelect $menu } @@ -551,16 +556,16 @@ proc tkMenuButtonDown menu { global tkPriv global tcl_platform $menu postcascade active - if {$tkPriv(postedMb) != ""} { + if {[string compare $tkPriv(postedMb) ""]} { grab -global $tkPriv(postedMb) } else { - while {([$menu cget -type] == "normal") - && ([winfo class [winfo parent $menu]] == "Menu") + while {![string compare [$menu cget -type] "normal"] + && ![string compare [winfo class [winfo parent $menu]] "Menu"] && [winfo ismapped [winfo parent $menu]]} { set menu [winfo parent $menu] } - if {$tkPriv(menuBar) == {}} { + if {![string compare $tkPriv(menuBar) {}]} { set tkPriv(menuBar) $menu set tkPriv(cursor) [$menu cget -cursor] $menu configure -cursor arrow @@ -571,14 +576,14 @@ proc tkMenuButtonDown menu { # restore the grab, since the old grab window will not be viewable # anymore. - if {$menu != [grab current $menu]} { + if {[string compare $menu [grab current $menu]]} { tkSaveGrabInfo $menu } # Must re-grab even if the grab window hasn't changed, in order # to release the implicit grab from the button press. - if {$tcl_platform(platform) == "unix"} { + if {![string compare $tcl_platform(platform) "unix"]} { grab -global $menu } } @@ -597,12 +602,12 @@ proc tkMenuButtonDown menu { proc tkMenuLeave {menu rootx rooty state} { global tkPriv set tkPriv(window) {} - if {[$menu index active] == "none"} { + if {![string compare [$menu index active] "none"]} { return } - if {([$menu type active] == "cascade") - && ([winfo containing $rootx $rooty] - == [$menu entrycget active -menu])} { + if {![string compare [$menu type active] "cascade"] + && ![string compare [winfo containing $rootx $rooty] \ + [$menu entrycget active -menu]]} { return } $menu activate none @@ -622,7 +627,7 @@ proc tkMenuLeave {menu rootx rooty state} { proc tkMenuInvoke {w buttonRelease} { global tkPriv - if {$buttonRelease && ($tkPriv(window) == "")} { + if {$buttonRelease && ![string compare $tkPriv(window) {}]} { # Mouse was pressed over a menu without a menu button, then # dragged off the menu (possibly with a cascade posted) and # released. Unpost everything and quit. @@ -633,14 +638,14 @@ proc tkMenuInvoke {w buttonRelease} { tkMenuUnpost $w return } - if {[$w type active] == "cascade"} { + if {![string compare [$w type active] "cascade"]} { $w postcascade active set menu [$w entrycget active -menu] tkMenuFirstEntry $menu - } elseif {[$w type active] == "tearoff"} { + } elseif {![string compare [$w type active] "tearoff"]} { tkMenuUnpost $w tkTearOffMenu $w - } elseif {[$w cget -type] == "menubar"} { + } elseif {![string compare [$w cget -type] "menubar"]} { $w postcascade none $w activate none event generate $w <<MenuSelect>> @@ -661,9 +666,9 @@ proc tkMenuInvoke {w buttonRelease} { proc tkMenuEscape menu { set parent [winfo parent $menu] - if {([winfo class $parent] != "Menu")} { + if {[string compare [winfo class $parent] "Menu"]} { tkMenuUnpost $menu - } elseif {([$parent cget -type] == "menubar")} { + } elseif {![string compare [$parent cget -type] "menubar"]} { tkMenuUnpost $menu tkRestoreOldGrab } else { @@ -675,7 +680,7 @@ proc tkMenuEscape menu { # differently depending on whether the menu is a menu bar or not. proc tkMenuUpArrow {menu} { - if {[$menu cget -type] == "menubar"} { + if {![string compare [$menu cget -type] "menubar"]} { tkMenuNextMenu $menu left } else { tkMenuNextEntry $menu -1 @@ -683,7 +688,7 @@ proc tkMenuUpArrow {menu} { } proc tkMenuDownArrow {menu} { - if {[$menu cget -type] == "menubar"} { + if {![string compare [$menu cget -type] "menubar"]} { tkMenuNextMenu $menu right } else { tkMenuNextEntry $menu 1 @@ -691,7 +696,7 @@ proc tkMenuDownArrow {menu} { } proc tkMenuLeftArrow {menu} { - if {[$menu cget -type] == "menubar"} { + if {![string compare [$menu cget -type] "menubar"]} { tkMenuNextEntry $menu -1 } else { tkMenuNextMenu $menu left @@ -699,7 +704,7 @@ proc tkMenuLeftArrow {menu} { } proc tkMenuRightArrow {menu} { - if {[$menu cget -type] == "menubar"} { + if {![string compare [$menu cget -type] "menubar"]} { tkMenuNextEntry $menu 1 } else { tkMenuNextMenu $menu right @@ -721,22 +726,22 @@ proc tkMenuNextMenu {menu direction} { # First handle traversals into and out of cascaded menus. - if {$direction == "right"} { + if {![string compare $direction "right"]} { set count 1 set parent [winfo parent $menu] set class [winfo class $parent] - if {[$menu type active] == "cascade"} { + if {![string compare [$menu type active] "cascade"]} { $menu postcascade active set m2 [$menu entrycget active -menu] - if {$m2 != ""} { + if {[string compare $m2 ""]} { tkMenuFirstEntry $m2 } return } else { set parent [winfo parent $menu] - while {($parent != ".")} { - if {([winfo class $parent] == "Menu") - && ([$parent cget -type] == "menubar")} { + while {[string compare $parent "."]} { + if {![string compare [winfo class $parent] "Menu"] + && ![string compare [$parent cget -type] "menubar"]} { tk_menuSetFocus $parent tkMenuNextEntry $parent 1 return @@ -747,8 +752,8 @@ proc tkMenuNextMenu {menu direction} { } else { set count -1 set m2 [winfo parent $menu] - if {[winfo class $m2] == "Menu"} { - if {[$m2 cget -type] != "menubar"} { + if {![string compare [winfo class $m2] "Menu"]} { + if {[string compare [$m2 cget -type] "menubar"]} { $menu activate none tkGenerateMenuSelect $menu tk_menuSetFocus $m2 @@ -767,8 +772,8 @@ proc tkMenuNextMenu {menu direction} { # or previous menubutton, if that makes sense. set m2 [winfo parent $menu] - if {[winfo class $m2] == "Menu"} { - if {[$m2 cget -type] == "menubar"} { + if {![string compare [winfo class $m2] "Menu"]} { + if {![string compare [$m2 cget -type] "menubar"]} { tk_menuSetFocus $m2 tkMenuNextEntry $m2 -1 return @@ -776,7 +781,7 @@ proc tkMenuNextMenu {menu direction} { } set w $tkPriv(postedMb) - if {$w == ""} { + if {![string compare $w ""]} { return } set buttons [winfo children [winfo parent $w]] @@ -790,13 +795,13 @@ proc tkMenuNextMenu {menu direction} { incr i -$length } set mb [lindex $buttons $i] - if {([winfo class $mb] == "Menubutton") - && ([$mb cget -state] != "disabled") - && ([$mb cget -menu] != "") - && ([[$mb cget -menu] index last] != "none")} { + if {![string compare [winfo class $mb] "Menubutton"] + && [string compare [$mb cget -state] "disabled"] + && [string compare [$mb cget -menu] ""] + && [string compare [[$mb cget -menu] index last] "none"]} { break } - if {$mb == $w} { + if {![string compare $mb $w]} { return } incr i $count @@ -817,13 +822,13 @@ proc tkMenuNextMenu {menu direction} { proc tkMenuNextEntry {menu count} { global tkPriv - if {[$menu index last] == "none"} { + if {![string compare [$menu index last] "none"]} { return } set length [expr {[$menu index last]+1}] set quitAfter $length set active [$menu index active] - if {$active == "none"} { + if {![string compare $active "none"]} { set i 0 } else { set i [expr {$active + $count}] @@ -854,9 +859,9 @@ proc tkMenuNextEntry {menu count} { } $menu activate $i tkGenerateMenuSelect $menu - if {[$menu type $i] == "cascade"} { + if {![string compare [$menu type $i] "cascade"]} { set cascade [$menu entrycget $i -menu] - if {[string compare $cascade ""] != 0} { + if {[string compare $cascade ""]} { $menu postcascade $i tkMenuFirstEntry $cascade } @@ -891,20 +896,20 @@ proc tkMenuFind {w char} { } switch [winfo class $child] { Menu { - if {[$child cget -type] == "menubar"} { - if {$char == ""} { + if {![string compare [$child cget -type] "menubar"]} { + if {![string compare $char ""]} { return $child } set last [$child index last] for {set i [$child cget -tearoff]} {$i <= $last} {incr i} { - if {[$child type $i] == "separator"} { + if {![string compare [$child type $i] "separator"]} { continue } set char2 [string index [$child entrycget $i -label] \ [$child entrycget $i -underline]] - if {([string compare $char [string tolower $char2]] \ - == 0) || ($char == "")} { - if {[$child entrycget $i -state] != "disabled"} { + if {![string compare $char [string tolower $char2]] \ + || ![string compare $char ""]} { + if {[string compare [$child entrycget $i -state] "disabled"]} { return $child } } @@ -923,9 +928,9 @@ proc tkMenuFind {w char} { Menubutton { set char2 [string index [$child cget -text] \ [$child cget -underline]] - if {([string compare $char [string tolower $char2]] == 0) - || ($char == "")} { - if {[$child cget -state] != "disabled"} { + if {![string compare $char [string tolower $char2]] + || ![string compare $char ""]} { + if {[string compare [$child cget $i -state] "disabled"]} { return $child } } @@ -933,7 +938,7 @@ proc tkMenuFind {w char} { default { set match [tkMenuFind $child $char] - if {$match != ""} { + if {[string compare $match ""]} { return $match } } @@ -956,21 +961,22 @@ proc tkMenuFind {w char} { proc tkTraverseToMenu {w char} { global tkPriv - if {$char == ""} { + if {![string compare $char ""]} { return } - while {[winfo class $w] == "Menu"} { - if {([$w cget -type] != "menubar") && ($tkPriv(postedMb) == "")} { + while {![string compare [winfo class $w] "Menu"]} { + if {[string compare [$w cget -type] "menubar"] + && ![string compare $tkPriv(postedMb) ""]} { return } - if {[$w cget -type] == "menubar"} { + if {![string compare [$w cget -type] "menubar"]} { break } set w [winfo parent $w] } set w [tkMenuFind [winfo toplevel $w] $char] - if {$w != ""} { - if {[winfo class $w] == "Menu"} { + if {[string compare $w ""]} { + if {![string compare [winfo class $w] "Menu"]} { tk_menuSetFocus $w set tkPriv(window) $w tkSaveGrabInfo $w @@ -993,8 +999,8 @@ proc tkTraverseToMenu {w char} { proc tkFirstMenu w { set w [tkMenuFind [winfo toplevel $w] ""] - if {$w != ""} { - if {[winfo class $w] == "Menu"} { + if {[string compare $w ""]} { + if {![string compare [winfo class $w] "Menu"]} { tk_menuSetFocus $w set tkPriv(window) $w tkSaveGrabInfo $w @@ -1019,12 +1025,12 @@ proc tkFirstMenu w { # nothing happens. proc tkTraverseWithinMenu {w char} { - if {$char == ""} { + if {![string compare $char ""]} { return } set char [string tolower $char] set last [$w index last] - if {$last == "none"} { + if {![string compare $last "none"]} { return } for {set i 0} {$i <= $last} {incr i} { @@ -1033,13 +1039,13 @@ proc tkTraverseWithinMenu {w char} { [$w entrycget $i -underline]]}]} { continue } - if {[string compare $char [string tolower $char2]] == 0} { - if {[$w type $i] == "cascade"} { + if {![string compare $char [string tolower $char2]]} { + if {![string compare [$w type $i] "cascade"]} { $w activate $i $w postcascade active event generate $w <<MenuSelect>> set m2 [$w entrycget $i -menu] - if {$m2 != ""} { + if {[string compare $m2 ""]} { tkMenuFirstEntry $m2 } } else { @@ -1063,25 +1069,26 @@ proc tkTraverseWithinMenu {w char} { # menu - Name of the menu window (possibly empty). proc tkMenuFirstEntry menu { - if {$menu == ""} { + if {![string compare $menu ""]} { return } tk_menuSetFocus $menu - if {[$menu index active] != "none"} { + if {[string compare [$menu index active] "none"]} { return } set last [$menu index last] - if {$last == "none"} { + if {![string compare $last "none"]} { return } for {set i 0} {$i <= $last} {incr i} { if {([catch {set state [$menu entrycget $i -state]}] == 0) - && ($state != "disabled") && ([$menu type $i] != "tearoff")} { + && [string compare $state "disabled"] + && [string compare [$menu type $i] "tearoff"]} { $menu activate $i tkGenerateMenuSelect $menu - if {[$menu type $i] == "cascade"} { + if {![string compare [$menu type $i] "cascade"]} { set cascade [$menu entrycget $i -menu] - if {[string compare $cascade ""] != 0} { + if {[string compare $cascade ""]} { $menu postcascade $i tkMenuFirstEntry $cascade } @@ -1109,12 +1116,12 @@ proc tkMenuFindName {menu s} { return $i } set last [$menu index last] - if {$last == "none"} { + if {![string compare $last "none"]} { return } for {set i 0} {$i <= $last} {incr i} { if {![catch {$menu entrycget $i -label} label]} { - if {$label == $s} { + if {![string compare $label $s]} { return $i } } @@ -1137,7 +1144,7 @@ proc tkMenuFindName {menu s} { proc tkPostOverPoint {menu x y {entry {}}} { global tcl_platform - if {$entry != {}} { + if {[string compare $entry {}]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ + [winfo reqheight $menu])/2}] @@ -1148,7 +1155,8 @@ proc tkPostOverPoint {menu x y {entry {}}} { incr x [expr {-[winfo reqwidth $menu]/2}] } $menu post $x $y - if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} { + if {[string compare $entry {}] + && [string compare [$menu entrycget $entry -state] "disabled"]} { $menu activate $entry tkGenerateMenuSelect $menu } @@ -1165,7 +1173,7 @@ proc tkPostOverPoint {menu x y {entry {}}} { proc tkSaveGrabInfo w { global tkPriv set tkPriv(oldGrab) [grab current $w] - if {$tkPriv(oldGrab) != ""} { + if {[string compare $tkPriv(oldGrab) ""]} { set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)] } } @@ -1177,13 +1185,13 @@ proc tkSaveGrabInfo w { proc tkRestoreOldGrab {} { global tkPriv - if {$tkPriv(oldGrab) != ""} { + if {[string compare $tkPriv(oldGrab) ""]} { # Be careful restoring the old grab, since it's window may not # be visible anymore. catch { - if {$tkPriv(grabStatus) == "global"} { + if {![string compare $tkPriv(grabStatus) "global"]} { grab set -global $tkPriv(oldGrab) } else { grab set $tkPriv(oldGrab) @@ -1195,7 +1203,7 @@ proc tkRestoreOldGrab {} { proc tk_menuSetFocus {menu} { global tkPriv - if {![info exists tkPriv(focus)] || [string length $tkPriv(focus)] == 0} { + if {![info exists tkPriv(focus)] || ![string compare $tkPriv(focus) {}]} { set tkPriv(focus) [focus] } focus $menu @@ -1204,9 +1212,8 @@ proc tk_menuSetFocus {menu} { proc tkGenerateMenuSelect {menu} { global tkPriv - if {([string compare $tkPriv(activeMenu) $menu] == 0) \ - && ([string compare $tkPriv(activeItem) [$menu index active]] \ - == 0)} { + if {![string compare $tkPriv(activeMenu) $menu] \ + && ![string compare $tkPriv(activeItem) [$menu index active]]} { return } @@ -1230,11 +1237,12 @@ proc tkGenerateMenuSelect {menu} { proc tk_popup {menu x y {entry {}}} { global tkPriv global tcl_platform - if {($tkPriv(popup) != "") || ($tkPriv(postedMb) != "")} { + if {[string compare $tkPriv(popup) ""] + || [string compare $tkPriv(postedMb) ""]} { tkMenuUnpost {} } tkPostOverPoint $menu $x $y $entry - if {$tcl_platform(platform) == "unix"} { + if {![string compare $tcl_platform(platform) "unix"]} { tkSaveGrabInfo $menu grab -global $menu set tkPriv(popup) $menu diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 093afdf..ea04e86 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# RCS: @(#) $Id: msgbox.tcl,v 1.4 1998/11/12 06:22:05 welch Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.5 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -49,15 +49,13 @@ proc tkMessageBox {args} { tclParseConfigSpec $w $specs "" $args if {[lsearch {info warning error question} $data(-icon)] == -1} { - error "invalid icon \"$data(-icon)\", must be error, info, question or warning" + error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } - if {$tcl_platform(platform) == "macintosh"} { - if {$data(-icon) == "error"} { - set data(-icon) "stop" - } elseif {$data(-icon) == "warning"} { - set data(-icon) "caution" - } elseif {$data(-icon) == "info"} { - set data(-icon) "note" + if {![string compare $tcl_platform(platform) "macintosh"]} { + switch -- $data(-icon) { + "error" {set data(-icon) "stop"} + "warning" {set data(-icon) "caution"} + "info" {set data(-icon) "note"} } } @@ -77,7 +75,7 @@ proc tkMessageBox {args} { set buttons { {ok -width 6 -text OK -under 0} } - if {$data(-default) == ""} { + if {![string compare $data(-default) ""]} { set data(-default) "ok" } } @@ -107,7 +105,7 @@ proc tkMessageBox {args} { } } default { - error "invalid message box type \"$data(-type)\", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel" + error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel" } } @@ -142,7 +140,7 @@ proc tkMessageBox {args} { wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW { } wm transient $w $data(-parent) - if {$tcl_platform(platform) == "macintosh"} { + if {![string compare $tcl_platform(platform) "macintosh"]} { unsupported1 style $w dBoxProc } @@ -150,22 +148,25 @@ proc tkMessageBox {args} { pack $w.bot -side bottom -fill both frame $w.top pack $w.top -side top -fill both -expand 1 - if {$tcl_platform(platform) != "macintosh"} { + if {[string compare $tcl_platform(platform) "macintosh"]} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } # 4. Fill the top part with bitmap and message (use the option - # database for -wraplength so that it can be overridden by - # the caller). + # database for -wraplength and -font so that they can be + # overridden by the caller). option add *Dialog.msg.wrapLength 3i widgetDefault - label $w.msg -justify left -text $data(-message) - catch {$w.msg configure -font \ - -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* + if {![string compare $tcl_platform(platform) "macintosh"]} { + option add *Dialog.msg.font system widgetDefault + } else { + option add *Dialog.msg.font {Times 18} widgetDefault } + + label $w.msg -justify left -text $data(-message) pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m - if {$data(-icon) != ""} { + if {[string compare $data(-icon) ""]} { label $w.bitmap -bitmap $data(-icon) pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m } @@ -176,29 +177,27 @@ proc tkMessageBox {args} { foreach but $buttons { set name [lindex $but 0] set opts [lrange $but 1 end] - if {![string compare $opts {}]} { + if {![llength $opts]} { # Capitalize the first letter of $name - set capName \ - [string toupper \ + set capName [string toupper \ [string index $name 0]][string range $name 1 end] set opts [list -text $capName] } - eval button $w.$name $opts -command [list "set tkPriv(button) $name"] + eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]] if {![string compare $name $data(-default)]} { $w.$name configure -default active } - pack $w.$name -in $w.bot -side left -expand 1 \ - -padx 3m -pady 2m + pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m # create the binding for the key accelerator, based on the underline # set underIdx [$w.$name cget -under] if {$underIdx >= 0} { set key [string index [$w.$name cget -text] $underIdx] - bind $w <Alt-[string tolower $key]> "$w.$name invoke" - bind $w <Alt-[string toupper $key]> "$w.$name invoke" + bind $w <Alt-[string tolower $key]> [list $w.$name invoke] + bind $w <Alt-[string toupper $key]> [list $w.$name invoke] } incr i } @@ -207,7 +206,7 @@ proc tkMessageBox {args} { # default button. if {[string compare $data(-default) ""]} { - bind $w <Return> "tkButtonInvoke $w.$data(-default)" + bind $w <Return> [list tkButtonInvoke $w.$data(-default)] } # 7. Withdraw the window, then update all the geometry information @@ -227,7 +226,7 @@ proc tkMessageBox {args} { set oldFocus [focus] set oldGrab [grab current $w] - if {$oldGrab != ""} { + if {[string compare $oldGrab ""]} { set grabStatus [grab status $oldGrab] } grab $w @@ -246,8 +245,8 @@ proc tkMessageBox {args} { tkwait variable tkPriv(button) catch {focus $oldFocus} destroy $w - if {$oldGrab != ""} { - if {$grabStatus == "global"} { + if {[string compare $oldGrab ""]} { + if {![string compare $grabStatus "global"]} { grab -global $oldGrab } else { grab $oldGrab diff --git a/library/palette.tcl b/library/palette.tcl index 572e1e3..45000b0 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -3,7 +3,7 @@ # This file contains procedures that change the color palette used # by Tk. # -# RCS: @(#) $Id: palette.tcl,v 1.3 1998/09/14 18:23:24 stanton Exp $ +# RCS: @(#) $Id: palette.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # @@ -187,23 +187,22 @@ proc tkRecolorTree {w colors} { # by 10%. proc tkDarken {color percent} { - set l [winfo rgb . $color] - set red [expr {[lindex $l 0]/256}] - set green [expr {[lindex $l 1]/256}] - set blue [expr {[lindex $l 2]/256}] - set red [expr {($red*$percent)/100}] + foreach {red green blue} [winfo rgb . $color] { + set red [expr {($red/256)*$percent/100}] + set green [expr {($green/256)*$percent/100}] + set blue [expr {($blue/256)*$percent/100}] + break + } if {$red > 255} { set red 255 } - set green [expr {($green*$percent)/100}] if {$green > 255} { set green 255 } - set blue [expr {($blue*$percent)/100}] if {$blue > 255} { set blue 255 } - format #%02x%02x%02x $red $green $blue + return [format "#%02x%02x%02x" $red $green $blue] } # tk_bisque -- diff --git a/library/safetk.tcl b/library/safetk.tcl index 78aeb86..0ceaebe 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -2,7 +2,7 @@ # # Support procs to use Tk in safe interpreters. # -# RCS: @(#) $Id: safetk.tcl,v 1.3 1998/09/14 18:23:24 stanton Exp $ +# RCS: @(#) $Id: safetk.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1997 Sun Microsystems, Inc. # @@ -22,7 +22,7 @@ # # We use opt (optional arguments parsing) -package require opt 0.1; +package require opt 0.4.1; namespace eval ::safe { @@ -62,65 +62,83 @@ namespace eval ::safe { # empty definition for auto_mkIndex proc ::safe::loadTk {} {} - ::tcl::OptProc loadTk { - {slave -interp "name of the slave interpreter"} - {-use -windowId {} "window Id to use (new toplevel otherwise)"} - {-display -displayName {} "display name to use (current one otherwise)"} - } { - set displayGiven [::tcl::OptProcArgGiven "-display"] - if {!$displayGiven} { - # Try to get the current display from "." - # (which might not exist if the master is tk-less) - if {[catch {set display [winfo screen .]}]} { - if {[info exists ::env(DISPLAY)]} { - set display $::env(DISPLAY) - } else { - Log $slave "no winfo screen . nor env(DISPLAY)" WARNING - set display ":0.0" - } +::tcl::OptProc loadTk { + {slave -interp "name of the slave interpreter"} + {-use -windowId {} "window Id to use (new toplevel otherwise)"} + {-display -displayName {} "display name to use (current one otherwise)"} +} { + set displayGiven [::tcl::OptProcArgGiven "-display"] + if {!$displayGiven} { + + # Try to get the current display from "." + # (which might not exist if the master is tk-less) + + if {[catch {set display [winfo screen .]}]} { + if {[info exists ::env(DISPLAY)]} { + set display $::env(DISPLAY) + } else { + Log $slave "no winfo screen . nor env(DISPLAY)" WARNING + set display ":0.0" } } - if {![::tcl::OptProcArgGiven "-use"]} { - # create a decorated toplevel - ::tcl::Lassign [tkTopLevel $slave $display] w use; - # set our delete hook (slave arg is added by interpDelete) - Set [DeleteHookName $slave] [list tkDelete {} $w]; + } + if {![::tcl::OptProcArgGiven "-use"]} { + + # create a decorated toplevel + + ::tcl::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 [DeleteHookName $slave] [list tkDelete {} $w]; + + } else { + + # set our delete hook (slave arg is added by interpDelete) + # to clean up tkInit(slave) + + Set [DeleteHookName $slave] [list disallowTk] + + # Let's be nice and also accept tk window names instead of ids + + if {[string match ".*" $use]} { + set windowName $use + set use [winfo id $windowName] + set nDisplay [winfo screen $windowName] } else { - # Let's be nice and also accept tk window names instead of ids - if {[string match ".*" $use]} { - set windowName $use - set use [winfo id $windowName] - set nDisplay [winfo screen $windowName] + + # Check for a better -display value + # (works only for multi screens on single host, but not + # cross hosts, for that a tk window name would be better + # but embeding is also usefull for non tk names) + + if {![catch {winfo pathname $use} name]} { + set nDisplay [winfo screen $name] } else { - # Check for a better -display value - # (works only for multi screens on single host, but not - # cross hosts, for that a tk window name would be better - # but embeding is also usefull for non tk names) - if {![catch {winfo pathname $use} name]} { - set nDisplay [winfo screen $name] - } else { - # Can't have a better one - set nDisplay $display - } + + # Can't have a better one + + set nDisplay $display } - if {[string compare $nDisplay $display]} { - if {$displayGiven} { - error "conflicting -display $display and -use\ - $use -> $nDisplay" - } else { - set display $nDisplay - } + } + if {[string compare $nDisplay $display]} { + if {$displayGiven} { + error "conflicting -display $display and -use\ + $use -> $nDisplay" + } else { + set display $nDisplay } } + } - # Prepares the slave for tk with those parameters - - tkInterpInit $slave [list "-use" $use "-display" $display] - - load {} Tk $slave + # Prepares the slave for tk with those parameters + + tkInterpInit $slave [list "-use" $use "-display" $display] + + load {} Tk $slave - return $slave - } + return $slave +} proc ::safe::TkInit {interpPath} { variable tkInit @@ -135,25 +153,73 @@ proc ::safe::TkInit {interpPath} { } } +# safe::allowTk -- +# +# Set tkInit(interpPath) to allow Tk to be initialized in +# safe::TkInit. +# +# Arguments: +# interpPath slave interpreter handle +# argv arguments passed to safe::TkInterpInit +# +# Results: +# none. + proc ::safe::allowTk {interpPath argv} { variable tkInit set tkInit($interpPath) $argv + return } - proc ::safe::tkDelete {W window slave} { - # we are going to be called for each widget... skip untill it's - # top level - Log $slave "Called tkDelete $W $window" NOTICE; - if {[::interp exists $slave]} { - if {[catch {::safe::interpDelete $slave} msg]} { - Log $slave "Deletion error : $msg"; - } - } - if {[winfo exists $window]} { - Log $slave "Destroy toplevel $window" NOTICE; - destroy $window; + +# safe::disallowTk -- +# +# Unset tkInit(interpPath) to disallow Tk from getting initialized +# in safe::TkInit. +# +# Arguments: +# interpPath slave interpreter handle +# +# Results: +# none. + +proc ::safe::disallowTk {interpPath} { + variable tkInit + unset tkInit($interpPath) + none +} + + +# safe::disallowTk -- +# +# Clean up the window associated with the interp being deleted. +# +# Arguments: +# interpPath slave interpreter handle +# +# Results: +# none. + +proc ::safe::tkDelete {W window slave} { + + # we are going to be called for each widget... skip untill it's + # top level + + Log $slave "Called tkDelete $W $window" NOTICE; + if {[::interp exists $slave]} { + if {[catch {::safe::interpDelete $slave} msg]} { + Log $slave "Deletion error : $msg"; } } + if {[winfo exists $window]} { + Log $slave "Destroy toplevel $window" NOTICE; + destroy $window; + } + + # clean up tkInit(slave) + disallowTk $slave + return +} proc ::safe::tkTopLevel {slave display} { variable tkSafeId; diff --git a/library/scale.tcl b/library/scale.tcl index a761a01..e36dbe8 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk scale widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: scale.tcl,v 1.3 1998/09/14 18:23:24 stanton Exp $ +# RCS: @(#) $Id: scale.tcl,v 1.4 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. @@ -32,7 +32,7 @@ bind Scale <Leave> { if {$tk_strictMotif} { %W config -activebackground $tkPriv(activeBg) } - if {[%W cget -state] == "active"} { + if {![string compare [%W cget -state] "active"]} { %W configure -state normal } } @@ -107,10 +107,10 @@ bind Scale <End> { proc tkScaleActivate {w x y} { global tkPriv - if {[$w cget -state] == "disabled"} { - return; + if {![string compare [$w cget -state] "disabled"]} { + return } - if {[$w identify $x $y] == "slider"} { + if {![string compare [$w identify $x $y] "slider"]} { $w configure -state active } else { $w configure -state normal @@ -129,11 +129,11 @@ proc tkScaleButtonDown {w x y} { global tkPriv set tkPriv(dragging) 0 set el [$w identify $x $y] - if {$el == "trough1"} { + if {![string compare $el "trough1"]} { tkScaleIncrement $w up little initial - } elseif {$el == "trough2"} { + } elseif {![string compare $el "trough2"]} { tkScaleIncrement $w down little initial - } elseif {$el == "slider"} { + } elseif {![string compare $el "slider"]} { set tkPriv(dragging) 1 set tkPriv(initValue) [$w get] set coords [$w coords] @@ -194,7 +194,7 @@ proc tkScaleEndDrag {w} { proc tkScaleIncrement {w dir big repeat} { global tkPriv if {![winfo exists $w]} return - if {$big == "big"} { + if {![string compare $big "big"]} { set inc [$w cget -bigincrement] if {$inc == 0} { set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}] @@ -205,15 +205,15 @@ proc tkScaleIncrement {w dir big repeat} { } else { set inc [$w cget -resolution] } - if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} { + if {([$w cget -from] > [$w cget -to]) ^ ![string compare $dir "up"]} { set inc [expr {-$inc}] } $w set [expr {[$w get] + $inc}] - if {$repeat == "again"} { + if {![string compare $repeat "again"]} { set tkPriv(afterId) [after [$w cget -repeatinterval] \ tkScaleIncrement $w $dir $big again] - } elseif {$repeat == "initial"} { + } elseif {![string compare $repeat "initial"]} { set delay [$w cget -repeatdelay] if {$delay > 0} { set tkPriv(afterId) [after $delay \ @@ -233,9 +233,9 @@ proc tkScaleIncrement {w dir big repeat} { proc tkScaleControlPress {w x y} { set el [$w identify $x $y] - if {$el == "trough1"} { + if {![string compare $el "trough1"]} { $w set [$w cget -from] - } elseif {$el == "trough2"} { + } elseif {![string compare $el "trough2"]} { $w set [$w cget -to] } } @@ -252,8 +252,8 @@ proc tkScaleControlPress {w x y} { proc tkScaleButton2Down {w x y} { global tkPriv - if {[$w cget -state] == "disabled"} { - return; + if {![string compare [$w cget -state] "disabled"]} { + return } $w configure -state active $w set [$w get $x $y] diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 48f2c11..93d4a3c 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk scrollbar widgets. # It also provides procedures that help in implementing the bindings. # -# RCS: @(#) $Id: scrlbar.tcl,v 1.4 1998/11/12 06:22:05 welch Exp $ +# RCS: @(#) $Id: scrlbar.tcl,v 1.5 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -17,8 +17,8 @@ #------------------------------------------------------------------------- # Standard Motif bindings: -if {($tcl_platform(platform) != "windows") && - ($tcl_platform(platform) != "macintosh")} { +if {[string compare $tcl_platform(platform) "windows"] && + [string compare $tcl_platform(platform) "macintosh"]} { bind Scrollbar <Enter> { if {$tk_strictMotif} { set tkPriv(activeBg) [%W cget -activebackground] @@ -144,7 +144,7 @@ proc tkScrollButtonDown {w x y} { set tkPriv(relief) [$w cget -activerelief] $w configure -activerelief sunken set element [$w identify $x $y] - if {$element == "slider"} { + if {![string compare $element "slider"]} { tkScrollStartDrag $w $x $y } else { tkScrollSelect $w $element initial @@ -185,21 +185,17 @@ proc tkScrollButtonUp {w x y} { proc tkScrollSelect {w element repeat} { global tkPriv if {![winfo exists $w]} return - if {$element == "arrow1"} { - tkScrollByUnits $w hv -1 - } elseif {$element == "trough1"} { - tkScrollByPages $w hv -1 - } elseif {$element == "trough2"} { - tkScrollByPages $w hv 1 - } elseif {$element == "arrow2"} { - tkScrollByUnits $w hv 1 - } else { - return + switch -- $element { + "arrow1" {tkScrollByUnits $w hv -1} + "trough1" {tkScrollByPages $w hv -1} + "trough2" {tkScrollByPages $w hv 1} + "arrow2" {tkScrollByUnits $w hv 1} + default {return} } - if {$repeat == "again"} { + if {![string compare $repeat "again"]} { set tkPriv(afterId) [after [$w cget -repeatinterval] \ tkScrollSelect $w $element again] - } elseif {$repeat == "initial"} { + } elseif {![string compare $repeat "initial"]} { set delay [$w cget -repeatdelay] if {$delay > 0} { set tkPriv(afterId) [after $delay tkScrollSelect $w $element again] @@ -218,7 +214,7 @@ proc tkScrollSelect {w element repeat} { proc tkScrollStartDrag {w x y} { global tkPriv - if {[$w cget -command] == ""} { + if {![string compare [$w cget -command] ""]} { return } set tkPriv(pressX) $x @@ -250,7 +246,7 @@ proc tkScrollStartDrag {w x y} { proc tkScrollDrag {w x y} { global tkPriv - if {$tkPriv(initPos) == ""} { + if {![string compare $tkPriv(initPos) ""]} { return } set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]] @@ -280,7 +276,7 @@ proc tkScrollDrag {w x y} { proc tkScrollEndDrag {w x y} { global tkPriv - if {$tkPriv(initPos) == ""} { + if {![string compare $tkPriv(initPos) ""]} { return } if {[$w cget -jump]} { @@ -304,7 +300,7 @@ proc tkScrollEndDrag {w x y} { proc tkScrollByUnits {w orient amount} { set cmd [$w cget -command] - if {($cmd == "") || ([string first \ + if {![string compare $cmd ""] || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { return } @@ -329,7 +325,7 @@ proc tkScrollByUnits {w orient amount} { proc tkScrollByPages {w orient amount} { set cmd [$w cget -command] - if {($cmd == "") || ([string first \ + if {![string compare $cmd ""] || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { return } @@ -353,7 +349,7 @@ proc tkScrollByPages {w orient amount} { proc tkScrollToPos {w pos} { set cmd [$w cget -command] - if {($cmd == "")} { + if {![string compare $cmd ""]} { return } set info [$w get] @@ -399,7 +395,8 @@ proc tkScrollTopBottom {w x y} { proc tkScrollButton2Down {w x y} { global tkPriv set element [$w identify $x $y] - if {($element == "arrow1") || ($element == "arrow2")} { + if {![string compare $element "arrow1"] + || ![string compare $element "arrow2"]} { tkScrollButtonDown $w $x $y return } diff --git a/library/tearoff.tcl b/library/tearoff.tcl index c68c32d..7a240c3 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -2,7 +2,7 @@ # # This file contains procedures that implement tear-off menus. # -# RCS: @(#) $Id: tearoff.tcl,v 1.3 1998/09/14 18:23:25 stanton Exp $ +# RCS: @(#) $Id: tearoff.tcl,v 1.4 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -40,11 +40,11 @@ proc tkTearOffMenu {w {x 0} {y 0}} { } set parent [winfo parent $w] - while {([winfo toplevel $parent] != $parent) - || ([winfo class $parent] == "Menu")} { + while {[string compare [winfo toplevel $parent] $parent] + || ![string compare [winfo class $parent] "Menu"]} { set parent [winfo parent $parent] } - if {$parent == "."} { + if {![string compare $parent "."]} { set parent "" } for {set i 1} 1 {incr i} { @@ -61,7 +61,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} { # entry. If it's a menubutton then use its text. set parent [winfo parent $w] - if {[$menu cget -title] != ""} { + if {[string compare [$menu cget -title] ""]} { wm title $menu [$menu cget -title] } else { switch [winfo class $parent] { @@ -92,7 +92,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} { # now. set cmd [$w cget -tearoffcommand] - if {$cmd != ""} { + if {[string compare $cmd ""]} { uplevel #0 $cmd $w $menu } return $menu @@ -121,7 +121,7 @@ proc tkMenuDup {src dst type} { } eval $cmd set last [$src index last] - if {$last == "none"} { + if {![string compare $last "none"]} { return } for {set i [$src cget -tearoff]} {$i <= $last} {incr i} { @@ -134,12 +134,33 @@ proc tkMenuDup {src dst type} { # Duplicate the binding tags and bindings from the source menu. - regsub -all . $src {\\&} quotedSrc - regsub -all . $dst {\\&} quotedDst - regsub -all $quotedSrc [bindtags $src] $dst x + 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} { + append x [string range $tags 0 [expr {$index - 1}]]$dst + set tags [string range $tags [expr {$index + $srcLen}] end] + } + append x $tags + bindtags $dst $x + foreach event [bind $src] { - regsub -all $quotedSrc [bind $src $event] $dst x + unset x + set script [bind $src $event] + set eventLen [string length $event] + + # Copy script to x, replacing each substring of event with dst. + + while {[set index [string first $event $script]] != -1} { + append x [string range $script 0 [expr {$index - 1}]] + append x $dst + set script [string range $script [expr {$index + $eventLen}] end] + } + append x $script + bind $dst $event $x } } diff --git a/library/text.tcl b/library/text.tcl index 6ef185c..a780bda 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: text.tcl,v 1.5 1998/10/10 00:30:36 rjohnson Exp $ +# RCS: @(#) $Id: text.tcl,v 1.6 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -202,7 +202,7 @@ bind Text <Return> { tkTextInsert %W \n } bind Text <Delete> { - if {[%W tag nextrange sel 1.0 end] != ""} { + if {[string compare [%W tag nextrange sel 1.0 end] ""]} { %W delete sel.first sel.last } else { %W delete insert @@ -210,7 +210,7 @@ bind Text <Delete> { } } bind Text <BackSpace> { - if {[%W tag nextrange sel 1.0 end] != ""} { + if {[string compare [%W tag nextrange sel 1.0 end] ""]} { %W delete sel.first sel.last } elseif {[%W compare insert != 1.0]} { %W delete insert-1c @@ -272,7 +272,7 @@ bind Text <Meta-KeyPress> {# nothing} bind Text <Control-KeyPress> {# nothing} bind Text <Escape> {# nothing} bind Text <KP_Enter> {# nothing} -if {$tcl_platform(platform) == "macintosh"} { +if {![string compare $tcl_platform(platform) "macintosh"]} { bind Text <Command-KeyPress> {# nothing} } @@ -334,7 +334,7 @@ bind Text <Control-t> { } } -if {$tcl_platform(platform) != "windows"} { +if {[string compare $tcl_platform(platform) "windows"]} { bind Text <Control-v> { if {!$tk_strictMotif} { tkTextScrollPages %W 1 @@ -381,7 +381,7 @@ bind Text <Meta-Delete> { # Macintosh only bindings: # if text black & highlight black -> text white, other text the same -if {$tcl_platform(platform) == "macintosh"} { +if {![string compare $tcl_platform(platform) "macintosh"]} { bind Text <FocusIn> { %W tag configure sel -borderwidth 0 %W configure -selectbackground systemHighlight -selectforeground systemHighlightText @@ -453,7 +453,7 @@ set tkPriv(prevPos) {} # on other platforms. bind Text <MouseWheel> { - %W yview scroll [expr - (%D / 120) * 4] units + %W yview scroll [expr {- (%D / 120) * 4}] units } # tkTextClosestGap -- @@ -496,7 +496,7 @@ proc tkTextButton1 {w x y} { set tkPriv(pressX) $x $w mark set insert [tkTextClosestGap $w $x $y] $w mark set anchor insert - if {[$w cget -state] == "normal"} {focus $w} + if {![string compare [$w cget -state] "normal"]} {focus $w} } # tkTextSelectTo -- @@ -551,8 +551,9 @@ proc tkTextSelectTo {w x y} { } } } - if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} { - if {$tcl_platform(platform) != "unix" && [$w compare $cur < anchor]} { + if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} { + if {[string compare $tcl_platform(platform) "unix"] + && [$w compare $cur < anchor]} { $w mark set insert $first } else { $w mark set insert $last @@ -604,7 +605,7 @@ proc tkTextKeyExtend {w index} { proc tkTextPaste {w x y} { $w mark set insert [tkTextClosestGap $w $x $y] catch {$w insert insert [selection get -displayof $w]} - if {[$w cget -state] == "normal"} {focus $w} + if {![string compare [$w cget -state] "normal"]} {focus $w} } # tkTextAutoScan -- @@ -670,7 +671,7 @@ proc tkTextSetCursor {w pos} { proc tkTextKeySelect {w new} { global tkPriv - if {[$w tag nextrange sel 1.0 end] == ""} { + if {![string compare [$w tag nextrange sel 1.0 end] ""]} { if {[$w compare $new < insert]} { $w tag add sel $new insert } else { @@ -711,7 +712,7 @@ proc tkTextKeySelect {w new} { proc tkTextResetAnchor {w index} { global tkPriv - if {[$w tag ranges sel] == ""} { + if {![string compare [$w tag ranges sel] ""]} { $w mark set anchor $index return } @@ -758,7 +759,8 @@ proc tkTextResetAnchor {w index} { # s - The string to insert (usually just a single character) proc tkTextInsert {w s} { - if {($s == "") || ([$w cget -state] == "disabled")} { + if {![string compare $s ""] || + ![string compare [$w cget -state] "disabled"]} { return } catch { @@ -812,13 +814,14 @@ proc tkTextUpDownLine {w n} { proc tkTextPrevPara {w pos} { set pos [$w index "$pos linestart"] while 1 { - if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n")) - || ($pos == "1.0")} { + if {(![string compare [$w get "$pos - 1 line"] "\n"] + && [string compare [$w get $pos] "\n"]) + || ![string compare $pos "1.0"]} { if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ dummy index]} { set pos [$w index "$pos + [lindex $index 0] chars"] } - if {[$w compare $pos != insert] || ($pos == "1.0")} { + if {[$w compare $pos != insert] || ![string compare $pos 1.0]} { return $pos } } @@ -837,13 +840,13 @@ proc tkTextPrevPara {w pos} { proc tkTextNextPara {w start} { set pos [$w index "$start linestart + 1 line"] - while {[$w get $pos] != "\n"} { + while {[string compare [$w get $pos] "\n"]} { if {[$w compare $pos == end]} { return [$w index "end - 1c"] } set pos [$w index "$pos + 1 line"] } - while {[$w get $pos] == "\n"} { + while {![string compare [$w get $pos] "\n"]} { set pos [$w index "$pos + 1 line"] if {[$w compare $pos == end]} { return [$w index "end - 1c"] @@ -871,7 +874,7 @@ proc tkTextNextPara {w start} { proc tkTextScrollPages {w count} { set bbox [$w bbox insert] $w yview scroll $count pages - if {$bbox == ""} { + if {![string compare $bbox ""]} { return [$w index @[expr {[winfo height $w]/2}],0] } return [$w index @[lindex $bbox 0],[lindex $bbox 1]] @@ -941,7 +944,7 @@ proc tk_textCut w { proc tk_textPaste w { global tcl_platform catch { - if {"$tcl_platform(platform)" != "unix"} { + if {[string compare $tcl_platform(platform) "unix"]} { catch { $w delete sel.first sel.last } @@ -960,7 +963,7 @@ proc tk_textPaste w { # w - The text window in which the cursor is to move. # start - Position at which to start search. -if {$tcl_platform(platform) == "windows"} { +if {![string compare $tcl_platform(platform) "windows"]} { proc tkTextNextWord {w start} { tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \ tcl_startOfNextWord diff --git a/library/tk.tcl b/library/tk.tcl index 4e9cb08..0a4aaae 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.6 1999/01/04 19:25:27 rjohnson Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.7 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -14,8 +14,8 @@ # Insist on running with compatible versions of Tcl and Tk. -package require -exact Tk 8.0 -package require -exact Tcl 8.0 +package require -exact Tk 8.1 +package require -exact Tcl 8.1 # Add Tk's directory to the end of the auto-load search path, if it # isn't already on the path: @@ -56,27 +56,29 @@ proc tkScreenChanged screen { set tkPriv(screen) $screen return } - set tkPriv(activeMenu) {} - set tkPriv(activeItem) {} - set tkPriv(afterId) {} - set tkPriv(buttons) 0 - set tkPriv(buttonWindow) {} - set tkPriv(dragging) 0 - set tkPriv(focus) {} - set tkPriv(grab) {} - set tkPriv(initPos) {} - set tkPriv(inMenubutton) {} - set tkPriv(listboxPrev) {} - set tkPriv(menuBar) {} - set tkPriv(mouseMoved) 0 - set tkPriv(oldGrab) {} - set tkPriv(popup) {} - set tkPriv(postedMb) {} - set tkPriv(pressX) 0 - set tkPriv(pressY) 0 - set tkPriv(prevPos) 0 + array set tkPriv { + activeMenu {} + activeItem {} + afterId {} + buttons 0 + buttonWindow {} + dragging 0 + focus {} + grab {} + initPos {} + inMenubutton {} + listboxPrev {} + menuBar {} + mouseMoved 0 + oldGrab {} + popup {} + postedMb {} + pressX 0 + pressY 0 + prevPos 0 + selectMode char + } set tkPriv(screen) $screen - set tkPriv(selectMode) char if {[string compare $tcl_platform(platform) "unix"] == 0} { set tkPriv(tearoff) 1 } else { @@ -114,6 +116,40 @@ proc tkEventMotifBindings {n1 dummy dummy} { } #---------------------------------------------------------------------- +# Define common dialogs on platforms where they are not implemented +# using compiled code. +#---------------------------------------------------------------------- + +if {![string compare [info commands tk_chooseColor] ""]} { + proc tk_chooseColor {args} { + return [eval tkColorDialog $args] + } +} +if {![string compare [info commands tk_getOpenFile] ""]} { + proc tk_getOpenFile {args} { + if {$::tk_strictMotif} { + return [eval tkMotifFDialog open $args] + } else { + return [eval tkFDialog open $args] + } + } +} +if {![string compare [info commands tk_getSaveFile] ""]} { + proc tk_getSaveFile {args} { + if {$::tk_strictMotif} { + return [eval tkMotifFDialog save $args] + } else { + return [eval tkFDialog save $args] + } + } +} +if {![string compare [info commands tk_messageBox] ""]} { + proc tk_messageBox {args} { + return [eval tkMessageBox $args] + } +} + +#---------------------------------------------------------------------- # Define the set of common virtual events. #---------------------------------------------------------------------- @@ -145,7 +181,7 @@ switch $tcl_platform(platform) { # Read in files that define all of the class bindings. # ---------------------------------------------------------------------- -if {$tcl_platform(platform) != "macintosh"} { +if {[string compare $tcl_platform(platform) "macintosh"]} { source [file join $tk_library button.tcl] source [file join $tk_library entry.tcl] source [file join $tk_library listbox.tcl] @@ -185,7 +221,7 @@ proc tkCancelRepeat {} { # w - Window to which focus should be set. proc tkTabToWindow {w} { - if {"[winfo class $w]" == "Entry"} { + if {![string compare [winfo class $w] Entry]} { $w select range 0 end $w icur end } diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 2fa9578..ec56b48 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -11,9 +11,9 @@ # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.8 1998/11/12 06:22:05 welch Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.9 1999/04/16 01:51:27 stanton Exp $ # -# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# 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. @@ -95,10 +95,10 @@ proc tkIconList_Create {w} { bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y" bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y" - bind $data(canvas) <Double-1> "tkIconList_Double1 $w %x %y" - bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat" bind $data(canvas) <B1-Leave> "tkIconList_Leave1 $w %x %y" bind $data(canvas) <B1-Enter> "tkCancelRepeat" + bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat" + bind $data(canvas) <Double-ButtonRelease-1> "tkIconList_Double1 $w %x %y" bind $data(canvas) <Up> "tkIconList_UpDown $w -1" bind $data(canvas) <Down> "tkIconList_UpDown $w 1" @@ -628,23 +628,22 @@ proc tkIconList_Reset {w} { # the tk_strictMotif flag is set to false. This procedure shouldn't # be called directly. Call tk_getOpenFile or tk_getSaveFile instead. # -proc tkFDialog {args} { - global tkPriv - set w __tk_filedialog - upvar #0 $w data +# Arguments: +# type "open" or "save" +# args Options parsed by the procedure. +# - if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} { - set type open - } else { - set type save - } +proc tkFDialog {type args} { + global tkPriv + set dataName __tk_filedialog + upvar #0 $dataName data - tkFDialog_Config $w $type $args + tkFDialog_Config $dataName $type $args if {![string compare $data(-parent) .]} { - set w .$w + set w .$dataName } else { - set w $data(-parent).$w + set w $data(-parent).$dataName } # (re)create the dialog box if necessary @@ -668,7 +667,9 @@ proc tkFDialog {args} { } wm transient $w $data(-parent) - # 5. Initialize the file types menu + trace variable data(selectPath) w "tkFDialog_SetPath $w" + + # Initialize the file types menu # if {$data(-filetypes) != {}} { $data(typeMenu) delete 0 end @@ -689,7 +690,7 @@ proc tkFDialog {args} { tkFDialog_UpdateWhenIdle $w - # 6. Withdraw the window, then update all the geometry information + # Withdraw the window, then update all the geometry information # so we know how big it wants to be, then center the window in the # display and de-iconify it. @@ -703,7 +704,7 @@ proc tkFDialog {args} { wm deiconify $w wm title $w $data(-title) - # 7. Set a grab and claim the focus too. + # Set a grab and claim the focus too. set oldFocus [focus] set oldGrab [grab current $w] @@ -718,7 +719,7 @@ proc tkFDialog {args} { $data(ent) select to end $data(ent) icursor end - # 8. Wait for the user to respond, then restore the focus and + # 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, @@ -735,6 +736,7 @@ proc tkFDialog {args} { grab $oldGrab } } + return $tkPriv(selectFilePath) } @@ -742,11 +744,19 @@ proc tkFDialog {args} { # # Configures the TK filedialog according to the argument list # -proc tkFDialog_Config {w type argList} { - upvar #0 $w data +proc tkFDialog_Config {dataName type argList} { + upvar #0 $dataName data set data(type) $type + # 0: Delete all variable that were set on data(selectPath) the + # last time the file dialog is used. The traces may cause troubles + # if the dialog is now used with a different -parent option. + + foreach trace [trace vinfo data(selectPath)] { + trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1] + } + # 1: the configuration specs # set specs { @@ -768,7 +778,7 @@ proc tkFDialog_Config {w type argList} { # 3: parse the arguments # - tclParseConfigSpec $w $specs "" $argList + tclParseConfigSpec $dataName $specs "" $argList if {![string compare $data(-title) ""]} { if {![string compare $type "open"]} { @@ -782,9 +792,8 @@ proc tkFDialog_Config {w type argList} { # settings # if {[string compare $data(-initialdir) ""]} { - if {[file isdirectory $data(-initialdir)]} { - set data(selectPath) [glob $data(-initialdir)] + set data(selectPath) [lindex [glob $data(-initialdir)] 0] } else { set data(selectPath) [pwd] } @@ -915,8 +924,6 @@ static char updir_bits[] = { $data(okBtn) config -command "tkFDialog_OkCmd $w" $data(cancelBtn) config -command "tkFDialog_CancelCmd $w" - trace variable data(selectPath) w "tkFDialog_SetPath $w" - bind $w <Alt-d> "focus $data(dirMenuBtn)" bind $w <Alt-t> [format { if {"[%s cget -state]" == "normal"} { @@ -1068,6 +1075,14 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] # cd $appPWD + # Restore the Open/Save Button + # + if {![string compare $data(type) open]} { + $data(okBtn) config -text "Open" + } else { + $data(okBtn) config -text "Save" + } + # turn off the busy cursor. # $data(ent) config -cursor $entCursor diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 15ff0ac..2080c97 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -4,53 +4,105 @@ # Unix platform. This implementation is used only if the # "tk_strictMotif" flag is set. # -# RCS: @(#) $Id: xmfbox.tcl,v 1.6 1998/11/12 06:22:05 welch Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.7 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# - # tkMotifFDialog -- # # Implements a file dialog similar to the standard Motif file # selection box. # -# Return value: +# Arguments: +# type "open" or "save" +# args Options parsed by the procedure. # +# Results: # A list of two members. The first member is the absolute # pathname of the selected file or "" if user hits cancel. The # second member is the name of the selected file type, or "" # which stands for "default file type" -# -proc tkMotifFDialog {args} { + +proc tkMotifFDialog {type args} { global tkPriv - set w __tk_filedialog - upvar #0 $w data + set dataName __tk_filedialog + upvar #0 $dataName data - if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} { - set type open - } else { - set type save + set w [tkMotifFDialog_Create $dataName $type $args] + + # Set a grab and claim the focus too. + + set oldFocus [focus] + set oldGrab [grab current $w] + if {$oldGrab != ""} { + set grabStatus [grab status $oldGrab] } + grab $w + focus $data(sEnt) + $data(sEnt) select from 0 + $data(sEnt) select to 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. - tkMotifFDialog_Config $w $type $args + tkwait variable tkPriv(selectFilePath) + catch {focus $oldFocus} + grab release $w + wm withdraw $w + if {$oldGrab != ""} { + if {$grabStatus == "global"} { + grab -global $oldGrab + } else { + grab $oldGrab + } + } + return $tkPriv(selectFilePath) +} + +# tkMotifFDialog_Create -- +# +# Creates the Motif file dialog (if it doesn't exist yet) and +# initialize the internal data structure associated with the +# dialog. +# +# This procedure is used by tkMotifFDialog to create the +# dialog. It's also used by the test suite to test the Motif +# file dialog implementation. User code shouldn't call this +# procedure directly. +# +# Arguments: +# dataName Name of the global "data" array for the file dialog. +# type "Save" or "Open" +# argList Options parsed by the procedure. +# +# Results: +# Pathname of the file dialog. + +proc tkMotifFDialog_Create {dataName type argList} { + global tkPriv + upvar #0 $dataName data + + tkMotifFDialog_Config $dataName $type $argList if {![string compare $data(-parent) .]} { - set w .$w + set w .$dataName } else { - set w $data(-parent).$w + set w $data(-parent).$dataName } # (re)create the dialog box if necessary # if {![winfo exists $w]} { - tkMotifFDialog_Create $w + tkMotifFDialog_BuildUI $w } elseif {[string compare [winfo class $w] TkMotifFDialog]} { destroy $w - tkMotifFDialog_Create $w + tkMotifFDialog_BuildUI $w } else { set data(fEnt) $w.top.f1.ent set data(dList) $w.top.f2.a.l @@ -60,58 +112,42 @@ proc tkMotifFDialog {args} { set data(filterBtn) $w.bot.filter set data(cancelBtn) $w.bot.cancel } + wm transient $w $data(-parent) tkMotifFDialog_Update $w - # 5. Withdraw the window, then update all the geometry information + # Withdraw the window, then update all the geometry information # so we know how big it wants to be, then center the window in the # display and de-iconify it. wm withdraw $w update idletasks - set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ - - [winfo vrootx [winfo parent $w]]}] - set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ - - [winfo vrooty [winfo parent $w]]}] + set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ + - [winfo vrootx [winfo parent $w]]] + set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ + - [winfo vrooty [winfo parent $w]]] wm geom $w +$x+$y wm deiconify $w wm title $w $data(-title) - # 6. Set a grab and claim the focus too. - - set oldFocus [focus] - set oldGrab [grab current $w] - if {$oldGrab != ""} { - set grabStatus [grab status $oldGrab] - } - grab $w - focus $data(sEnt) - $data(sEnt) select from 0 - $data(sEnt) select to end - - # 7. 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. - - tkwait variable tkPriv(selectFilePath) - catch {focus $oldFocus} - grab release $w - wm withdraw $w - if {$oldGrab != ""} { - if {$grabStatus == "global"} { - grab -global $oldGrab - } else { - grab $oldGrab - } - } - return $tkPriv(selectFilePath) + return $w } -proc tkMotifFDialog_Config {w type argList} { - upvar #0 $w data +# tkMotifFDialog_Config -- +# +# Iterates over the optional arguments to determine the option +# values for the Motif file dialog; gives default values to +# unspecified options. +# +# Arguments: +# dataName The name of the global variable in which +# data for the file dialog is stored. +# type "Save" or "Open" +# argList Options parsed by the procedure. + +proc tkMotifFDialog_Config {dataName type argList} { + upvar #0 $dataName data set data(type) $type @@ -136,7 +172,7 @@ proc tkMotifFDialog_Config {w type argList} { # 3: parse the arguments # - tclParseConfigSpec $w $specs "" $argList + tclParseConfigSpec $dataName $specs "" $argList if {![string compare $data(-title) ""]} { if {![string compare $type "open"]} { @@ -179,11 +215,21 @@ proc tkMotifFDialog_Config {w type argList} { } } -proc tkMotifFDialog_Create {w} { +# tkMotifFDialog_BuildUI -- +# +# Builds the UI components of the Motif file dialog. +# +# Arguments: +# w Pathname of the dialog to build. +# +# Results: +# None. + +proc tkMotifFDialog_BuildUI {w} { set dataName [lindex [split $w .] end] upvar #0 $dataName data - # 1: Create the dialog ... + # Create the dialog toplevel and internal frames. # toplevel $w -class TkMotifFDialog set top [frame $w.top -relief raised -bd 1] @@ -261,7 +307,22 @@ proc tkMotifFDialog_Create {w} { wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w" } -proc tkMotifFDialog_MakeSList {w f label under cmd} { +# tkMotifFDialog_MakeSList -- +# +# Create a scrolled-listbox and set the keyboard accelerator +# bindings so that the list selection follows what the user +# types. +# +# Arguments: +# w Pathname of the dialog box. +# f Frame widget inside which to create the scrolled +# listbox. This frame widget already exists. +# label The string to display on top of the listbox. +# under Sets the -under option of the label. +# cmdPrefix Specifies procedures to call when the listbox is +# browsed or activated. + +proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} { label $f.lab -text $label -under $under -anchor w listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\ -xscrollcommand "$f.h set" \ @@ -283,13 +344,14 @@ proc tkMotifFDialog_MakeSList {w f label under cmd} { # bindings for the listboxes # set list $f.l - bind $list <Up> "tkMotifFDialog_Browse$cmd $w" - bind $list <Down> "tkMotifFDialog_Browse$cmd $w" - bind $list <space> "tkMotifFDialog_Browse$cmd $w" - bind $list <1> "tkMotifFDialog_Browse$cmd $w" - bind $list <B1-Motion> "tkMotifFDialog_Browse$cmd $w" - bind $list <Double-1> "tkMotifFDialog_Activate$cmd $w" - bind $list <Return> "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w" + bind $list <Up> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <Down> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <space> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <1> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <B1-Motion> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <Double-ButtonRelease-1> "tkMotifFDialog_Activate$cmdPrefix $w" + bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix $w; \ + tkMotifFDialog_Activate$cmdPrefix $w" bindtags $list "Listbox $list [winfo toplevel $list] all" tkListBoxKeyAccel_Set $list @@ -297,6 +359,168 @@ proc tkMotifFDialog_MakeSList {w f label under cmd} { return $f.l } +# tkMotifFDialog_InterpFilter -- +# +# Interpret the string in the filter entry into two components: +# the directory and the pattern. If the string is a relative +# pathname, give a warning to the user and restore the pattern +# to original. +# +# Arguments: +# w pathname of the dialog box. +# +# Results: +# A list of two elements. The first element is the directory +# specified # by the filter. The second element is the filter +# pattern itself. + +proc tkMotifFDialog_InterpFilter {w} { + upvar #0 [winfo name $w] data + + set text [string trim [$data(fEnt) get]] + + # Perform tilde substitution + # + set badTilde 0 + if {[string compare [string index $text 0] ~] == 0} { + set list [file split $text] + set tilde [lindex $list 0] + if [catch {set tilde [glob $tilde]}] { + set badTilde 1 + } else { + set text [eval file join [concat $tilde [lrange $list 1 end]]] + } + } + + # If the string is a relative pathname, combine it + # with the current selectPath. + + set relative 0 + if {[file pathtype $text] == "relative"} { + set relative 1 + } elseif {$badTilde} { + set relative 1 + } + + if {$relative} { + tk_messageBox -icon warning -type ok \ + -message "\"$text\" must be an absolute pathname" + + $data(fEnt) delete 0 end + $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \ + $data(filter)] + + return [list $data(selectPath) $data(filter)] + } + + set resolved [tkFDialog_JoinFile [file dirname $text] [file tail $text]] + + if [file isdirectory $resolved] { + set dir $resolved + set fil $data(filter) + } else { + set dir [file dirname $resolved] + set fil [file tail $resolved] + } + + return [list $dir $fil] +} + +# tkMotifFDialog_Update +# +# Load the files and synchronize the "filter" and "selection" fields +# boxes. +# +# Arguments: +# w pathname of the dialog box. +# +# Results: +# None. + +proc tkMotifFDialog_Update {w} { + upvar #0 [winfo name $w] data + + $data(fEnt) delete 0 end + $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)] + $data(sEnt) delete 0 end + $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \ + $data(selectFile)] + + tkMotifFDialog_LoadFiles $w +} + +# tkMotifFDialog_LoadFiles -- +# +# Loads the files and directories into the two listboxes according +# to the filter setting. +# +# Arguments: +# w pathname of the dialog box. +# +# Results: +# None. + +proc tkMotifFDialog_LoadFiles {w} { + upvar #0 [winfo name $w] data + + $data(dList) delete 0 end + $data(fList) delete 0 end + + set appPWD [pwd] + if [catch { + cd $data(selectPath) + }] { + cd $appPWD + + $data(dList) insert end ".." + return + } + + # Make the dir list + # + foreach f [lsort -dictionary [glob -nocomplain .* *]] { + if [file isdir ./$f] { + $data(dList) insert end $f + } + } + # Make the file list + # + if ![string compare $data(filter) *] { + set files [lsort -dictionary [glob -nocomplain .* *]] + } else { + set files [lsort -dictionary \ + [glob -nocomplain $data(filter)]] + } + + set top 0 + foreach f $files { + if ![file isdir ./$f] { + regsub {^[.]/} $f "" f + $data(fList) insert end $f + if [string match .* $f] { + incr top + } + } + } + + # The user probably doesn't want to see the . files. We adjust the view + # so that the listbox displays all the non-dot files + $data(fList) yview $top + + cd $appPWD +} + +# tkMotifFDialog_BrowseFList -- +# +# This procedure is called when the directory list is browsed +# (clicked-over) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + proc tkMotifFDialog_BrowseDList {w} { upvar #0 [winfo name $w] data @@ -316,14 +540,15 @@ proc tkMotifFDialog_BrowseDList {w} { switch -- $subdir { . { - set newSpec [file join $data(selectPath) $data(filter)] + set newSpec [tkFDialog_JoinFile $data(selectPath) $data(filter)] } .. { - set newSpec [file join [file dirname $data(selectPath)] \ + set newSpec [tkFDialog_JoinFile [file dirname $data(selectPath)] \ $data(filter)] } default { - set newSpec [file join $data(selectPath) $subdir $data(filter)] + set newSpec [tkFDialog_JoinFile [tkFDialog_JoinFile \ + $data(selectPath) $subdir] $data(filter)] } } @@ -331,6 +556,17 @@ proc tkMotifFDialog_BrowseDList {w} { $data(fEnt) insert 0 $newSpec } +# tkMotifFDialog_ActivateDList -- +# +# This procedure is called when the directory list is activated +# (double-clicked) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + proc tkMotifFDialog_ActivateDList {w} { upvar #0 [winfo name $w] data @@ -352,7 +588,7 @@ proc tkMotifFDialog_ActivateDList {w} { set newDir [file dirname $data(selectPath)] } default { - set newDir [file join $data(selectPath) $subdir] + set newDir [tkFDialog_JoinFile $data(selectPath) $subdir] } } @@ -368,6 +604,17 @@ proc tkMotifFDialog_ActivateDList {w} { } } +# tkMotifFDialog_BrowseFList -- +# +# This procedure is called when the file list is browsed +# (clicked-over) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + proc tkMotifFDialog_BrowseFList {w} { upvar #0 [winfo name $w] data @@ -383,14 +630,26 @@ proc tkMotifFDialog_BrowseFList {w} { $data(dList) selection clear 0 end $data(fEnt) delete 0 end - $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)] + $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)] $data(fEnt) xview end $data(sEnt) delete 0 end - $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)] + $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \ + $data(selectFile)] $data(sEnt) xview end } +# tkMotifFDialog_ActivateFList -- +# +# This procedure is called when the file list is activated +# (double-clicked) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + proc tkMotifFDialog_ActivateFList {w} { upvar #0 [winfo name $w] data @@ -405,6 +664,18 @@ proc tkMotifFDialog_ActivateFList {w} { } } +# tkMotifFDialog_ActivateFEnt -- +# +# This procedure is called when the user presses Return inside +# the "filter" entry. It updates the dialog according to the +# text inside the filter entry. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + proc tkMotifFDialog_ActivateFEnt {w} { upvar #0 [winfo name $w] data @@ -415,34 +686,18 @@ proc tkMotifFDialog_ActivateFEnt {w} { tkMotifFDialog_Update $w } -proc tkMotifFDialog_InterpFilter {w} { - upvar #0 [winfo name $w] data - - set text [string trim [$data(fEnt) get]] - # Perform tilde substitution - # - if {![string compare [string index $text 0] ~]} { - set list [file split $text] - set tilde [lindex $list 0] - catch { - set tilde [glob $tilde] - } - set text [eval file join [concat $tilde [lrange $list 1 end]]] - } - - set resolved [file join [file dirname $text] [file tail $text]] - - if {[file isdirectory $resolved]} { - set dir $resolved - set fil $data(filter) - } else { - set dir [file dirname $resolved] - set fil [file tail $resolved] - } - - return [list $dir $fil] -} - +# tkMotifFDialog_ActivateSEnt -- +# +# This procedure is called when the user presses Return inside +# the "selection" entry. It sets the tkPriv(selectFilePath) global +# variable so that the vwait loop in tkMotifFDialog will be +# terminated. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. proc tkMotifFDialog_ActivateSEnt {w} { global tkPriv @@ -452,7 +707,6 @@ proc tkMotifFDialog_ActivateSEnt {w} { set selectFile [file tail $selectFilePath] set selectPath [file dirname $selectFilePath] - if {![string compare $selectFilePath ""]} { tkMotifFDialog_FilterCmd $w return @@ -522,75 +776,6 @@ proc tkMotifFDialog_CancelCmd {w} { set tkPriv(selectPath) "" } -# tkMotifFDialog_Update -# -# Load the files and synchronize the "filter" and "selection" fields -# boxes. -# -# popup: -# If this is true, then update the selection field according to the -# "-selection" flag -# -proc tkMotifFDialog_Update {w} { - upvar #0 [winfo name $w] data - - $data(fEnt) delete 0 end - $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)] - $data(sEnt) delete 0 end - $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)] - - tkMotifFDialog_LoadFiles $w -} - -proc tkMotifFDialog_LoadFiles {w} { - upvar #0 [winfo name $w] data - - $data(dList) delete 0 end - $data(fList) delete 0 end - - set appPWD [pwd] - if {[catch { - cd $data(selectPath) - }]} { - cd $appPWD - - $data(dList) insert end ".." - return - } - - # Make the dir list - # - foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] { - if {[file isdirectory $f]} { - $data(dList) insert end $f - } - } - # Make the file list - # - if {![string compare $data(filter) *]} { - set files [lsort -command tclSortNoCase [glob -nocomplain .* *]] - } else { - set files [lsort -command tclSortNoCase \ - [glob -nocomplain $data(filter)]] - } - - set top 0 - foreach f $files { - if {![file isdir $f]} { - $data(fList) insert end $f - if {[string match .* $f]} { - incr top - } - } - } - - # The user probably doesn't want to see the . files. We adjust the view - # so that the listbox displays all the non-dot files - $data(fList) yview $top - - cd $appPWD -} - proc tkListBoxKeyAccel_Set {w} { bind Listbox <Any-KeyPress> "" bind $w <Destroy> "tkListBoxKeyAccel_Unset $w" @@ -605,6 +790,20 @@ proc tkListBoxKeyAccel_Unset {w} { catch {unset tkPriv(lbAccel,$w,afterId)} } +# tkListBoxKeyAccel_Key-- +# +# This procedure maintains a list of recently entered keystrokes +# over a listbox widget. It arranges an idle event to move the +# selection of the listbox to the entry that begins with the +# keystrokes. +# +# Arguments: +# w The pathname of the listbox. +# key The key which the user just pressed. +# +# Results: +# None. + proc tkListBoxKeyAccel_Key {w key} { global tkPriv @@ -1,4 +1,4 @@ -Tk 8.0.5 for Macintosh +Tk 8.1 for Macintosh by Ray Johnson Scriptics Corporation @@ -8,7 +8,7 @@ Jim Ingham Cygnus Solutions jingham@cygnus.com -RCS: @(#) $Id: README,v 1.7 1999/04/16 01:25:54 stanton Exp $ +RCS: @(#) $Id: README,v 1.8 1999/04/16 01:51:29 stanton Exp $ 1. Introduction --------------- @@ -22,51 +22,12 @@ directory. 2. What's new? ------------- -Native Look & Feel!!! We now try really hard to support the -Macintosh Look & Feel with Tcl/Tk 8.0. We aren't finished but -it look pretty good. Let me know what are the most "un-mac like" -problems and I'll fix them as quickly as I can. - -The button, checkbutton, radiobutton, and scrollbar widgets actually -use the Mac toolbox controls. This means that they will track the -look&feel if you use extension that change the appearance of -applications (like Aaron.) We also use "system" colors so the default -backgrounds etc. will also change colors. We plan to support this -feature - so let me know if something doesn't work quite right. -Unfortunantly, we are not able to change the colors of buttons under -MacOS 8. Doing this is discouraged under Appearance, and we will probably -not implement it anytime soon. - -We also now support native menus! By using the new -menu option -on toplevels you can have a menubar that is cross platform. You -can also place Tk menus in the Apple and Help menus! Check out -the documentation for more details. Syd Polk <icepick@eng.sun.com> is -the author of the new menu code. Feel free to contact him if you -have questions or comments about the menu mechanism. - -As of Tk 8.0.4, MacTk menus will adopt the backgrounds, shape, separator, etc -of the current theme. - -The "tk_messageBox" command on the Macintosh is now much more -mac-like. I'll probably still need to adjust this more - but it -looks a hell of alot better than it did before. - -I've also added a command that allows you to get more native window -styles. However, we have yet to decide on a cross platform solution -to the problem of varying window styles. None the less, I thought -it would be use full to add the capability in an unsupported means -to tide you over until a better solution is available. The command -is called "unsupported1". It can be used in the following way: - - toplevel .foo; unsupported1 style .foo zoomDocProc - -The above command will create a document window with a zoom box. -Type "unsupported1 style . ???" to get a list of the supported -styles. The command works like "wm overrideredirect" - you must -make the call before the window is mapped. - -As always - report the bugs you find - including asthetic ones -in the look & feel of widgets. +All the widgets will now display internationalized text! + +The widget configuration package has been changed to support the new object +model introduced with the 8.0 compiler. For now the old configuration +package is retained, and in fact, only the menu and button widgets use +the new package. 3. Mac specific features ------------------------ @@ -99,8 +60,8 @@ pointers to where you can find more information about the feature. Mac version of Tk allows you to use several Mac specific icons. See the GetBitmap.3 man page for a complete list. -* The send command does not yet work on the Macintosh. We hope to - have it available in Tk 8.1. +* The send command works among interpreters in the same application. We hope to + have the complete implementation available in Tk 8.1. * The -use and -container options almost work. The focus bugs that were in Tk8.0 final have been fixed. But there are still some @@ -114,7 +75,7 @@ Macintosh Tk is distributed in three different forms. This should make it easier to only download what you need. The packages are as follows: -mactk8.0.5.sea.hqx +mactk8.1.sea.hqx This distribution is a "binary" only release. It contains an installer program that will install a 68k, PowerPC, or Fat @@ -122,13 +83,13 @@ mactk8.0.5.sea.hqx the Tcl & Tk libraries in the Extensions folder inside your System Folder. (No "INIT"'s or Control Pannels are installed.) -mactcltk-full-8.0.5.sea.hqx +mactcltk-full-8.1.sea.hqx This release contains the full release of Tcl and Tk for the Macintosh plus the More Files package on which Macintosh Tcl and Tk rely. -mactk-source-8.0.5.sea.hqx +mactk-source-8.1.sea.hqx This release contains the complete source to Tk for the Macintosh In addition, Metrowerks CodeWarrior libraries and project files @@ -163,7 +124,7 @@ developed. We are working are having better documentation for the Macintosh platform in the future. However, if you have WWW access you may access the Man pages at the following URL: - http://www.scriptics.com/man/tcl8.0/contents.html + http://www.scriptics.com/man/tcl8.1/contents.html Other documentation and sample Tcl scripts can be found at the Tcl ftp site: @@ -180,18 +141,15 @@ available (see below). In order to compile Macintosh Tk you must have the following items: - CodeWarrior Pro 1 or higher (CodeWarrior release 9 or higher can work - and we have project files, but we are depricating support) - 8.0.5 was build with CW Pro 4. - Mac Tcl 8.0 (source) - (which requires More Files 1.4.2 or greater - except not 1.4.4) - Mac Tk 8.0 (source) + CodeWarrior Pro 3 or higher + Mac Tcl 8.1 (source) + (which requires More Files 1.4.2 or 1.4.3) + Mac Tk 8.1 (source) The project files included with the Mac Tcl source should work fine. The only thing you may need to update are the access paths. -As with Tcl, there is something in the initial release of the CW Pro 2 -linker that rendersthe CFM68K version of Wish very unstable. I am -working with Metrowerks to resolve the issue. +As with Tcl, you need to upgrade to the 2.0.1 version of the C +compilers or later to build the CFM68K version of Tcl/Tk. Special notes: @@ -203,20 +161,18 @@ Special notes: to the menu system, though you have to have Appearance 1.0.1 or later installed for this to work. -* If you get the Unix tar file, it will untar into a directory - tcl8.0.5. However, the Macintosh project files expect the folder to - be called tcl8.0. You will need to rename the folder to tcl8.0, or - change all the paths in the project files. +* If you get the Unix tar file, it will untar into a directory tcl8.0.4. However, + the Macintosh project files expect the folder to be called tcl8.0. You will need + to rename the folder to tcl8.0, or change all the paths in the project files. + 7. About Dialog --------------- -There is now a way to replace the default dialog box for the Wish -application. If you create the tcl procedure "tkAboutDialog" it will -be called instead of creating the default dialog box. Your procedure -is then responsible for displaying a window, removing it, etc. This -interface is experimental and may change in the future - tell me what -you think of it. +The prefered method for replacing the about dialog is to replace the +main menubar of the application, using the -menu option for the "." +window. Then add a cascade called .mainMenu.apple to your mainMenu, +and you can put an about item in here WITH YOUR OWN LABEL! 8. Apple Events --------------- @@ -304,3 +260,8 @@ future. If you have comments or Bug reports send them to: Jim Ingham jingham@cygnus.com + +or use our on-line bug form at + +http://www.scriptics.com/support/bugForm.html + diff --git a/mac/bugs.doc b/mac/bugs.doc index 071153e..a405487 100644 --- a/mac/bugs.doc +++ b/mac/bugs.doc @@ -4,7 +4,7 @@ by Ray Johnson Sun Microsystems Laboratories rjohnson@eng.sun.com -RCS: @(#) $Id: bugs.doc,v 1.3 1998/11/12 05:59:07 jingham Exp $ +RCS: @(#) $Id: bugs.doc,v 1.4 1999/04/16 01:51:29 stanton Exp $ We are now very close to passing the test suite for Tk. We are very interested in finding remaining bugs that still linger. Please let us @@ -26,7 +26,11 @@ Known bugs: container, so you can watch that instead. All the focus bugs in Tk8.0 have been fixed, however. -* The send command is not yet implemented. +* The send command is only implemented within the same app. + +* You cannot color buttons, and the indicators for radiobuttons and + checkbuttons under Appearance. They will always use the current + Theme color. But, then, you are not supposed to... * Drawing is not really correct. This shows up mostly in the canvas when line widths are greater than one. Unfortunantly, this will not diff --git a/mac/tkMac.h b/mac/tkMac.h index 4c3d362..214822a 100644 --- a/mac/tkMac.h +++ b/mac/tkMac.h @@ -1,5 +1,5 @@ /* - * Tkmacint.h -- + * tkMacInt.h -- * * Declarations of Macintosh specific exported variables and procedures. * @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMac.h,v 1.5 1999/03/10 07:04:44 stanton Exp $ + * RCS: @(#) $Id: tkMac.h,v 1.6 1999/04/16 01:51:29 stanton Exp $ */ #ifndef _TKMAC @@ -44,11 +44,11 @@ typedef int (Tk_MacEmbedMakeContainerExistProc) (Tk_Window window); typedef void (Tk_MacEmbedGetClipProc) (Tk_Window window, RgnHandle rgn); typedef void (Tk_MacEmbedGetOffsetInParentProc) (Tk_Window window, Point *ulCorner); -/* - * Mac Specific functions that are available to extension writers. +/* + * These functions are currently in tkMacInt.h. They are just copied over here + * so they can be exported. */ -#include "tkPlatDecls.h" #pragma export reset diff --git a/mac/tkMacAppInit.c b/mac/tkMacAppInit.c index e95e448..16e83c0 100644 --- a/mac/tkMacAppInit.c +++ b/mac/tkMacAppInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacAppInit.c,v 1.7 1999/04/16 01:25:54 stanton Exp $ + * RCS: @(#) $Id: tkMacAppInit.c,v 1.8 1999/04/16 01:51:29 stanton Exp $ */ #include <Gestalt.h> @@ -26,14 +26,14 @@ #include "tclMac.h" #ifdef TK_TEST -EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TK_TEST */ #ifdef TCL_TEST -EXTERN int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); +extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TCL_TEST */ Tcl_Interp *gStdoutInterp = NULL; @@ -111,7 +111,7 @@ main( * * Results: * Returns a standard Tcl completion code, and leaves an error - * message in interp->result if an error occurs. + * message in the interp's result if an error occurs. * * Side effects: * Depends on the startup script. @@ -325,7 +325,7 @@ SetupMainInterp( return TCL_OK; error: - panic(interp->result); + panic(Tcl_GetStringResult(interp)); return TCL_ERROR; } diff --git a/mac/tkMacBitmap.c b/mac/tkMacBitmap.c index 6f09434..0b71837 100644 --- a/mac/tkMacBitmap.c +++ b/mac/tkMacBitmap.c @@ -3,12 +3,12 @@ * * This file handles the implementation of native bitmaps. * - * Copyright (c) 1996 Sun Microsystems, Inc. + * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacBitmap.c,v 1.2 1998/09/14 18:23:34 stanton Exp $ + * RCS: @(#) $Id: tkMacBitmap.c,v 1.3 1999/04/16 01:51:29 stanton Exp $ */ #include "tkPort.h" @@ -82,7 +82,7 @@ static BuiltInIcon builtInIcons[] = { * * Results: * A standard Tcl result. If an error occurs then TCL_ERROR is - * returned and a message is left in interp->result. + * returned and a message is left in the interp's result. * * Side effects: * "Name" is entered into the bitmap table and may be used from @@ -100,10 +100,14 @@ TkpDefineNativeBitmaps() char * name; BuiltInIcon *builtInPtr; NativeIcon *nativeIconPtr; + Tcl_HashTable *tablePtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (builtInPtr = builtInIcons; builtInPtr->name != NULL; builtInPtr++) { name = Tk_GetUid(builtInPtr->name); - predefHashPtr = Tcl_CreateHashEntry(&tkPredefBitmapTable, name, &new); + tablePtr = TkGetBitmapPredefTable(); + predefHashPtr = Tcl_CreateHashEntry(tablePtr, name, &new); if (!new) { continue; } @@ -128,7 +132,7 @@ TkpDefineNativeBitmaps() * * Results: * A standard Tcl result. If an error occurs then TCL_ERROR is - * returned and a message is left in interp->result. + * returned and a message is left in the interp's result. * * Side effects: * "Name" is entered into the bitmap table and may be used from @@ -188,7 +192,7 @@ TkpCreateNativeBitmap( * * Results: * A standard Tcl result. If an error occurs then TCL_ERROR is - * returned and a message is left in interp->result. + * returned and a message is left in the interp's result. * * Side effects: * "Name" is entered into the bitmap table and may be used from @@ -210,19 +214,28 @@ TkpGetNativeAppBitmap( GWorldPtr destPort; Rect destRect; Handle resource; - int type; + int type, destWrote; + Str255 nativeName; + + /* + * macRoman is the encoding that the resource fork uses. + */ + + Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), name, + strlen(name), 0, NULL, + (char *) &nativeName[1], + 255, NULL, &destWrote, NULL); /* Internalize native */ + nativeName[0] = destWrote; - c2pstr(name); - resource = GetNamedResource('cicn', (StringPtr) name); + resource = GetNamedResource('cicn', nativeName); if (resource != NULL) { type = TYPE3; } else { - resource = GetNamedResource('ICON', (StringPtr) name); + resource = GetNamedResource('ICON', nativeName); if (resource != NULL) { type = TYPE2; } } - p2cstr((StringPtr) name); if (resource == NULL) { return NULL; diff --git a/mac/tkMacButton.c b/mac/tkMacButton.c index 237f0b2..cdc609b 100644 --- a/mac/tkMacButton.c +++ b/mac/tkMacButton.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacButton.c,v 1.4 1999/04/16 01:25:54 stanton Exp $ + * RCS: @(#) $Id: tkMacButton.c,v 1.5 1999/04/16 01:51:29 stanton Exp $ */ #include "tkButton.h" @@ -28,7 +28,7 @@ #define DRAW_LABEL 0 /* Labels are treated genericly. */ #define DRAW_CONTROL 1 /* Draw using the Native control. */ #define DRAW_CUSTOM 2 /* Make our own button drawing. */ -#define DRAW_BEVEL 3 +#define DRAW_BEVEL 3 /* * The following structures are used to draw our controls. Rather than @@ -85,17 +85,17 @@ static pascal void UserPaneBackgroundProc(ControlHandle, */ static int UpdateControlColors _ANSI_ARGS_((TkButton *butPtr, - ControlRef controlHandle, CCTabHandle ccTabHandle, - RGBColor *saveColorPtr)); + ControlRef controlHandle, CCTabHandle ccTabHandle, + RGBColor *saveColorPtr)); static void DrawBufferedControl _ANSI_ARGS_((TkButton *butPtr, - GWorldPtr destPort, GC gc, Pixmap pixmap)); + GWorldPtr destPort, GC gc, Pixmap pixmap)); static void InitSampleControls(); static void SetupBevelButton _ANSI_ARGS_((TkButton *butPtr, - ControlRef controlHandle, - GWorldPtr destPort, GC gc, Pixmap pixmap)); + ControlRef controlHandle, + GWorldPtr destPort, GC gc, Pixmap pixmap)); static void ChangeBackgroundWindowColor _ANSI_ARGS_(( - WindowRef macintoshWindow, RGBColor rgbColor, - RGBColor *oldColor)); + WindowRef macintoshWindow, RGBColor rgbColor, + RGBColor *oldColor)); static void ButtonExitProc _ANSI_ARGS_((ClientData clientData)); /* @@ -193,17 +193,17 @@ TkpDisplayButton( offset = (butPtr->type == TYPE_BUTTON) && hasImageOrBitmap; border = butPtr->normalBorder; - if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) { + if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { gc = butPtr->disabledGC; } else if ((butPtr->type == TYPE_BUTTON) - && (butPtr->state == tkActiveUid)) { + && (butPtr->state == STATE_ACTIVE)) { gc = butPtr->activeTextGC; border = butPtr->activeBorder; } else { gc = butPtr->normalTextGC; } - if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid) + if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE) && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) { border = butPtr->selectBorder; } @@ -218,10 +218,10 @@ TkpDisplayButton( relief = butPtr->relief; if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) { - if (!TkMacHaveAppearance() || !hasImageOrBitmap) { + if (!TkMacHaveAppearance() || !hasImageOrBitmap) { relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN - : TK_RELIEF_RAISED; - } + : TK_RELIEF_RAISED; + } } /* @@ -230,11 +230,11 @@ TkpDisplayButton( */ if (butPtr->type == TYPE_BUTTON) { - Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0, - Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); } else { - Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0, - Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); } if (butPtr->type == TYPE_LABEL) { @@ -251,21 +251,21 @@ TkpDisplayButton( * does not record this call, and so we can't use the * Appearance bevel button here. The only case that would * exercise this is if you use a bitmap, with - * -data & -mask specified. We should probably draw the + * -data & -mask specified. We should probably draw the * appearance button and overprint the image in this case. * This just punts and draws the old-style, ugly, button. */ if (gc->clip_mask == 0) { - drawType = DRAW_BEVEL; + drawType = DRAW_BEVEL; } else { - TkpClipMask *clipPtr = (TkpClipMask*) gc->clip_mask; - if ((clipPtr->type == TKP_CLIP_PIXMAP) && - (clipPtr->value.pixmap != butPtr->bitmap)) { - drawType = DRAW_CUSTOM; - } else { - drawType = DRAW_BEVEL; - } + TkpClipMask *clipPtr = (TkpClipMask*) gc->clip_mask; + if ((clipPtr->type == TKP_CLIP_PIXMAP) && + (clipPtr->value.pixmap != butPtr->bitmap)) { + drawType = DRAW_CUSTOM; + } else { + drawType = DRAW_BEVEL; + } } } } else { @@ -273,15 +273,15 @@ TkpDisplayButton( drawType = DRAW_CONTROL; } else if (hasImageOrBitmap) { if (gc->clip_mask == 0) { - drawType = DRAW_BEVEL; + drawType = DRAW_BEVEL; } else { - TkpClipMask *clipPtr = (TkpClipMask*) gc->clip_mask; - if ((clipPtr->type == TKP_CLIP_PIXMAP) && - (clipPtr->value.pixmap != butPtr->bitmap)) { - drawType = DRAW_CUSTOM; - } else { - drawType = DRAW_BEVEL; - } + TkpClipMask *clipPtr = (TkpClipMask*) gc->clip_mask; + if ((clipPtr->type == TKP_CLIP_PIXMAP) && + (clipPtr->value.pixmap != butPtr->bitmap)) { + drawType = DRAW_CUSTOM; + } else { + drawType = DRAW_BEVEL; + } } } else { drawType = DRAW_CUSTOM; @@ -289,13 +289,13 @@ TkpDisplayButton( } /* - * Draw the native portion of the buttons. Start by creating the control + * Draw the native portion of the buttons. Start by creating the control * if it doesn't already exist. Then configure the Macintosh control from * the Tk info. Finally, we call Draw1Control to draw to the screen. */ if ((drawType == DRAW_CONTROL) || - ((drawType == DRAW_BEVEL) && TkMacHaveAppearance())) { + ((drawType == DRAW_BEVEL) && TkMacHaveAppearance())) { borderWidth = 0; /* @@ -319,7 +319,7 @@ TkpDisplayButton( */ if ((drawType == DRAW_BEVEL) && TkMacHaveAppearance()) { - /* Empty Body */ + /* Empty Body */ } else if (butPtr->image != None) { Tk_SizeOfImage(butPtr->image, &width, &height); @@ -369,12 +369,12 @@ TkpDisplayButton( /* * If the button is disabled with a stipple rather than a special - * foreground color, generate the stippled effect. If the widget + * foreground color, generate the stippled effect. If the widget * is selected and we use a different background color when selected, * must temporarily modify the GC. */ - if ((butPtr->state == tkDisabledUid) + if ((butPtr->state == STATE_DISABLED) && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) { if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn && (butPtr->selectBorder != NULL)) { @@ -471,7 +471,7 @@ TkpComputeButtonGeometry( } else { Tk_FreeTextLayout(butPtr->textLayout); butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, - butPtr->text, -1, butPtr->wrapLength, + Tcl_GetString(butPtr->text), -1, butPtr->wrapLength, butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); width = butPtr->textWidth; @@ -504,7 +504,7 @@ TkpComputeButtonGeometry( /* * The width and height calculation for Appearance buttons with images & - * non-Appearance buttons with images is different. In the latter case, + * non-Appearance buttons with images is different. In the latter case, * we add the borderwidth to the inset, since we are going to stamp a * 3-D border over the image. In the former, we add it to the height, * directly, since Appearance will draw the border as part of our control. @@ -516,7 +516,7 @@ TkpComputeButtonGeometry( * * The highlight width corresponds to the default ring on the Macintosh. * As such, the highlight width is only added if the button is the default - * button. The actual width of the default ring is one less than the + * button. The actual width of the default ring is one less than the * highlight width as there is also one pixel of spacing. * Appearance buttons with images do not have a highlight ring, because the * Bevel button type does not support one. @@ -528,48 +528,48 @@ TkpComputeButtonGeometry( } if ((butPtr->type == TYPE_BUTTON)) { - if ((butPtr->image == None) && (butPtr->bitmap == None)) { + if ((butPtr->image == None) && (butPtr->bitmap == None)) { + butPtr->inset = 0; + if (butPtr->defaultState != STATE_DISABLED) { + butPtr->inset += butPtr->highlightWidth; + } + } else if (TkMacHaveAppearance()) { butPtr->inset = 0; - if (butPtr->defaultState != tkDisabledUid) { - butPtr->inset += butPtr->highlightWidth; - } - } else if (TkMacHaveAppearance()) { - butPtr->inset = 0; - width += (2 * butPtr->borderWidth + 4); - height += (2 * butPtr->borderWidth + 4); + width += (2 * butPtr->borderWidth + 4); + height += (2 * butPtr->borderWidth + 4); } else { - butPtr->inset = butPtr->borderWidth; - width += 2; - height += 2; - if (butPtr->defaultState != tkDisabledUid) { - butPtr->inset += butPtr->highlightWidth; - } - } + butPtr->inset = butPtr->borderWidth; + width += 2; + height += 2; + if (butPtr->defaultState != STATE_DISABLED) { + butPtr->inset += butPtr->highlightWidth; + } + } } else if ((butPtr->type != TYPE_LABEL)) { - if (butPtr->indicatorOn) { + if (butPtr->indicatorOn) { butPtr->inset = 0; } else { - /* - * Under Appearance, the Checkbutton or radiobutton with an image - * is represented by a BevelButton with the Sticky defProc... - * So we must set its height in the same way as the Button - * with an image or bitmap. - */ - if (((butPtr->image != None) || (butPtr->bitmap != None)) - && TkMacHaveAppearance()) { - int border; - butPtr->inset = 0; - if ( butPtr->borderWidth <= 2 ) { - border = 6; - } else { - border = 2 * butPtr->borderWidth + 2; - } - width += border; - height += border; - } else { - butPtr->inset = butPtr->borderWidth; - } - } + /* + * Under Appearance, the Checkbutton or radiobutton with an image + * is represented by a BevelButton with the Sticky defProc... + * So we must set its height in the same way as the Button + * with an image or bitmap. + */ + if (((butPtr->image != None) || (butPtr->bitmap != None)) + && TkMacHaveAppearance()) { + int border; + butPtr->inset = 0; + if ( butPtr->borderWidth <= 2 ) { + border = 6; + } else { + border = 2 * butPtr->borderWidth + 2; + } + width += border; + height += border; + } else { + butPtr->inset = butPtr->borderWidth; + } + } } else { butPtr->inset = butPtr->borderWidth; } @@ -629,9 +629,9 @@ DrawBufferedControl( TkButton *butPtr, /* Tk button. */ GWorldPtr destPort, /* Off screen GWorld. */ GC gc, /* The GC we are drawing into - needed for - * the bevel button */ + * the bevel button */ Pixmap pixmap /* The pixmap we are drawing into - needed - for the bevel button */ + for the bevel button */ ) { ControlRef controlHandle; @@ -641,19 +641,19 @@ DrawBufferedControl( int isBevel = 0; if (windowRef == NULL) { - InitSampleControls(); + InitSampleControls(); } /* * Now swap in the passed in GWorld for the portBits of our fake - * window. We also adjust various fields in the WindowRecord to make + * window. We also adjust various fields in the WindowRecord to make * the system think this is a normal window. * Note, we can use DrawControlInCurrentPort under Appearance, so we don't * need to swap pixmaps. */ if (!TkMacHaveAppearance()) { - ((CWindowPeek) windowRef)->port.portPixMap = destPort->portPixMap; + ((CWindowPeek) windowRef)->port.portPixMap = destPort->portPixMap; } ((CWindowPeek) windowRef)->port.portRect = destPort->portRect; @@ -665,90 +665,90 @@ DrawBufferedControl( /* * Set up control in hidden window to match what we need - * to draw in the buffered window. + * to draw in the buffered window. */ isBevel = 0; switch (butPtr->type) { case TYPE_BUTTON: - if (TkMacHaveAppearance()) { - if ((butPtr->image == None) && (butPtr->bitmap == None)) { - controlHandle = buttonHandle; - ccTabHandle = buttonTabHandle; - } else { - if (butPtr->borderWidth <= 2) { - controlHandle = smallBevelHandle; - } else if (butPtr->borderWidth == 3) { - controlHandle = medBevelHandle; - } else { - controlHandle = largeBevelHandle; - } - ccTabHandle = buttonTabHandle; - SetupBevelButton(butPtr, controlHandle, destPort, - gc, pixmap); - isBevel = 1; - } + if (TkMacHaveAppearance()) { + if ((butPtr->image == None) && (butPtr->bitmap == None)) { + controlHandle = buttonHandle; + ccTabHandle = buttonTabHandle; + } else { + if (butPtr->borderWidth <= 2) { + controlHandle = smallBevelHandle; + } else if (butPtr->borderWidth == 3) { + controlHandle = medBevelHandle; + } else { + controlHandle = largeBevelHandle; + } + ccTabHandle = buttonTabHandle; + SetupBevelButton(butPtr, controlHandle, destPort, + gc, pixmap); + isBevel = 1; + } } else { - controlHandle = buttonHandle; - ccTabHandle = buttonTabHandle; + controlHandle = buttonHandle; + ccTabHandle = buttonTabHandle; } break; case TYPE_RADIO_BUTTON: if (TkMacHaveAppearance()) { - if (((butPtr->image == None) && (butPtr->bitmap == None)) - || (butPtr->indicatorOn)) { - controlHandle = radioHandle; - ccTabHandle = radioTabHandle; - } else { - if (butPtr->borderWidth <= 2) { - controlHandle = smallStickyBevelHandle; - } else if (butPtr->borderWidth == 3) { - controlHandle = medStickyBevelHandle; - } else { - controlHandle = largeStickyBevelHandle; - } - ccTabHandle = radioTabHandle; - SetupBevelButton(butPtr, controlHandle, destPort, - gc, pixmap); - isBevel = 1; - } + if (((butPtr->image == None) && (butPtr->bitmap == None)) + || (butPtr->indicatorOn)) { + controlHandle = radioHandle; + ccTabHandle = radioTabHandle; + } else { + if (butPtr->borderWidth <= 2) { + controlHandle = smallStickyBevelHandle; + } else if (butPtr->borderWidth == 3) { + controlHandle = medStickyBevelHandle; + } else { + controlHandle = largeStickyBevelHandle; + } + ccTabHandle = radioTabHandle; + SetupBevelButton(butPtr, controlHandle, destPort, + gc, pixmap); + isBevel = 1; + } } else { - controlHandle = radioHandle; - ccTabHandle = radioTabHandle; - } + controlHandle = radioHandle; + ccTabHandle = radioTabHandle; + } break; case TYPE_CHECK_BUTTON: if (TkMacHaveAppearance()) { - if (((butPtr->image == None) && (butPtr->bitmap == None)) - || (butPtr->indicatorOn)) { - controlHandle = checkHandle; - ccTabHandle = checkTabHandle; - } else { - if (butPtr->borderWidth <= 2) { - controlHandle = smallStickyBevelHandle; - } else if (butPtr->borderWidth == 3) { - controlHandle = medStickyBevelHandle; - } else { - controlHandle = largeStickyBevelHandle; - } - ccTabHandle = checkTabHandle; - SetupBevelButton(butPtr, controlHandle, destPort, - gc, pixmap); - isBevel = 1; - } + if (((butPtr->image == None) && (butPtr->bitmap == None)) + || (butPtr->indicatorOn)) { + controlHandle = checkHandle; + ccTabHandle = checkTabHandle; + } else { + if (butPtr->borderWidth <= 2) { + controlHandle = smallStickyBevelHandle; + } else if (butPtr->borderWidth == 3) { + controlHandle = medStickyBevelHandle; + } else { + controlHandle = largeStickyBevelHandle; + } + ccTabHandle = checkTabHandle; + SetupBevelButton(butPtr, controlHandle, destPort, + gc, pixmap); + isBevel = 1; + } } else { - controlHandle = checkHandle; - ccTabHandle = checkTabHandle; - } + controlHandle = checkHandle; + ccTabHandle = checkTabHandle; + } break; } (**controlHandle).contrlRect.left = butPtr->inset; (**controlHandle).contrlRect.top = butPtr->inset; (**controlHandle).contrlRect.right = Tk_Width(butPtr->tkwin) - - butPtr->inset; + - butPtr->inset; (**controlHandle).contrlRect.bottom = Tk_Height(butPtr->tkwin) - - butPtr->inset; + - butPtr->inset; /* * Setting the control visibility by hand does not @@ -756,16 +756,16 @@ DrawBufferedControl( */ if (TkMacHaveAppearance()) { - SetControlVisibility(controlHandle, true, false); - (**userPaneHandle).contrlRect.left = 0; - (**userPaneHandle).contrlRect.top = 0; - (**userPaneHandle).contrlRect.right = Tk_Width(butPtr->tkwin); - (**userPaneHandle).contrlRect.bottom = Tk_Height(butPtr->tkwin); - } else { - (**controlHandle).contrlVis = 255; - } + SetControlVisibility(controlHandle, true, false); + (**userPaneHandle).contrlRect.left = 0; + (**userPaneHandle).contrlRect.top = 0; + (**userPaneHandle).contrlRect.right = Tk_Width(butPtr->tkwin); + (**userPaneHandle).contrlRect.bottom = Tk_Height(butPtr->tkwin); + } else { + (**controlHandle).contrlVis = 255; + } - + if (butPtr->flags & SELECTED) { (**controlHandle).contrlValue = 1; @@ -773,23 +773,23 @@ DrawBufferedControl( (**controlHandle).contrlValue = 0; } - if (butPtr->state == tkActiveUid) { - if (isBevel) { - (**controlHandle).contrlHilite = kControlButtonPart; - } else { + if (butPtr->state == STATE_ACTIVE) { + if (isBevel) { + (**controlHandle).contrlHilite = kControlButtonPart; + } else { switch (butPtr->type) { - case TYPE_BUTTON: + case TYPE_BUTTON: (**controlHandle).contrlHilite = kControlButtonPart; break; - case TYPE_RADIO_BUTTON: + case TYPE_RADIO_BUTTON: (**controlHandle).contrlHilite = kControlRadioButtonPart; break; - case TYPE_CHECK_BUTTON: + case TYPE_CHECK_BUTTON: (**controlHandle).contrlHilite = kControlCheckBoxPart; break; } } - } else if (butPtr->state == tkDisabledUid) { + } else if (butPtr->state == STATE_DISABLED) { (**controlHandle).contrlHilite = kControlInactivePart; } else { (**controlHandle).contrlHilite = kControlNoPart; @@ -815,36 +815,36 @@ DrawBufferedControl( */ if (TkMacHaveAppearance()) { - SetPort((GrafPort *) destPort); + SetPort((GrafPort *) destPort); } else { - SetPort(windowRef); + SetPort(windowRef); } windowColorChanged = UpdateControlColors(butPtr, controlHandle, - ccTabHandle, &saveBackColor); + ccTabHandle, &saveBackColor); if ((butPtr->type == TYPE_BUTTON) && TkMacHaveAppearance()) { - Boolean isDefault; - - if (butPtr->defaultState == tkActiveUid) { + Boolean isDefault; + + if (butPtr->defaultState == STATE_ACTIVE) { isDefault = true; } else { isDefault = false; } SetControlData(controlHandle, kControlNoPart, - kControlPushButtonDefaultTag, - sizeof(isDefault), (Ptr) &isDefault); + kControlPushButtonDefaultTag, + sizeof(isDefault), (Ptr) &isDefault); } if (TkMacHaveAppearance()) { - DrawControlInCurrentPort(userPaneHandle); + DrawControlInCurrentPort(userPaneHandle); } else { - Draw1Control(controlHandle); + Draw1Control(controlHandle); } if (!TkMacHaveAppearance() && - (butPtr->type == TYPE_BUTTON) && - (butPtr->defaultState == tkActiveUid)) { + (butPtr->type == TYPE_BUTTON) && + (butPtr->defaultState == STATE_ACTIVE)) { Rect box = (**controlHandle).contrlRect; RGBColor rgbColor; @@ -866,13 +866,13 @@ DrawBufferedControl( */ if (TkMacHaveAppearance()) { - SetControlVisibility(controlHandle, false, false); - if (isBevel) { - KillPicture(bevelButtonContent.u.picture); - } - } else { - (**controlHandle).contrlVis = 0; - } + SetControlVisibility(controlHandle, false, false); + if (isBevel) { + KillPicture(bevelButtonContent.u.picture); + } + } else { + (**controlHandle).contrlVis = 0; + } LMSetWindowList((WindowRef) ((CWindowPeek) windowRef)->nextWindow); } @@ -882,8 +882,8 @@ DrawBufferedControl( * InitSampleControls -- * * This function initializes a dummy Macintosh window and - * sample controls to allow drawing Mac controls to any GWorld - * (including off-screen bitmaps). + * sample controls to allow drawing Mac controls to any GWorld + * (including off-screen bitmaps). * * Results: * None. @@ -907,9 +907,9 @@ InitSampleControls() * the data structures attached to it are only deallocated * on exit of the application. */ - + windowRef = NewCWindow(NULL, &geometry, "\pempty", false, - zoomDocProc, (WindowRef) -1, true, 0); + zoomDocProc, (WindowRef) -1, true, 0); if (windowRef == NULL) { panic("Can't allocate buffer window."); } @@ -926,15 +926,15 @@ InitSampleControls() SetPort(windowRef); if (TkMacHaveAppearance()) { - OSErr err; - ControlRef dontCare; - - /* - * Adding UserPaneBackgroundProcs to the root control does - * not seem to work, so we have to add another UserPane to - * the root control. - */ - + + OSErr err; + ControlRef dontCare; + + /* Adding UserPaneBackgroundProcs to the root control does + * not seem to work, so we have to add another UserPane to + * the root control. + */ + err = CreateRootControl(windowRef, &dontCare); if (err != noErr) { panic("Can't create root control in DrawBufferedControl"); @@ -942,60 +942,66 @@ InitSampleControls() userPaneHandle = NewControl(windowRef, &geometry, "\p", true, kControlSupportsEmbedding|kControlHasSpecialBackground, - 0, 1, kControlUserPaneProc, (SInt32) 0); + 0, 1, kControlUserPaneProc, (SInt32) 0); SetUserPaneSetUpSpecialBackgroundProc(userPaneHandle, UserPaneBackgroundProc); SetUserPaneDrawProc(userPaneHandle, UserPaneDraw); buttonHandle = NewControl(windowRef, &geometry, "\p", - false, 1, 0, 1, kControlPushButtonProc, (SInt32) 0); + false, 1, 0, 1, kControlPushButtonProc, (SInt32) 0); EmbedControl(buttonHandle, userPaneHandle); - checkHandle = NewControl(windowRef, &geometry, "\p", - false, 1, 0, 1, kControlCheckBoxProc, (SInt32) 0); + checkHandle = NewControl(windowRef, &geometry, "\p", + false, 1, 0, 1, kControlCheckBoxProc, (SInt32) 0); EmbedControl(checkHandle, userPaneHandle); - radioHandle = NewControl(windowRef, &geometry, "\p", - false, 1, 0, 1, kControlRadioButtonProc, (SInt32) 0); + radioHandle = NewControl(windowRef, &geometry, "\p", + false, 1, 0, 1, kControlRadioButtonProc, (SInt32) 0); EmbedControl(radioHandle, userPaneHandle); - smallBevelHandle = NewControl(windowRef, &geometry, "\p", - false, 0, 0, - kControlBehaviorOffsetContents << 16 | kControlContentPictHandle, - kControlBevelButtonSmallBevelProc, (SInt32) 0); - EmbedControl(smallBevelHandle, userPaneHandle); - medBevelHandle = NewControl(windowRef, &geometry, "\p", - false, 0, 0, - kControlBehaviorOffsetContents << 16 | kControlContentPictHandle, - kControlBevelButtonNormalBevelProc, (SInt32) 0); - EmbedControl(medBevelHandle, userPaneHandle); - largeBevelHandle = NewControl(windowRef, &geometry, "\p", - false, 0, 0, - kControlBehaviorOffsetContents << 16 | kControlContentPictHandle, - kControlBevelButtonLargeBevelProc, (SInt32) 0); - EmbedControl(largeBevelHandle, userPaneHandle); - bevelButtonContent.contentType = kControlContentPictHandle; - smallStickyBevelHandle = NewControl(windowRef, &geometry, "\p", - false, 0, 0, - (kControlBehaviorOffsetContents | kControlBehaviorSticky) << 16 - | kControlContentPictHandle, - kControlBevelButtonSmallBevelProc, (SInt32) 0); - EmbedControl(smallStickyBevelHandle, userPaneHandle); - medStickyBevelHandle = NewControl(windowRef, &geometry, "\p", - false, 0, 0, - (kControlBehaviorOffsetContents | kControlBehaviorSticky) << 16 - | kControlContentPictHandle, - kControlBevelButtonNormalBevelProc, (SInt32) 0); - EmbedControl(medStickyBevelHandle, userPaneHandle); - largeStickyBevelHandle = NewControl(windowRef, &geometry, "\p", - false, 0, 0, - (kControlBehaviorOffsetContents | kControlBehaviorSticky) << 16 - | kControlContentPictHandle, - kControlBevelButtonLargeBevelProc, (SInt32) 0); - EmbedControl(largeStickyBevelHandle, userPaneHandle); + smallBevelHandle = NewControl(windowRef, &geometry, "\p", + false, 0, 0, + kControlBehaviorOffsetContents << 16 + | kControlContentPictHandle, + kControlBevelButtonSmallBevelProc, (SInt32) 0); + EmbedControl(smallBevelHandle, userPaneHandle); + medBevelHandle = NewControl(windowRef, &geometry, "\p", + false, 0, 0, + kControlBehaviorOffsetContents << 16 + | kControlContentPictHandle, + kControlBevelButtonNormalBevelProc, (SInt32) 0); + EmbedControl(medBevelHandle, userPaneHandle); + largeBevelHandle = NewControl(windowRef, &geometry, "\p", + false, 0, 0, + kControlBehaviorOffsetContents << 16 + | kControlContentPictHandle, + kControlBevelButtonLargeBevelProc, (SInt32) 0); + EmbedControl(largeBevelHandle, userPaneHandle); + bevelButtonContent.contentType = kControlContentPictHandle; + smallStickyBevelHandle = NewControl(windowRef, &geometry, "\p", + false, 0, 0, + (kControlBehaviorOffsetContents + | kControlBehaviorSticky) << 16 + | kControlContentPictHandle, + kControlBevelButtonSmallBevelProc, (SInt32) 0); + EmbedControl(smallStickyBevelHandle, userPaneHandle); + medStickyBevelHandle = NewControl(windowRef, &geometry, "\p", + false, 0, 0, + (kControlBehaviorOffsetContents + | kControlBehaviorSticky) << 16 + | kControlContentPictHandle, + kControlBevelButtonNormalBevelProc, (SInt32) 0); + EmbedControl(medStickyBevelHandle, userPaneHandle); + largeStickyBevelHandle = NewControl(windowRef, &geometry, "\p", + false, 0, 0, + (kControlBehaviorOffsetContents + | kControlBehaviorSticky) << 16 + | kControlContentPictHandle, + kControlBevelButtonLargeBevelProc, (SInt32) 0); + EmbedControl(largeStickyBevelHandle, userPaneHandle); - picParams.version = -2; - picParams.hRes = 0x00480000; - picParams.vRes = 0x00480000; - picParams.srcRect.top = 0; - picParams.srcRect.left = 0; + picParams.version = -2; + picParams.hRes = 0x00480000; + picParams.vRes = 0x00480000; + picParams.srcRect.top = 0; + picParams.srcRect.left = 0; ((CWindowPeek) windowRef)->visible = true; } else { @@ -1013,8 +1019,8 @@ InitSampleControls() } /* - * Remove our window from the window list. This way our - * applications ad others will not be confused that this + * Remove our window from the window list. This way our + * applications and others will not be confused that this * window exists - but no one knows about it. */ @@ -1040,9 +1046,9 @@ InitSampleControls() * TODO: The ButtonExitProc doesn't currently work and the * code it includes will crash the Mac on exit from Tk. - oldPixPtr = ((CWindowPeek) windowRef)->port.portPixMap; - Tcl_CreateExitHandler(ButtonExitProc, (ClientData) NULL); - */ + oldPixPtr = ((CWindowPeek) windowRef)->port.portPixMap; + Tcl_CreateExitHandler(ButtonExitProc, (ClientData) NULL); + */ } @@ -1065,12 +1071,12 @@ InitSampleControls() void SetupBevelButton( TkButton *butPtr, /* Tk button. */ - ControlRef controlHandle, /* The control to set this picture to */ + ControlRef controlHandle, /* The control to set this picture to */ GWorldPtr destPort, /* Off screen GWorld. */ GC gc, /* The GC we are drawing into - needed for - * the bevel button */ + * the bevel button */ Pixmap pixmap /* The pixmap we are drawing into - needed - for the bevel button */ + for the bevel button */ ) { int height, width; @@ -1079,13 +1085,13 @@ SetupBevelButton( SetPort((GrafPtr) destPort); if (butPtr->image != None) { - Tk_SizeOfImage(butPtr->image, - &width, &height); + Tk_SizeOfImage(butPtr->image, + &width, &height); } else { - Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, - &width, &height); + Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, + &width, &height); } - + if ((butPtr->width > 0) && (butPtr->width < width)) { width = butPtr->width; } @@ -1105,48 +1111,48 @@ SetupBevelButton( */ if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) { - Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height, - pixmap, 0, 0); + Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height, + pixmap, 0, 0); } else if (butPtr->image != NULL) { - Tk_RedrawImage(butPtr->image, 0, 0, width, - height, pixmap, 0, 0); - } else { - XSetClipOrigin(butPtr->display, gc, 0, 0); - XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0, - (unsigned int) width, (unsigned int) height, 0, 0, 1); + Tk_RedrawImage(butPtr->image, 0, 0, width, + height, pixmap, 0, 0); + } else { + XSetClipOrigin(butPtr->display, gc, 0, 0); + XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0, + (unsigned int) width, (unsigned int) height, 0, 0, 1); } ClosePicture(); SetControlData(controlHandle, kControlButtonPart, - kControlBevelButtonContentTag, - sizeof(ControlButtonContentInfo), - (char *) &bevelButtonContent); - + kControlBevelButtonContentTag, + sizeof(ControlButtonContentInfo), + (char *) &bevelButtonContent); + if (butPtr->anchor == TK_ANCHOR_N) { - theAlignment = kControlBevelButtonAlignTop; - } else if (butPtr->anchor == TK_ANCHOR_NE) { - theAlignment = kControlBevelButtonAlignTopRight; - } else if (butPtr->anchor == TK_ANCHOR_E) { - theAlignment = kControlBevelButtonAlignRight; - } else if (butPtr->anchor == TK_ANCHOR_SE) { - theAlignment = kControlBevelButtonAlignBottomRight; - } else if (butPtr->anchor == TK_ANCHOR_S) { - theAlignment = kControlBevelButtonAlignBottom; - } else if (butPtr->anchor == TK_ANCHOR_SW) { - theAlignment = kControlBevelButtonAlignBottomLeft; - } else if (butPtr->anchor == TK_ANCHOR_W) { - theAlignment = kControlBevelButtonAlignLeft; - } else if (butPtr->anchor == TK_ANCHOR_NW) { - theAlignment = kControlBevelButtonAlignTopLeft; - } else if (butPtr->anchor == TK_ANCHOR_CENTER) { - theAlignment = kControlBevelButtonAlignCenter; + theAlignment = kControlBevelButtonAlignTop; + } else if (butPtr->anchor == TK_ANCHOR_NE) { + theAlignment = kControlBevelButtonAlignTopRight; + } else if (butPtr->anchor == TK_ANCHOR_E) { + theAlignment = kControlBevelButtonAlignRight; + } else if (butPtr->anchor == TK_ANCHOR_SE) { + theAlignment = kControlBevelButtonAlignBottomRight; + } else if (butPtr->anchor == TK_ANCHOR_S) { + theAlignment = kControlBevelButtonAlignBottom; + } else if (butPtr->anchor == TK_ANCHOR_SW) { + theAlignment = kControlBevelButtonAlignBottomLeft; + } else if (butPtr->anchor == TK_ANCHOR_W) { + theAlignment = kControlBevelButtonAlignLeft; + } else if (butPtr->anchor == TK_ANCHOR_NW) { + theAlignment = kControlBevelButtonAlignTopLeft; + } else if (butPtr->anchor == TK_ANCHOR_CENTER) { + theAlignment = kControlBevelButtonAlignCenter; } SetControlData(controlHandle, kControlButtonPart, - kControlBevelButtonGraphicAlignTag, - sizeof(ControlButtonGraphicAlignment), - (char *) &theAlignment); + kControlBevelButtonGraphicAlignTag, + sizeof(ControlButtonGraphicAlignment), + (char *) &theAlignment); } @@ -1156,8 +1162,8 @@ SetupBevelButton( * SetUserPaneDrawProc -- * * Utility function to add a UserPaneDrawProc - * to a userPane control. From MoreControls code - * from Apple DTS. + * to a userPane control. From MoreControls code + * from Apple DTS. * * Results: * MacOS system error. @@ -1168,15 +1174,15 @@ SetupBevelButton( *-------------------------------------------------------------- */ pascal OSErr SetUserPaneDrawProc ( - ControlRef control, - ControlUserPaneDrawProcPtr upp) + ControlRef control, + ControlUserPaneDrawProcPtr upp) { ControlUserPaneDrawUPP myControlUserPaneDrawUPP; myControlUserPaneDrawUPP = NewControlUserPaneDrawProc(upp); return SetControlData (control, - kControlNoPart, kControlUserPaneDrawProcTag, - sizeof(myControlUserPaneDrawUPP), - (Ptr) &myControlUserPaneDrawUPP); + kControlNoPart, kControlUserPaneDrawProcTag, + sizeof(myControlUserPaneDrawUPP), + (Ptr) &myControlUserPaneDrawUPP); } /* @@ -1185,7 +1191,7 @@ pascal OSErr SetUserPaneDrawProc ( * SetUserPaneSetUpSpecialBackgroundProc -- * * Utility function to add a UserPaneBackgroundProc - * to a userPane control + * to a userPane control * * Results: * MacOS system error. @@ -1203,9 +1209,9 @@ SetUserPaneSetUpSpecialBackgroundProc( ControlUserPaneBackgroundUPP myControlUserPaneBackgroundUPP; myControlUserPaneBackgroundUPP = NewControlUserPaneBackgroundProc(upp); return SetControlData (control, kControlNoPart, - kControlUserPaneBackgroundProcTag, - sizeof(myControlUserPaneBackgroundUPP), - (Ptr) &myControlUserPaneBackgroundUPP); + kControlUserPaneBackgroundProcTag, + sizeof(myControlUserPaneBackgroundUPP), + (Ptr) &myControlUserPaneBackgroundUPP); } /* @@ -1214,7 +1220,7 @@ SetUserPaneSetUpSpecialBackgroundProc( * UserPaneDraw -- * * This function draws the background of the user pane that will - * lie under checkboxes and radiobuttons. + * lie under checkboxes and radiobuttons. * * Results: * None. @@ -1229,9 +1235,9 @@ UserPaneDraw( ControlRef control, ControlPartCode cpc) { - Rect contrlRect = (**control).contrlRect; - RGBBackColor (&gUserPaneBackground); - EraseRect (&contrlRect); + Rect contrlRect = (**control).contrlRect; + RGBBackColor (&gUserPaneBackground); + EraseRect (&contrlRect); } /* @@ -1240,7 +1246,7 @@ UserPaneDraw( * UserPaneBackgroundProc -- * * This function sets up the background of the user pane that will - * lie under checkboxes and radiobuttons. + * lie under checkboxes and radiobuttons. * * Results: * None. @@ -1257,7 +1263,7 @@ UserPaneBackgroundProc( ControlBackgroundPtr info) { if (info->colorDevice) { - RGBBackColor (&gUserPaneBackground); + RGBBackColor (&gUserPaneBackground); } } @@ -1271,8 +1277,8 @@ UserPaneBackgroundProc( * used we create a custom palette for the button, populate * with the colors for the button and install the palette. * - * Under Appearance, we just set the pointer that will be - * used by the UserPaneDrawProc. + * Under Appearance, we just set the pointer that will be + * used by the UserPaneDrawProc. * * Results: * None. @@ -1295,7 +1301,7 @@ UpdateControlColors( /* * Under Appearance we cannot change the background of the * button itself. However, the color we are setting is the color - * of the containing userPane. This will be the color that peeks + * of the containing userPane. This will be the color that peeks * around the rounded corners of the button. * We make this the highlightbackground rather than the background, * because if you color the background of a frame containing a @@ -1304,38 +1310,37 @@ UpdateControlColors( */ if (TkMacHaveAppearance() && (butPtr->type == TYPE_BUTTON)) { - xcolor = Tk_3DBorderColor(butPtr->highlightBorder); + xcolor = Tk_3DBorderColor(butPtr->highlightBorder); } else { - xcolor = Tk_3DBorderColor(butPtr->normalBorder); + xcolor = Tk_3DBorderColor(butPtr->normalBorder); } if (TkMacHaveAppearance()) { - TkSetMacColor(xcolor->pixel, &gUserPaneBackground); + TkSetMacColor(xcolor->pixel, &gUserPaneBackground); } else { (**ccTabHandle).ccSeed = 0; - (**ccTabHandle).ccRider = 0; - (**ccTabHandle).ctSize = 3; - (**ccTabHandle).ctTable[0].value = cBodyColor; - TkSetMacColor(xcolor->pixel, + (**ccTabHandle).ccRider = 0; + (**ccTabHandle).ctSize = 3; + (**ccTabHandle).ctTable[0].value = cBodyColor; + TkSetMacColor(xcolor->pixel, &(**ccTabHandle).ctTable[0].rgb); - (**ccTabHandle).ctTable[1].value = cTextColor; - TkSetMacColor(butPtr->normalFg->pixel, + (**ccTabHandle).ctTable[1].value = cTextColor; + TkSetMacColor(butPtr->normalFg->pixel, &(**ccTabHandle).ctTable[1].rgb); - (**ccTabHandle).ctTable[2].value = cFrameColor; - TkSetMacColor(butPtr->highlightColorPtr->pixel, + (**ccTabHandle).ctTable[2].value = cFrameColor; + TkSetMacColor(butPtr->highlightColorPtr->pixel, &(**ccTabHandle).ctTable[2].rgb); - SetControlColor(controlHandle, ccTabHandle); - - if (((xcolor->pixel >> 24) != CONTROL_BODY_PIXEL) && - ((butPtr->type == TYPE_CHECK_BUTTON) || - (butPtr->type == TYPE_RADIO_BUTTON))) { + SetControlColor(controlHandle, ccTabHandle); + + if (((xcolor->pixel >> 24) != CONTROL_BODY_PIXEL) && + ((butPtr->type == TYPE_CHECK_BUTTON) || + (butPtr->type == TYPE_RADIO_BUTTON))) { RGBColor newColor; - if (TkSetMacColor(xcolor->pixel, &newColor)) { - ChangeBackgroundWindowColor((**controlHandle).contrlOwner, - newColor, saveColorPtr); - } + TkSetMacColor(xcolor->pixel, &newColor); + ChangeBackgroundWindowColor((**controlHandle).contrlOwner, + newColor, saveColorPtr); return true; - } + } } return false; @@ -1348,7 +1353,7 @@ UpdateControlColors( * * This procedure will change the background color entry * in the Window's colortable. The system isn't notified - * of the change. This call should only be used to fool + * of the change. This call should only be used to fool * the drawing routines for checkboxes and radiobuttons. * Any change should be temporary and be reverted after * the widget is drawn. @@ -1422,7 +1427,7 @@ ButtonExitProc(clientData) /* * Restore our dummy window to it's origional state by putting it - * back in the window list and restoring it's bits. The destroy + * back in the window list and restoring it's bits. The destroy * the controls and window. */ diff --git a/mac/tkMacClipboard.c b/mac/tkMacClipboard.c index 9d387f5..75bc131 100644 --- a/mac/tkMacClipboard.c +++ b/mac/tkMacClipboard.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacClipboard.c,v 1.2 1998/09/14 18:23:34 stanton Exp $ + * RCS: @(#) $Id: tkMacClipboard.c,v 1.3 1999/04/16 01:51:30 stanton Exp $ */ #include "tkInt.h" @@ -32,7 +32,7 @@ * Results: * The return value is a standard Tcl return value. * If an error occurs (such as no selection exists) - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * None. @@ -241,7 +241,7 @@ TkSuspendClipboard() char *buffer, *p, *endPtr, *buffPtr; long length; - dispPtr = tkDisplayList; + dispPtr = TkGetDisplayList(); if ((dispPtr == NULL) || !dispPtr->clipboardActive) { return; } diff --git a/mac/tkMacColor.c b/mac/tkMacColor.c index 856ebe5..1b7e948 100644 --- a/mac/tkMacColor.c +++ b/mac/tkMacColor.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacColor.c,v 1.4 1999/04/16 01:25:54 stanton Exp $ + * RCS: @(#) $Id: tkMacColor.c,v 1.5 1999/04/16 01:51:30 stanton Exp $ */ #include <tkColor.h> @@ -88,7 +88,8 @@ TkSetMacColor( case MENU_BACKGROUND_PIXEL: case MENU_DISABLED_PIXEL: case MENU_TEXT_PIXEL: - return GetMenuPartColor((pixel >> 24), macColor); + GetMenuPartColor((pixel >> 24), macColor); + return true; case APPEARANCE_PIXEL: return false; case PIXEL_MAGIC: @@ -430,75 +431,63 @@ GetMenuPartColor( RGBColor backColor, foreColor; GDHandle maxDevice; Rect globalRect; - MCEntryPtr mcEntryPtr; + MCEntryPtr mcEntryPtr = GetMCEntry(0, 0); - /* Under Appearance, we don't want to set any menu colors when we - are asked for the standard menu colors. So we return false (which - means don't use this color... */ - - if (TkMacHaveAppearance()) { - macColor->red = 0xFFFF; - macColor->green = 0; - macColor->blue = 0; - return false; - } else { - mcEntryPtr = GetMCEntry(0, 0); - switch (pixel) { - case MENU_ACTIVE_PIXEL: - if (mcEntryPtr == NULL) { - macColor->red = macColor->blue = macColor->green = 0; - } else { - *macColor = mcEntryPtr->mctRGB3; - } - return true; - case MENU_ACTIVE_TEXT_PIXEL: - if (mcEntryPtr == NULL) { - macColor->red = macColor->blue = macColor->green = 0xFFFF; - } else { - *macColor = mcEntryPtr->mctRGB2; - } - return true; - case MENU_BACKGROUND_PIXEL: - if (mcEntryPtr == NULL) { - macColor->red = macColor->blue = macColor->green = 0xFFFF; - } else { - *macColor = mcEntryPtr->mctRGB2; - } - return true; - case MENU_DISABLED_PIXEL: - if (mcEntryPtr == NULL) { - backColor.red = backColor.blue = backColor.green = 0xFFFF; - foreColor.red = foreColor.blue = foreColor.green = 0x0000; - } else { - backColor = mcEntryPtr->mctRGB2; - foreColor = mcEntryPtr->mctRGB3; - } - SetRect(&globalRect, SHRT_MIN, SHRT_MIN, SHRT_MAX, SHRT_MAX); - maxDevice = GetMaxDevice(&globalRect); - if (GetGray(maxDevice, &backColor, &foreColor)) { - *macColor = foreColor; - } else { + switch (pixel) { + case MENU_ACTIVE_PIXEL: + if (mcEntryPtr == NULL) { + macColor->red = macColor->blue = macColor->green = 0; + } else { + *macColor = mcEntryPtr->mctRGB3; + } + return 1; + case MENU_ACTIVE_TEXT_PIXEL: + if (mcEntryPtr == NULL) { + macColor->red = macColor->blue = macColor->green = 0xFFFF; + } else { + *macColor = mcEntryPtr->mctRGB2; + } + return 1; + case MENU_BACKGROUND_PIXEL: + if (mcEntryPtr == NULL) { + macColor->red = macColor->blue = macColor->green = 0xFFFF; + } else { + *macColor = mcEntryPtr->mctRGB2; + } + return 1; + case MENU_DISABLED_PIXEL: + if (mcEntryPtr == NULL) { + backColor.red = backColor.blue = backColor.green = 0xFFFF; + foreColor.red = foreColor.blue = foreColor.green = 0x0000; + } else { + backColor = mcEntryPtr->mctRGB2; + foreColor = mcEntryPtr->mctRGB3; + } + SetRect(&globalRect, SHRT_MIN, SHRT_MIN, SHRT_MAX, SHRT_MAX); + maxDevice = GetMaxDevice(&globalRect); + if (GetGray(maxDevice, &backColor, &foreColor)) { + *macColor = foreColor; + } else { - /* - * Pointer may have been moved by GetMaxDevice or GetGray. - */ + /* + * Pointer may have been moved by GetMaxDevice or GetGray. + */ - mcEntryPtr = GetMCEntry(0,0); - if (mcEntryPtr == NULL) { - macColor->red = macColor->green = macColor->blue = 0x7777; - } else { - *macColor = mcEntryPtr->mctRGB2; - } - } - return true; - case MENU_TEXT_PIXEL: - if (mcEntryPtr == NULL) { - macColor->red = macColor->green = macColor->blue = 0; - } else { - *macColor = mcEntryPtr->mctRGB3; - } - return true; - } - return false; + mcEntryPtr = GetMCEntry(0,0); + if (mcEntryPtr == NULL) { + macColor->red = macColor->green = macColor->blue = 0x7777; + } else { + *macColor = mcEntryPtr->mctRGB2; + } + } + return 1; + case MENU_TEXT_PIXEL: + if (mcEntryPtr == NULL) { + macColor->red = macColor->green = macColor->blue = 0; + } else { + *macColor = mcEntryPtr->mctRGB3; + } + return 1; } + return 0; } diff --git a/mac/tkMacConfig.c b/mac/tkMacConfig.c new file mode 100644 index 0000000..951f553 --- /dev/null +++ b/mac/tkMacConfig.c @@ -0,0 +1,45 @@ +/* + * tkMacConfig.c -- + * + * This module implements the Macintosh system defaults for + * the configuration package. + * + * Copyright (c) 1997 by Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkMacConfig.c,v 1.2 1999/04/16 01:51:30 stanton Exp $ + */ + +#include "tk.h" +#include "tkInt.h" + + +/* + *---------------------------------------------------------------------- + * + * TkpGetSystemDefault -- + * + * Given a dbName and className for a configuration option, + * return a string representation of the option. + * + * Results: + * Returns a Tk_Uid that is the string identifier that identifies + * this option. Returns NULL if there are no system defaults + * that match this pair. + * + * Side effects: + * None, once the package is initialized. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkpGetSystemDefault( + Tk_Window tkwin, /* A window to use. */ + char *dbName, /* The option database name. */ + char *className) /* The name of the option class. */ +{ + return NULL; +} diff --git a/mac/tkMacCursor.c b/mac/tkMacCursor.c index 604e8f0..f03f207 100644 --- a/mac/tkMacCursor.c +++ b/mac/tkMacCursor.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacCursor.c,v 1.4 1999/03/10 07:04:44 stanton Exp $ + * RCS: @(#) $Id: tkMacCursor.c,v 1.5 1999/04/16 01:51:30 stanton Exp $ */ #include "tkPort.h" @@ -109,13 +109,23 @@ FindCursorByName( { Handle resource; Str255 curName; + int destWrote, inCurLen; - curName[0] = strlen(string); - if (curName[0] > 255) { + inCurLen = strlen(string); + if (inCurLen > 255) { return; } - - strcpy((char *) curName + 1, string); + + /* + * macRoman is the encoding that the resource fork uses. + */ + + Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), string, + inCurLen, 0, NULL, + (char *) &curName[1], + 255, NULL, &destWrote, NULL); /* Internalize native */ + curName[0] = destWrote; + resource = GetNamedResource('crsr', curName); if (resource != NULL) { @@ -252,7 +262,7 @@ TkCreateCursorFromData( /* *---------------------------------------------------------------------- * - * TkFreeCursor -- + * TkpFreeCursor -- * * This procedure is called to release a cursor allocated by * TkGetCursorByName. @@ -267,7 +277,7 @@ TkCreateCursorFromData( */ void -TkFreeCursor( +TkpFreeCursor( TkCursor *cursorPtr) { TkMacCursor *macCursorPtr = (TkMacCursor *) cursorPtr; @@ -284,8 +294,6 @@ TkFreeCursor( if (macCursorPtr == gCurrentCursor) { gCurrentCursor = NULL; } - - ckfree((char *) macCursorPtr); } /* diff --git a/mac/tkMacDefault.h b/mac/tkMacDefault.h index 886bdd3..a09d3be 100644 --- a/mac/tkMacDefault.h +++ b/mac/tkMacDefault.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacDefault.h,v 1.2 1998/09/14 18:23:35 stanton Exp $ + * RCS: @(#) $Id: tkMacDefault.h,v 1.3 1999/04/16 01:51:30 stanton Exp $ */ #ifndef _TKMACDEFAULT @@ -61,7 +61,8 @@ #define DEF_CHKRAD_FG DEF_BUTTON_FG #define DEF_BUTTON_FONT "system" #define DEF_BUTTON_HEIGHT "0" -#define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG +#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR +#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO #define DEF_BUTTON_HIGHLIGHT "systemButtonFrame" #define DEF_LABEL_HIGHLIGHT_WIDTH "0" #define DEF_BUTTON_HIGHLIGHT_WIDTH "4" @@ -288,7 +289,8 @@ #define DEF_MENUBUTTON_FONT "system" #define DEF_MENUBUTTON_FG BLACK #define DEF_MENUBUTTON_HEIGHT "0" -#define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG +#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR +#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 @@ -348,7 +350,8 @@ #define DEF_SCALE_FG_COLOR BLACK #define DEF_SCALE_FG_MONO BLACK #define DEF_SCALE_FROM "0" -#define DEF_SCALE_HIGHLIGHT_BG NORMAL_BG +#define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR +#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO #define DEF_SCALE_HIGHLIGHT BLACK #define DEF_SCALE_HIGHLIGHT_WIDTH "0" #define DEF_SCALE_LABEL "" diff --git a/mac/tkMacDialog.c b/mac/tkMacDialog.c index a2a98fd..736f157 100644 --- a/mac/tkMacDialog.c +++ b/mac/tkMacDialog.c @@ -3,13 +3,12 @@ * * Contains the Mac implementation of the common dialog boxes. * - * Copyright (c) 1996 Sun Microsystems, Inc. + * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacDialog.c,v 1.2 1998/09/14 18:23:35 stanton Exp $ - * + * RCS: @(#) $Id: tkMacDialog.c,v 1.3 1999/04/16 01:51:30 stanton Exp $ */ #include <Gestalt.h> @@ -26,6 +25,13 @@ #include "tclMacInt.h" #include "tkFileFilter.h" +#ifndef StrLength +#define StrLength(s) (*((unsigned char *) (s))) +#endif +#ifndef StrBody +#define StrBody(s) ((char *) (s) + 1) +#endif + /* * The following are ID's for resources that are defined in tkMacResource.r */ @@ -45,38 +51,27 @@ * information about the file dialog and the file filters. */ typedef struct _OpenFileData { - Tcl_Interp * interp; - char * initialFile; /* default file to appear in the - * save dialog */ - char * defExt; /* default extension (not used on the - * Mac) */ FileFilterList fl; /* List of file filters. */ SInt16 curType; /* The filetype currently being - * listed */ - int isOpen; /* True if this is an Open dialog, - * false if it is a Save dialog. */ - MenuHandle menu; /* Handle of the menu in the popup*/ - short dialogId; /* resource ID of the dialog */ - int popupId; /* resource ID of the popup */ - short popupItem; /* item number of the popup in the - * dialog */ + * listed. */ + short popupItem; /* Item number of the popup in the + * dialog. */ int usePopup; /* True if we show the popup menu (this * is an open operation and the - * -filetypes option is set) - */ + * -filetypes option is set). */ } OpenFileData; static pascal Boolean FileFilterProc _ANSI_ARGS_((CInfoPBPtr pb, void *myData)); -static int GetFileName _ANSI_ARGS_ (( - ClientData clientData, Tcl_Interp *interp, - int argc, char **argv, int isOpen )); +static int GetFileName _ANSI_ARGS_ ((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[], int isOpen)); static Boolean MatchOneType _ANSI_ARGS_((CInfoPBPtr pb, - OpenFileData * myDataPtr, FileFilter * filterPtr)); + OpenFileData *myofdPtr, FileFilter *filterPtr)); static pascal short OpenHookProc _ANSI_ARGS_((short item, - DialogPtr theDialog, OpenFileData * myDataPtr)); + DialogPtr theDialog, OpenFileData * myofdPtr)); static int ParseFileDlgArgs _ANSI_ARGS_ ((Tcl_Interp * interp, - OpenFileData * myDataPtr, int argc, char ** argv, + OpenFileData * myofdPtr, int argc, char ** argv, int isOpen)); /* @@ -92,68 +87,7 @@ static DlgHookYDUPP saveHook = NULL; /* *---------------------------------------------------------------------- * - * EvalArgv -- - * - * Invokes the Tcl procedure with the arguments. argv[0] is set by - * the caller of this function. It may be different than cmdName. - * The TCL command will see argv[0], not cmdName, as its name if it - * invokes [lindex [info level 0] 0] - * - * Results: - * TCL_ERROR if the command does not exist and cannot be autoloaded. - * Otherwise, return the result of the evaluation of the command. - * - * Side effects: - * The command may be autoloaded. - * - *---------------------------------------------------------------------- - */ - -static int -EvalArgv( - Tcl_Interp *interp, /* Current interpreter. */ - char * cmdName, /* Name of the TCL command to call */ - int argc, /* Number of arguments. */ - char **argv) /* Argument strings. */ -{ - Tcl_CmdInfo cmdInfo; - - if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) { - char * cmdArgv[2]; - - /* - * This comand is not in the interpreter yet -- looks like we - * have to auto-load it - */ - if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "cannot execute command \"auto_load\"", - NULL); - return TCL_ERROR; - } - - cmdArgv[0] = "auto_load"; - cmdArgv[1] = cmdName; - - if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ - return TCL_ERROR; - } - - if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "cannot auto-load command \"", - cmdName, "\"",NULL); - return TCL_ERROR; - } - } - - return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv); -} - -/* - *---------------------------------------------------------------------- - * - * Tk_ChooseColorCmd -- + * Tk_ChooseColorObjCmd -- * * This procedure implements the color dialog box for the Mac * platform. See the user documentation for details on what it @@ -169,23 +103,86 @@ EvalArgv( */ int -Tk_ChooseColorCmd( +Tk_ChooseColorObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { - Tk_Window parent = Tk_MainWindow(interp); - char * colorStr = NULL; - XColor * colorPtr = NULL; - char * title = "Choose a color:"; - int i, version; - long response = 0; - OSErr err = noErr; - char buff[40]; - static RGBColor in; + Tk_Window parent; + char *title; + int i, picked, srcRead, dstWrote; + long response; + OSErr err; static inited = 0; - + static RGBColor in; + static char *optionStrings[] = { + "-initialcolor", "-parent", "-title", NULL + }; + enum options { + COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE + }; + + if (inited == 0) { + /* + * 'in' stores the last color picked. The next time the color dialog + * pops up, the last color will remain in the dialog. + */ + + in.red = 0xffff; + in.green = 0xffff; + in.blue = 0xffff; + inited = 1; + } + + parent = (Tk_Window) clientData; + title = "Choose a color:"; + picked = 0; + + for (i = 1; i < objc; i += 2) { + int index; + char *option, *value; + + if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", + TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + if (i + 1 == objc) { + option = Tcl_GetStringFromObj(objv[i], NULL); + Tcl_AppendResult(interp, "value for \"", option, "\" missing", + (char *) NULL); + return TCL_ERROR; + } + value = Tcl_GetStringFromObj(objv[i + 1], NULL); + + switch ((enum options) index) { + case COLOR_INITIAL: { + XColor *colorPtr; + + colorPtr = Tk_GetColor(interp, parent, value); + if (colorPtr == NULL) { + return TCL_ERROR; + } + in.red = colorPtr->red; + in.green = colorPtr->green; + in.blue = colorPtr->blue; + Tk_FreeColor(colorPtr); + break; + } + case COLOR_PARENT: { + parent = Tk_NameToWindow(interp, value, parent); + if (parent == NULL) { + return TCL_ERROR; + } + break; + } + case COLOR_TITLE: { + title = value; + break; + } + } + } + /* * Use the gestalt manager to determine how to bring * up the color picker. If versin 2.0 isn't available @@ -194,92 +191,12 @@ Tk_ChooseColorCmd( */ err = Gestalt(gestaltColorPicker, &response); - if ((err == noErr) || (response == 0x0200L)) { - version = 2; - } else { - version = 1; - } - - for (i=1; i<argc; i+=2) { - int v = i+1; - int len = strlen(argv[i]); - - if (strncmp(argv[i], "-initialcolor", len)==0) { - if (v==argc) {goto arg_missing;} - - colorStr = argv[v]; - } else if (strncmp(argv[i], "-parent", len)==0) { - if (v==argc) {goto arg_missing;} - - parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp)); - if (parent == NULL) { - return TCL_ERROR; - } - } else if (strncmp(argv[i], "-title", len)==0) { - if (v==argc) {goto arg_missing;} - - title = argv[v]; - } else { - Tcl_AppendResult(interp, "unknown option \"", - argv[i], "\", must be -initialcolor, -parent or -title", - NULL); - return TCL_ERROR; - } - } - - if (colorStr) { - colorPtr = Tk_GetColor(interp, parent, colorStr); - if (colorPtr == NULL) { - return TCL_ERROR; - } - } - - if (!inited) { - inited = 1; - in.red = 0xffff; - in.green = 0xffff; - in.blue = 0xffff; - } - if (colorPtr) { - in.red = colorPtr->red; - in.green = colorPtr->green; - in.blue = colorPtr->blue; - } - - if (version == 1) { - /* - * Use version 1.0 of the color picker - */ - - RGBColor out; - Str255 prompt; - Point point = {-1, -1}; - - prompt[0] = strlen(title); - strncpy((char*) prompt+1, title, 255); - - if (GetColor(point, prompt, &in, &out)) { - /* - * user selected a color - */ - sprintf(buff, "#%02x%02x%02x", out.red >> 8, out.green >> 8, - out.blue >> 8); - Tcl_SetResult(interp, buff, TCL_VOLATILE); + if ((err == noErr) && (response == 0x0200L)) { + ColorPickerInfo cpinfo; - /* - * Save it for the next time - */ - in.red = out.red; - in.green = out.green; - in.blue = out.blue; - } else { - Tcl_ResetResult(interp); - } - } else { /* * Version 2.0 of the color picker is available. Let's use it */ - ColorPickerInfo cpinfo; cpinfo.theColor.profile = 0L; cpinfo.theColor.color.rgb.red = in.red; @@ -292,41 +209,50 @@ Tk_ChooseColorCmd( cpinfo.eventProc = NULL; cpinfo.colorProc = NULL; cpinfo.colorProcData = NULL; + + Tcl_UtfToExternal(NULL, NULL, title, -1, 0, NULL, + StrBody(cpinfo.prompt), 255, &srcRead, &dstWrote, NULL); + StrLength(cpinfo.prompt) = (unsigned char) dstWrote; + + if ((PickColor(&cpinfo) == noErr) && (cpinfo.newColorChosen != 0)) { + in.red = cpinfo.theColor.color.rgb.red; + in.green = cpinfo.theColor.color.rgb.green; + in.blue = cpinfo.theColor.color.rgb.blue; + picked = 1; + } + } else { + RGBColor out; + Str255 prompt; + Point point = {-1, -1}; + + /* + * Use version 1.0 of the color picker + */ + + Tcl_UtfToExternal(NULL, NULL, title, -1, 0, NULL, StrBody(prompt), + 255, &srcRead, &dstWrote, NULL); + StrLength(prompt) = (unsigned char) dstWrote; - cpinfo.prompt[0] = strlen(title); - strncpy((char*)cpinfo.prompt+1, title, 255); - - if ((PickColor(&cpinfo) == noErr) && cpinfo.newColorChosen) { - sprintf(buff, "#%02x%02x%02x", - cpinfo.theColor.color.rgb.red >> 8, - cpinfo.theColor.color.rgb.green >> 8, - cpinfo.theColor.color.rgb.blue >> 8); - Tcl_SetResult(interp, buff, TCL_VOLATILE); - - in.blue = cpinfo.theColor.color.rgb.red; - in.green = cpinfo.theColor.color.rgb.green; - in.blue = cpinfo.theColor.color.rgb.blue; - } else { - Tcl_ResetResult(interp); + if (GetColor(point, prompt, &in, &out)) { + in = out; + picked = 1; } - } + } + + if (picked != 0) { + char result[32]; - if (colorPtr) { - Tk_FreeColor(colorPtr); + sprintf(result, "#%02x%02x%02x", in.red >> 8, in.green >> 8, + in.blue >> 8); + Tcl_AppendResult(interp, result, NULL); } - return TCL_OK; - - arg_missing: - Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", - NULL); - return TCL_ERROR; } /* *---------------------------------------------------------------------- * - * Tk_GetOpenFileCmd -- + * Tk_GetOpenFileObjCmd -- * * This procedure implements the "open file" dialog box for the * Mac platform. See the user documentation for details on what @@ -341,19 +267,19 @@ Tk_ChooseColorCmd( */ int -Tk_GetOpenFileCmd( +Tk_GetOpenFileObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, argc, argv, OPEN_FILE); + return GetFileName(clientData, interp, objc, objv, OPEN_FILE); } /* *---------------------------------------------------------------------- * - * Tk_GetSaveFileCmd -- + * Tk_GetSaveFileObjCmd -- * * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box * instead @@ -367,13 +293,13 @@ Tk_GetOpenFileCmd( */ int -Tk_GetSaveFileCmd( +Tk_GetSaveFileObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, argc, argv, SAVE_FILE); + return GetFileName(clientData, interp, objc, objv, SAVE_FILE); } /* @@ -389,8 +315,8 @@ Tk_GetSaveFileCmd( * * Side effects: * If the user selects a file, the native pathname of the file - * is returned in interp->result. Otherwise an empty string - * is returned in interp->result. + * is returned in the interp's result. Otherwise an empty string + * is returned in the interp's result. * *---------------------------------------------------------------------- */ @@ -399,32 +325,124 @@ static int GetFileName( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - char **argv, /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[], /* Argument objects. */ int isOpen) /* true if we should call GetOpenFileName(), * false if we should call GetSaveFileName() */ { - int code = TCL_OK; - int i; - OpenFileData myData, *myDataPtr; + int i, result; + OpenFileData ofd; StandardFileReply reply; Point mypoint; - Str255 str; - - myDataPtr = &myData; + MenuHandle menu; + Str255 initialFile; + char *choice[6]; + Tk_Window parent; + static char *optionStrings[] = { + "-defaultextension", "-filetypes", "-initialdir", "-initialfile", + "-parent", "-title", NULL + }; + enum options { + FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, + FILE_PARENT, FILE_TITLE + }; if (openFilter == NULL) { openFilter = NewFileFilterYDProc(FileFilterProc); openHook = NewDlgHookYDProc(OpenHookProc); saveHook = NewDlgHookYDProc(OpenHookProc); } + + result = TCL_ERROR; + parent = (Tk_Window) clientData; + memset(choice, 0, sizeof(choice)); - /* - * 1. Parse the arguments. - */ - if (ParseFileDlgArgs(interp, myDataPtr, argc, argv, isOpen) - != TCL_OK) { - return TCL_ERROR; + for (i = 1; i < objc; i += 2) { + int index; + char *string; + + if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", + TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + if (i + 1 == objc) { + string = Tcl_GetStringFromObj(objv[i], NULL); + Tcl_AppendResult(interp, "value for \"", string, "\" missing", + (char *) NULL); + return TCL_ERROR; + } + choice[index] = Tcl_GetStringFromObj(objv[i + 1], NULL); + } + + StrLength(initialFile) = 0; + menu = NULL; + + TkInitFileFilters(&ofd.fl); + ofd.curType = 0; + ofd.popupItem = OPEN_POPUP_ITEM; + ofd.usePopup = isOpen; + + if (choice[FILE_TYPES] != NULL) { + if (TkGetFileFilters(interp, &ofd.fl, choice[FILE_TYPES], 0) != TCL_OK) { + goto end; + } + } + if (choice[FILE_INITDIR] != NULL) { + FSSpec dirSpec; + Tcl_DString ds; + long dirID; + OSErr err; + Boolean isDirectory; + char *string; + Str255 dir; + int srcRead, dstWrote; + + string = choice[FILE_INITDIR]; + if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { + goto end; + } + Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds), 0, NULL, StrBody(dir), 255, + &srcRead, &dstWrote, NULL); + StrLength(dir) = (unsigned char) dstWrote; + Tcl_DStringFree(&ds); + + err = FSpLocationFromPath(StrLength(dir), StrBody(dir), &dirSpec); + if (err != noErr) { + Tcl_AppendResult(interp, "bad directory \"", string, "\"", NULL); + goto end; + } + err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory); + if ((err != noErr) || !isDirectory) { + Tcl_AppendResult(interp, "bad directory \"", string, "\"", NULL); + goto end; + } + /* + * Make sure you negate -dirSpec.vRefNum because the + * standard file package wants it that way ! + */ + + LMSetSFSaveDisk(-dirSpec.vRefNum); + LMSetCurDirStore(dirID); + } + if (choice[FILE_INITFILE] != NULL) { + Tcl_DString ds; + int srcRead, dstWrote; + + if (Tcl_TranslateFileName(interp, choice[FILE_INITFILE], &ds) == NULL) { + goto end; + } + Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds), 0, NULL, + StrBody(initialFile), 255, &srcRead, &dstWrote, NULL); + StrLength(initialFile) = (unsigned char) dstWrote; + Tcl_DStringFree(&ds); + } + if (choice[FILE_PARENT] != NULL) { + parent = Tk_NameToWindow(interp, choice[FILE_PARENT], parent); + if (parent == NULL) { + return TCL_ERROR; + } } /* @@ -436,237 +454,89 @@ GetFileName( * left overs from previous invocation of this command */ - if (myDataPtr->usePopup) { - FileFilter * filterPtr; - - for (i=CountMItems(myDataPtr->menu); i>0; i--) { + if (ofd.usePopup) { + FileFilter *filterPtr; + + menu = GetMenu(OPEN_MENU); + for (i = CountMItems(menu); i > 0; i--) { /* * The item indices are one based. Also, if we delete from * the beginning, the items may be re-numbered. So we * delete from the end */ - DeleteMenuItem(myDataPtr->menu, i); + + DeleteMenuItem(menu, i); } - if (myDataPtr->fl.filters) { - for (filterPtr=myDataPtr->fl.filters; filterPtr; - filterPtr=filterPtr->next) { - strncpy((char*)str+1, filterPtr->name, 254); - str[0] = strlen(filterPtr->name); - AppendMenu(myDataPtr->menu, (ConstStr255Param) str); - } + filterPtr = ofd.fl.filters; + if (filterPtr == NULL) { + ofd.usePopup = 0; } else { - myDataPtr->usePopup = 0; + for ( ; filterPtr != NULL; filterPtr = filterPtr->next) { + Str255 str; + + StrLength(str) = (unsigned char) strlen(filterPtr->name); + strcpy(StrBody(str), filterPtr->name); + AppendMenu(menu, str); + } } } /* * 3. Call the toolbox file dialog function. */ + SetPt(&mypoint, -1, -1); TkpSetCursor(NULL); - - if (myDataPtr->isOpen) { - if (myDataPtr->usePopup) { - CustomGetFile(openFilter, (short) -1, NULL, &reply, - myDataPtr->dialogId, - mypoint, openHook, NULL, NULL, NULL, (void*)myDataPtr); + if (isOpen) { + if (ofd.usePopup) { + CustomGetFile(openFilter, (short) -1, NULL, &reply, OPEN_BOX, + mypoint, openHook, NULL, NULL, NULL, (void*) &ofd); } else { StandardGetFile(NULL, -1, NULL, &reply); } } else { - Str255 prompt, def; - - strcpy((char*)prompt+1, "Save as"); - prompt[0] = strlen("Save as"); - if (myDataPtr->initialFile) { - strncpy((char*)def+1, myDataPtr->initialFile, 254); - def[0] = strlen(myDataPtr->initialFile); - } else { - def[0] = 0; - } - if (myDataPtr->usePopup) { + static Str255 prompt = "\pSave as"; + + if (ofd.usePopup) { /* * Currently this never gets called because we don't use * popup for the save dialog. */ - CustomPutFile(prompt, def, &reply, myDataPtr->dialogId, mypoint, - saveHook, NULL, NULL, NULL, myDataPtr); + CustomPutFile(prompt, initialFile, &reply, OPEN_BOX, + mypoint, saveHook, NULL, NULL, NULL, (void *) &ofd); } else { - StandardPutFile(prompt, def, &reply); + StandardPutFile(prompt, initialFile, &reply); } } - Tcl_ResetResult(interp); if (reply.sfGood) { int length; - Handle pathHandle = NULL; - char * pathName = NULL; + Handle pathHandle; + pathHandle = NULL; FSpPathFromLocation(&reply.sfFile, &length, &pathHandle); - if (pathHandle != NULL) { + Tcl_DString ds; + HLock(pathHandle); - pathName = (char *) ckalloc((unsigned) (length + 1)); - strcpy(pathName, *pathHandle); + Tcl_ExternalToUtfDString(NULL, (char *) *pathHandle, -1, &ds); + Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); + Tcl_DStringFree(&ds); HUnlock(pathHandle); DisposeHandle(pathHandle); - - /* - * Return the full pathname of the selected file - */ - - Tcl_SetResult(interp, pathName, TCL_DYNAMIC); } } - - done: - TkFreeFileFilters(&myDataPtr->fl); - return code; -} - -/* - *---------------------------------------------------------------------- - * - * ParseFileDlgArgs -- - * - * Parses the arguments passed to tk_getOpenFile and tk_getSaveFile. - * - * Results: - * A standard TCL return value. - * - * Side effects: - * The OpenFileData structure is initialized and modified according - * to the arguments. - * - *---------------------------------------------------------------------- - */ - -static int -ParseFileDlgArgs( - Tcl_Interp * interp, /* Current interpreter. */ - OpenFileData * myDataPtr, /* Information about the file dialog */ - int argc, /* Number of arguments */ - char ** argv, /* Argument strings */ - int isOpen) /* TRUE if this is an "open" dialog */ -{ - int i; - - myDataPtr->interp = interp; - myDataPtr->initialFile = NULL; - myDataPtr->curType = 0; - - TkInitFileFilters(&myDataPtr->fl); - if (isOpen) { - myDataPtr->isOpen = 1; - myDataPtr->usePopup = 1; - myDataPtr->menu = GetMenu(OPEN_MENU); - myDataPtr->dialogId = OPEN_BOX; - myDataPtr->popupId = OPEN_POPUP; - myDataPtr->popupItem = OPEN_POPUP_ITEM; - if (myDataPtr->menu == NULL) { - Debugger(); - } - } else { - myDataPtr->isOpen = 0; - myDataPtr->usePopup = 0; - } - - for (i=1; i<argc; i+=2) { - int v = i+1; - int len = strlen(argv[i]); - - if (strncmp(argv[i], "-defaultextension", len)==0) { - if (v==argc) {goto arg_missing;} + result = TCL_OK; - myDataPtr->defExt = argv[v]; - } - else if (strncmp(argv[i], "-filetypes", len)==0) { - if (v==argc) {goto arg_missing;} - - if (TkGetFileFilters(interp, &myDataPtr->fl,argv[v],0) != TCL_OK) { - return TCL_ERROR; - } - } - else if (strncmp(argv[i], "-initialdir", len)==0) { - FSSpec dirSpec; - char * dirName; - Tcl_DString dstring; - long dirID; - OSErr err; - Boolean isDirectory; - - if (v==argc) {goto arg_missing;} - - if (Tcl_TranslateFileName(interp, argv[v], &dstring) == NULL) { - return TCL_ERROR; - } - dirName = dstring.string; - if (FSpLocationFromPath(strlen(dirName), dirName, &dirSpec) != - noErr) { - Tcl_AppendResult(interp, "bad directory \"", argv[v], - "\"", NULL); - return TCL_ERROR; - } - err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory); - if ((err != noErr) || !isDirectory) { - Tcl_AppendResult(interp, "bad directory \"", argv[v], - "\"", NULL); - return TCL_ERROR; - } - /* - * Make sure you negate -dirSpec.vRefNum because the standard file - * package wants it that way ! - */ - LMSetSFSaveDisk(-dirSpec.vRefNum); - LMSetCurDirStore(dirID); - Tcl_DStringFree(&dstring); - } - else if (strncmp(argv[i], "-initialfile", len)==0) { - if (v==argc) {goto arg_missing;} - - myDataPtr->initialFile = argv[v]; - } - else if (strncmp(argv[i], "-parent", len)==0) { - /* - * Ignored on the Mac, but make sure that it's a valid window - * pathname - */ - Tk_Window parent; - - if (v==argc) {goto arg_missing;} - - parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp)); - if (parent == NULL) { - return TCL_ERROR; - } - } - else if (strncmp(argv[i], "-title", len)==0) { - if (v==argc) {goto arg_missing;} - - /* - * This option is ignored on the Mac because the Mac file - * dialog do not support titles. - */ - } - else { - Tcl_AppendResult(interp, "unknown option \"", - argv[i], "\", must be -defaultextension, ", - "-filetypes, -initialdir, -initialfile, -parent or -title", - NULL); - return TCL_ERROR; - } + end: + TkFreeFileFilters(&ofd.fl); + if (menu != NULL) { + DisposeMenu(menu); } - - return TCL_OK; - - arg_missing: - Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", - NULL); - return TCL_ERROR; + return result; } - /* *---------------------------------------------------------------------- * @@ -689,7 +559,7 @@ static pascal short OpenHookProc( short item, /* Event description. */ DialogPtr theDialog, /* The dialog where the event occurs. */ - OpenFileData * myDataPtr) /* Information about the file dialog. */ + OpenFileData *ofdPtr) /* Information about the file dialog. */ { short ignore; Rect rect; @@ -698,29 +568,29 @@ OpenHookProc( switch (item) { case sfHookFirstCall: - if (myDataPtr->usePopup) { + if (ofdPtr->usePopup) { /* * Set the popup list to display the selected type. */ - GetDialogItem(theDialog, myDataPtr->popupItem, - &ignore, &handle, &rect); - SetControlValue((ControlRef) handle, myDataPtr->curType + 1); + GetDialogItem(theDialog, ofdPtr->popupItem, &ignore, &handle, + &rect); + SetControlValue((ControlRef) handle, ofdPtr->curType + 1); } return sfHookNullEvent; case OPEN_POPUP_ITEM: - if (myDataPtr->usePopup) { - GetDialogItem(theDialog, myDataPtr->popupItem, + if (ofdPtr->usePopup) { + GetDialogItem(theDialog, ofdPtr->popupItem, &ignore, &handle, &rect); newType = GetCtlValue((ControlRef) handle) - 1; - if (myDataPtr->curType != newType) { - if (newType<0 || newType>myDataPtr->fl.numFilters) { + if (ofdPtr->curType != newType) { + if (newType<0 || newType>ofdPtr->fl.numFilters) { /* * Sanity check. Looks like the user selected an * non-existent menu item?? Don't do anything. */ } else { - myDataPtr->curType = newType; + ofdPtr->curType = newType; } return sfHookRebuildList; } @@ -755,10 +625,10 @@ FileFilterProc( void *myData) /* Client data for this file dialog */ { int i; - OpenFileData * myDataPtr = (OpenFileData*)myData; + OpenFileData * ofdPtr = (OpenFileData*)myData; FileFilter * filterPtr; - if (myDataPtr->fl.numFilters == 0) { + if (ofdPtr->fl.numFilters == 0) { /* * No types have been specified. List all files by default */ @@ -772,13 +642,13 @@ FileFilterProc( return MATCHED; } - if (myDataPtr->usePopup) { - i = myDataPtr->curType; - for (filterPtr=myDataPtr->fl.filters; filterPtr && i>0; i--) { + if (ofdPtr->usePopup) { + i = ofdPtr->curType; + for (filterPtr=ofdPtr->fl.filters; filterPtr && i>0; i--) { filterPtr = filterPtr->next; } if (filterPtr) { - return MatchOneType(pb, myDataPtr, filterPtr); + return MatchOneType(pb, ofdPtr, filterPtr); } else { return UNMATCHED; } @@ -788,9 +658,9 @@ FileFilterProc( * considered matched if it matches any of the file filters. */ - for (filterPtr=myDataPtr->fl.filters; filterPtr; + for (filterPtr=ofdPtr->fl.filters; filterPtr; filterPtr=filterPtr->next) { - if (MatchOneType(pb, myDataPtr, filterPtr) == MATCHED) { + if (MatchOneType(pb, ofdPtr, filterPtr) == MATCHED) { return MATCHED; } } @@ -818,7 +688,7 @@ FileFilterProc( static Boolean MatchOneType( CInfoPBPtr pb, /* Information about the file */ - OpenFileData * myDataPtr, /* Information about this file dialog */ + OpenFileData * ofdPtr, /* Information about this file dialog */ FileFilter * filterPtr) /* Match the file described by pb against * this filter */ { @@ -909,31 +779,33 @@ MatchOneType( return UNMATCHED; } - /* *---------------------------------------------------------------------- * - * Tk_MessageBoxCmd -- + * Tk_ChooseDirectoryObjCmd -- * - * This procedure implements the MessageBox window for the - * Mac platform. See the user documentation for details on what - * it does. + * This procedure implements the "tk_chooseDirectory" dialog box + * for the Windows platform. See the user documentation for details + * on what it does. * * Results: - * A standard Tcl result. + * See user documentation. * * Side effects: - * See user documentation. + * A modal dialog window is created. Tcl_SetServiceMode() is + * called to allow background events to be processed * *---------------------------------------------------------------------- */ int -Tk_MessageBoxCmd( - ClientData clientData, /* Main window associated with interpreter. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - char **argv) /* Argument strings. */ +Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window associated with interpreter. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - return EvalArgv(interp, "tkMessageBox", argc, argv); + return TCL_ERROR; } + + diff --git a/mac/tkMacDraw.c b/mac/tkMacDraw.c index 6e0b617..425e3b9 100644 --- a/mac/tkMacDraw.c +++ b/mac/tkMacDraw.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacDraw.c,v 1.3 1999/04/16 01:25:54 stanton Exp $ + * RCS: @(#) $Id: tkMacDraw.c,v 1.4 1999/04/16 01:51:30 stanton Exp $ */ #include "tkInt.h" @@ -220,7 +220,7 @@ XCopyPlane( tmode = srcOr; tmode = srcCopy + transparent; - if (TkSetMacColor(gc->foreground, &macColor)) { + if (TkSetMacColor(gc->foreground, &macColor) == true) { RGBForeColor(&macColor); } @@ -230,9 +230,8 @@ XCopyPlane( * Case 1: opaque bitmaps. */ - if (TkSetMacColor(gc->background, &macColor)) { + TkSetMacColor(gc->background, &macColor); RGBBackColor(&macColor); - } tmode = srcCopy; CopyBits(srcBit, destBit, &srcRect, &destRect, tmode, NULL); } else if (clipPtr->type == TKP_CLIP_PIXMAP) { @@ -672,73 +671,6 @@ XDrawRectangle( /* *---------------------------------------------------------------------- * - * XDrawRectangles -- - * - * Draws the outlines of the specified rectangles as if a - * five-point PolyLine protocol request were specified for each - * rectangle: - * - * [x,y] [x+width,y] [x+width,y+height] [x,y+height] - * [x,y] - * - * For the specified rectangles, these functions do not draw a - * pixel more than once. XDrawRectangles draws the rectangles in - * the order listed in the array. If rectangles intersect, the - * intersecting pixels are drawn multiple times. Draws a - * rectangle. - * - * Results: - * None. - * - * Side effects: - * Draws rectangles on the specified drawable. - * - *---------------------------------------------------------------------- - */ -void -XDrawRectangles(display, d, gc, rectArr, numRects) - Display *display; - Drawable d; - GC gc; - XRectangle *rectArr; - int numRects; -{ - MacDrawable *macWin = (MacDrawable *) d; - Rect theRect; - CGrafPtr saveWorld; - GDHandle saveDevice; - GWorldPtr destPort; - - register XRectangle *rectPtr; - - destPort = TkMacGetDrawablePort(d); - - display->request++; - GetGWorld(&saveWorld, &saveDevice); - SetGWorld(destPort, NULL); - - TkMacSetUpClippingRgn(d); - - TkMacSetUpGraphicsPort(gc); - - ShowPen(); - PenPixPat(gPenPat); - - for (rectPtr = rectArr; numRects > 0; numRects--, rectPtr++) { - theRect.left = (short) (macWin->xOff + rectPtr->x); - theRect.top = (short) (macWin->yOff + rectPtr->y); - theRect.right = (short) (theRect.left + rectPtr->width); - theRect.bottom = (short) (theRect.top + rectPtr->height); - - FrameRect(&theRect); - } - - SetGWorld(saveWorld, saveDevice); -} - -/* - *---------------------------------------------------------------------- - * * XDrawArc -- * * Draw an arc. @@ -798,65 +730,6 @@ XDrawArc( /* *---------------------------------------------------------------------- * - * XDrawArcs -- - * - * Draw an array of arcs. - * - * Results: - * None. - * - * Side effects: - * Draws the arcs on the specified drawable. - * - *---------------------------------------------------------------------- - */ - -void -XDrawArcs( - Display* display, /* Display. */ - Drawable d, /* Draw on this. */ - GC gc, /* Use this GC. */ - XArc *arcArr, - int numArcs) - -{ - MacDrawable *macWin = (MacDrawable *) d; - Rect theRect; - short start, extent; - CGrafPtr saveWorld; - GDHandle saveDevice; - GWorldPtr destPort; - register XArc *arcPtr; - - destPort = TkMacGetDrawablePort(d); - - display->request++; - GetGWorld(&saveWorld, &saveDevice); - SetGWorld(destPort, NULL); - - TkMacSetUpClippingRgn(d); - - TkMacSetUpGraphicsPort(gc); - - ShowPen(); - PenPixPat(gPenPat); - - for (arcPtr = arcArr; numArcs > 0; numArcs--, arcPtr++) { - theRect.left = (short) (macWin->xOff + arcPtr->x ); - theRect.top = (short) (macWin->yOff + arcPtr->y); - theRect.right = (short) (theRect.left + arcPtr->width); - theRect.bottom = (short) (theRect.top + arcPtr->height); - start = (short) (90 - (arcPtr->angle1 / 64)); - extent = (short) (-(arcPtr->angle2 / 64)); - - FrameArc(&theRect, start, extent); - } - SetGWorld(saveWorld, saveDevice); -} - -/* - *---------------------------------------------------------------------- - * * XFillArc -- * * Draw a filled arc. @@ -950,97 +823,6 @@ XFillArc( /* *---------------------------------------------------------------------- * - * XFillArc -- - * - * Draw an array of filled arcs. - * - * Results: - * None. - * - * Side effects: - * Draws the filled arcs on the specified drawable. - * - *---------------------------------------------------------------------- - */ - -void -XFillArcs( - Display* display, /* Display. */ - Drawable d, /* Draw on this. */ - GC gc, /* Use this GC. */ - XArc *arcArr, /* Array of arcs */ - int numArcs) /* number of arcs */ -{ - MacDrawable *macWin = (MacDrawable *) d; - Rect theRect; - short start, extent; - PolyHandle polygon; - XArc *arcPtr; - double sin1, cos1, sin2, cos2, angle; - double boxWidth, boxHeight; - double vertex[2], center1[2], center2[2]; - CGrafPtr saveWorld; - GDHandle saveDevice; - GWorldPtr destPort; - - destPort = TkMacGetDrawablePort(d); - - display->request++; - GetGWorld(&saveWorld, &saveDevice); - SetGWorld(destPort, NULL); - - TkMacSetUpClippingRgn(d); - - TkMacSetUpGraphicsPort(gc); - - for (arcPtr = arcArr; numArcs > 0; numArcs--, arcPtr++) { - theRect.left = (short) (macWin->xOff + arcPtr->x); - theRect.top = (short) (macWin->yOff + arcPtr->y); - theRect.right = (short) (theRect.left + arcPtr->width); - theRect.bottom = (short) (theRect.top + arcPtr->height); - start = (short) (90 - (arcPtr->angle1 / 64)); - extent = (short) (- (arcPtr->angle2 / 64)); - - if (gc->arc_mode == ArcChord) { - boxWidth = theRect.right - theRect.left; - boxHeight = theRect.bottom - theRect.top; - angle = -(arcPtr->angle1/64.0)*PI/180.0; - sin1 = sin(angle); - cos1 = cos(angle); - angle -= (arcPtr->angle2/64.0)*PI/180.0; - sin2 = sin(angle); - cos2 = cos(angle); - vertex[0] = (theRect.left + theRect.right)/2.0; - vertex[1] = (theRect.top + theRect.bottom)/2.0; - center1[0] = vertex[0] + cos1*boxWidth/2.0; - center1[1] = vertex[1] + sin1*boxHeight/2.0; - center2[0] = vertex[0] + cos2*boxWidth/2.0; - center2[1] = vertex[1] + sin2*boxHeight/2.0; - - polygon = OpenPoly(); - MoveTo((short) ((theRect.left + theRect.right)/2), - (short) ((theRect.top + theRect.bottom)/2)); - - LineTo((short) (center1[0] + 0.5), (short) (center1[1] + 0.5)); - LineTo((short) (center2[0] + 0.5), (short) (center2[1] + 0.5)); - ClosePoly(); - - ShowPen(); - FillCArc(&theRect, start, extent, gPenPat); - FillCPoly(polygon, gPenPat); - - KillPoly(polygon); - } else { - ShowPen(); - FillCArc(&theRect, start, extent, gPenPat); - } - } - SetGWorld(saveWorld, saveDevice); -} - -/* - *---------------------------------------------------------------------- - * * TkScrollWindow -- * * Scroll a rectangle of the specified window and accumulate @@ -1142,7 +924,7 @@ TkScrollWindow( SetGWorld(saveWorld, saveDevice); /* - * Fortunantly, the region returned by ScrollRect is symanticly + * Fortunantly, the region returned by ScrollRect is symanticlly * the same as what we need to return in this function. If the * region is empty we return zero to denote that no damage was * created. @@ -1183,14 +965,14 @@ TkMacSetUpGraphicsPort( if (TkSetMacColor(gc->foreground, &macColor) == true) { /* TODO: cache RGBPats for preformace - measure gains... */ MakeRGBPat(gPenPat, &macColor); + } - PenNormal(); - if(gc->function == GXxor) { - PenMode(patXor); - } - if (gc->line_width > 1) { - PenSize(gc->line_width, gc->line_width); - } + PenNormal(); + if(gc->function == GXxor) { + PenMode(patXor); + } + if (gc->line_width > 1) { + PenSize(gc->line_width, gc->line_width); } } diff --git a/mac/tkMacEmbed.c b/mac/tkMacEmbed.c index 58f4c88..a5e97f8 100644 --- a/mac/tkMacEmbed.c +++ b/mac/tkMacEmbed.c @@ -8,12 +8,12 @@ * Currently only Toplevel embedding within the same Tk application is * allowed on the Macintosh. * - * Copyright (c) 1996-97 Sun Microsystems, Inc. + * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacEmbed.c,v 1.3 1998/09/14 18:23:35 stanton Exp $ + * RCS: @(#) $Id: tkMacEmbed.c,v 1.4 1999/04/16 01:51:30 stanton Exp $ */ #include "tkInt.h" @@ -217,7 +217,7 @@ TkpMakeWindow( * Results: * The return value is normally TCL_OK. If an error occurs (such * as string not being a valid window spec), then the return value - * is TCL_ERROR and an error message is left in interp->result if + * is TCL_ERROR and an error message is left in the interp's result if * interp is non-NULL. * * Side effects: diff --git a/mac/tkMacFont.c b/mac/tkMacFont.c index 1a75249..b68f414 100644 --- a/mac/tkMacFont.c +++ b/mac/tkMacFont.c @@ -10,36 +10,389 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacFont.c,v 1.3 1999/04/16 01:25:54 stanton Exp $ + * RCS: @(#) $Id: tkMacFont.c,v 1.4 1999/04/16 01:51:30 stanton Exp $ */ #include <Windows.h> #include <Strings.h> #include <Fonts.h> +#include <Script.h> #include <Resources.h> +#include <TextUtils.h> #include "tkMacInt.h" #include "tkFont.h" -#include "tkPort.h" /* - * The following structure represents the Macintosh's' implementation of a - * font. + * For doing things with Mac strings and Fixed numbers. This probably should move + * the mac header file. */ +#ifndef StrLength +#define StrLength(s) (*((unsigned char *) (s))) +#endif +#ifndef StrBody +#define StrBody(s) ((char *) (s) + 1) +#endif +#define pstrcmp(s1, s2) RelString((s1), (s2), 1, 1) +#define pstrcasecmp(s1, s2) RelString((s1), (s2), 0, 1) + +#ifndef Fixed2Int +#define Fixed2Int(f) ((f) >> 16) +#define Int2Fixed(i) ((i) << 16) +#endif + +/* + * The preferred font encodings. + */ + +static CONST char *encodingList[] = { + "macRoman", "macJapan", NULL +}; + +/* + * The following structures are used to map the script/language codes of a + * font to the name that should be passed to Tcl_GetTextEncoding() to obtain + * the encoding for that font. The set of numeric constants is fixed and + * defined by Apple. + */ + +static TkStateMap scriptMap[] = { + {smRoman, "macRoman"}, + {smJapanese, "macJapan"}, + {smTradChinese, "macChinese"}, + {smKorean, "macKorean"}, + {smArabic, "macArabic"}, + {smHebrew, "macHebrew"}, + {smGreek, "macGreek"}, + {smCyrillic, "macCyrillic"}, + {smRSymbol, "macRSymbol"}, + {smDevanagari, "macDevanagari"}, + {smGurmukhi, "macGurmukhi"}, + {smGujarati, "macGujarati"}, + {smOriya, "macOriya"}, + {smBengali, "macBengali"}, + {smTamil, "macTamil"}, + {smTelugu, "macTelugu"}, + {smKannada, "macKannada"}, + {smMalayalam, "macMalayalam"}, + {smSinhalese, "macSinhalese"}, + {smBurmese, "macBurmese"}, + {smKhmer, "macKhmer"}, + {smThai, "macThailand"}, + {smLaotian, "macLaos"}, + {smGeorgian, "macGeorgia"}, + {smArmenian, "macArmenia"}, + {smSimpChinese, "macSimpChinese"}, + {smTibetan, "macTIbet"}, + {smMongolian, "macMongolia"}, + {smGeez, "macEthiopia"}, + {smEastEurRoman, "macCentEuro"}, + {smVietnamese, "macVietnam"}, + {smExtArabic, "macSindhi"}, + {NULL, NULL} +}; + +static TkStateMap romanMap[] = { + {langCroatian, "macCroatian"}, + {langSlovenian, "macCroatian"}, + {langIcelandic, "macIceland"}, + {langRomanian, "macRomania"}, + {langTurkish, "macTurkish"}, + {langGreek, "macGreek"}, + {NULL, NULL} +}; + +static TkStateMap cyrillicMap[] = { + {langUkrainian, "macUkraine"}, + {langBulgarian, "macBulgaria"}, + {NULL, NULL} +}; + +/* + * The following structure represents a font family. It is assumed that + * all screen fonts constructed from the same "font family" share certain + * properties; all screen fonts with the same "font family" point to a + * shared instance of this structure. The most important shared property + * is the character existence metrics, used to determine if a screen font + * can display a given Unicode character. + * + * Under Macintosh, a "font family" is uniquely identified by its face number. + */ + + +#define FONTMAP_SHIFT 10 + +#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar) * 8 - FONTMAP_SHIFT)) +#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT) + +typedef struct FontFamily { + struct FontFamily *nextPtr; /* Next in list of all known font families. */ + int refCount; /* How many SubFonts are referring to this + * FontFamily. When the refCount drops to + * zero, this FontFamily may be freed. */ + /* + * Key. + */ + + short faceNum; /* Unique face number key for this FontFamily. */ + + /* + * Derived properties. + */ + + Tcl_Encoding encoding; /* Encoding for this font family. */ + int isSymbolFont; /* Non-zero if this is a symbol family. */ + int isMultiByteFont; /* Non-zero if this is a multi-byte family. */ + char typeTable[256]; /* Table that identfies all lead bytes for a + * multi-byte family, used when measuring chars. + * If a byte is a lead byte, the value at the + * corresponding position in the typeTable is 1, + * otherwise 0. If this is a single-byte font, + * all entries are 0. */ + char *fontMap[FONTMAP_PAGES]; + /* Two-level sparse table used to determine + * quickly if the specified character exists. + * As characters are encountered, more pages + * in this table are dynamically added. The + * contents of each page is a bitmask + * consisting of FONTMAP_BITSPERPAGE bits, + * representing whether this font can be used + * to display the given character at the + * corresponding bit position. The high bits + * of the character are used to pick which + * page of the table is used. */ +} FontFamily; + +/* + * The following structure encapsulates an individual screen font. A font + * object is made up of however many SubFonts are necessary to display a + * stream of multilingual characters. + */ + +typedef struct SubFont { + char **fontMap; /* Pointer to font map from the FontFamily, + * cached here to save a dereference. */ + FontFamily *familyPtr; /* The FontFamily for this SubFont. */ +} SubFont; + +/* + * The following structure represents Macintosh's implementation of a font + * object. + */ + +#define SUBFONT_SPACE 3 + typedef struct MacFont { TkFont font; /* Stuff used by generic font package. Must * be first in structure. */ - short family; - short size; - short style; + SubFont staticSubFonts[SUBFONT_SPACE]; + /* Builtin space for a limited number of + * SubFonts. */ + int numSubFonts; /* Length of following array. */ + SubFont *subFontArray; /* Array of SubFonts that have been loaded + * in order to draw/measure all the characters + * encountered by this font so far. All fonts + * start off with one SubFont initialized by + * AllocFont() from the original set of font + * attributes. Usually points to + * staticSubFonts, but may point to malloced + * space if there are lots of SubFonts. */ + + short size; /* Font size in pixels, constructed from + * font attributes. */ + short style; /* Style bits, constructed from font + * attributes. */ } MacFont; +/* + * The following structure is used to map between the UTF-8 name for a font and + * the name that the Macintosh uses to refer to the font, in order to determine + * if a font exists. The Macintosh names for fonts are stored in the encoding + * of the font itself. + */ + +typedef struct FontNameMap { + Tk_Uid utfName; /* The name of the font in UTF-8. */ + StringPtr nativeName; /* The name of the font in the font's encoding. */ + short faceNum; /* Unique face number for this font. */ +} FontNameMap; + +/* + * The list of font families that are currently loaded. As screen fonts + * are loaded, this list grows to hold information about what characters + * exist in each font family. + */ + +static FontFamily *fontFamilyList = NULL; + +/* + * Information cached about the system at startup time. + */ + +static FontNameMap *gFontNameMap = NULL; static GWorldPtr gWorld = NULL; -static TkFont * AllocMacFont _ANSI_ARGS_((TkFont *tkfont, - Tk_Window tkwin, int family, int size, int style)); +/* + * Procedures used only in this file. + */ + +static FontFamily * AllocFontFamily(CONST MacFont *fontPtr, int family); +static SubFont * CanUseFallback(MacFont *fontPtr, + CONST char *fallbackName, int ch); +static SubFont * CanUseFallbackWithAliases(MacFont *fontPtr, + char *faceName, int ch, Tcl_DString *nameTriedPtr); +static SubFont * FindSubFontForChar(MacFont *fontPtr, int ch); +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 void InitFont(Tk_Window tkwin, int family, int size, + int style, MacFont *fontPtr); +static void InitSubFont(CONST MacFont *fontPtr, int family, + SubFont *subFontPtr); +static void MultiFontDrawText(MacFont *fontPtr, + CONST char *source, int numBytes, int x, int y); +static void ReleaseFont(MacFont *fontPtr); +static void ReleaseSubFont(SubFont *subFontPtr); +static int SeenName(CONST char *name, Tcl_DString *dsPtr); + +static char * BreakLine(FontFamily *familyPtr, int flags, + CONST char *source, int numBytes, int *widthPtr); +static int GetFamilyNum(CONST char *faceName, short *familyPtr); +static int GetFamilyOrAliasNum(CONST char *faceName, + short *familyPtr); +static Tcl_Encoding GetFontEncoding(int faceNum, int allowSymbol, + int *isSymbolPtr); +static Tk_Uid GetUtfFaceName(StringPtr faceNameStr); + + +/* + *------------------------------------------------------------------------- + * + * TkpFontPkgInit -- + * + * This procedure is called when an application is created. It + * initializes all the structures that are used by the + * platform-dependant code on a per application basis. + * + * Results: + * None. + * + * Side effects: + * See comments below. + * + *------------------------------------------------------------------------- + */ +void +TkpFontPkgInit(mainPtr) + TkMainInfo *mainPtr; /* The application being created. */ +{ + MenuHandle fontMenu; + FontNameMap *tmpFontNameMap, *newFontNameMap, *mapPtr; + int i, j, numFonts, fontMapOffset, isSymbol; + Str255 nativeName; + Tcl_DString ds; + Tcl_Encoding encoding; + Tcl_Encoding *encodings; + + if (gWorld == NULL) { + /* + * Do the following one time only. + */ + + Rect rect = {0, 0, 1, 1}; + + SetFractEnable(0); + + /* + * Used for saving and restoring state while drawing and measuring. + */ + + if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) { + panic("TkpFontPkgInit: NewGWorld failed"); + } + + /* + * The name of each font is stored in the encoding of that font. + * How would we translate a name from UTF-8 into the native encoding + * of the font unless we knew the encoding of that font? We can't. + * So, precompute the UTF-8 and native names of all fonts on the + * system. The when the user asks for font by its UTF-8 name, we + * lookup the name in that table and really ask for the font by its + * native name. Any unknown UTF-8 names will be mapped to the system + * font. + */ + + fontMenu = NewMenu('FT', "\px"); + AddResMenu(fontMenu, 'FONT'); + + numFonts = CountMItems(fontMenu); + tmpFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * numFonts); + encodings = (Tcl_Encoding *) ckalloc(sizeof(Tcl_Encoding) * numFonts); + + mapPtr = tmpFontNameMap; + for (i = 0; i < numFonts; i++) { + GetMenuItemText(fontMenu, i + 1, nativeName); + GetFNum(nativeName, &mapPtr->faceNum); + encodings[i] = GetFontEncoding(mapPtr->faceNum, 0, &isSymbol); + Tcl_ExternalToUtfDString(encodings[i], StrBody(nativeName), + StrLength(nativeName), &ds); + mapPtr->utfName = Tk_GetUid(Tcl_DStringValue(&ds)); + mapPtr->nativeName = (StringPtr) ckalloc(StrLength(nativeName) + 1); + memcpy(mapPtr->nativeName, nativeName, StrLength(nativeName) + 1); + Tcl_DStringFree(&ds); + mapPtr++; + } + DisposeMenu(fontMenu); + + /* + * Reorder FontNameMap so fonts with the preferred encodings are at + * the front of the list. The relative order of fonts that all have + * the same encoding is preserved. Fonts with unknown encodings get + * stuck at the end. + */ + + newFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * (numFonts + 1)); + fontMapOffset = 0; + for (i = 0; encodingList[i] != NULL; i++) { + encoding = Tcl_GetEncoding(NULL, encodingList[i]); + if (encoding == NULL) { + continue; + } + for (j = 0; j < numFonts; j++) { + if (encodings[j] == encoding) { + newFontNameMap[fontMapOffset] = tmpFontNameMap[j]; + fontMapOffset++; + Tcl_FreeEncoding(encodings[j]); + tmpFontNameMap[j].utfName = NULL; + } + } + Tcl_FreeEncoding(encoding); + } + for (i = 0; i < numFonts; i++) { + if (tmpFontNameMap[i].utfName != NULL) { + newFontNameMap[fontMapOffset] = tmpFontNameMap[i]; + fontMapOffset++; + Tcl_FreeEncoding(encodings[i]); + } + } + if (fontMapOffset != numFonts) { + panic("TkpFontPkgInit: unexpected number of fonts"); + } + + mapPtr = &newFontNameMap[numFonts]; + mapPtr->utfName = NULL; + mapPtr->nativeName = NULL; + mapPtr->faceNum = 0; + + ckfree((char *) tmpFontNameMap); + ckfree((char *) encodings); + + gFontNameMap = newFontNameMap; + } +} /* *--------------------------------------------------------------------------- @@ -73,6 +426,7 @@ TkpGetNativeFont( CONST char *name) /* Platform-specific font name. */ { short family; + MacFont *fontPtr; if (strcmp(name, "system") == 0) { family = GetSysFont(); @@ -81,8 +435,11 @@ TkpGetNativeFont( } else { return NULL; } - - return AllocMacFont(NULL, tkwin, family, 0, 0); + + fontPtr = (MacFont *) ckalloc(sizeof(MacFont)); + InitFont(tkwin, family, 0, 0, fontPtr); + + return (TkFont *) fontPtr; } /* @@ -122,41 +479,47 @@ 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) /* Set of attributes to match. */ + CONST TkFontAttributes *faPtr) + /* Set of attributes to match. */ { - char buf[257]; - size_t len; - short family, size, style; - - if (faPtr->family == NULL) { - family = 0; - } else { - CONST char *familyName; - - familyName = faPtr->family; - if (strcasecmp(familyName, "Times New Roman") == 0) { - familyName = "Times"; - } else if (strcasecmp(familyName, "Courier New") == 0) { - familyName = "Courier"; - } else if (strcasecmp(familyName, "Arial") == 0) { - familyName = "Helvetica"; - } - - len = strlen(familyName); - if (len > 255) { - len = 255; + short faceNum, style; + int i, j; + char *faceName, *fallback; + char ***fallbacks; + MacFont *fontPtr; + + /* + * Algorithm to get the closest font to the one requested. + * + * try fontname + * try all aliases for fontname + * foreach fallback for fontname + * try the fallback + * try all aliases for the fallback + */ + + faceNum = 0; + faceName = faPtr->family; + if (faceName != NULL) { + if (GetFamilyOrAliasNum(faceName, &faceNum) != 0) { + goto found; + } + fallbacks = TkFontGetFallbacks(); + for (i = 0; fallbacks[i] != NULL; i++) { + for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) { + if (strcasecmp(faceName, fallback) == 0) { + for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) { + if (GetFamilyOrAliasNum(fallback, &faceNum)) { + goto found; + } + } + } + break; + } } - buf[0] = (char) len; - memcpy(buf + 1, familyName, len); - buf[len + 1] = '\0'; - GetFNum((StringPtr) buf, &family); } - - size = faPtr->pointsize; - if (size <= 0) { - size = GetDefFontSize(); - } - + + found: style = 0; if (faPtr->weight != TK_FW_NORMAL) { style |= bold; @@ -167,8 +530,15 @@ TkpGetFontFromAttributes( if (faPtr->underline) { style |= underline; } - - return AllocMacFont(tkFontPtr, tkwin, family, size, style); + if (tkFontPtr == NULL) { + fontPtr = (MacFont *) ckalloc(sizeof(MacFont)); + } else { + fontPtr = (MacFont *) tkFontPtr; + ReleaseFont(fontPtr); + } + InitFont(tkwin, faceNum, faPtr->size, style, fontPtr); + + return (TkFont *) fontPtr; } /* @@ -194,7 +564,10 @@ void TkpDeleteFont( TkFont *tkFontPtr) /* Token of font to be deleted. */ { - ckfree((char *) tkFontPtr); + MacFont *fontPtr; + + fontPtr = (MacFont *) tkFontPtr; + ReleaseFont(fontPtr); } /* @@ -206,7 +579,7 @@ TkpDeleteFont( * on the display of the given window. * * Results: - * interp->result is modified to hold a list of all the available + * Modifies interp's result object to hold a list of all the available * font families. * * Side effects: @@ -220,76 +593,54 @@ TkpGetFontFamilies( Tcl_Interp *interp, /* Interp to hold result. */ Tk_Window tkwin) /* For display to query. */ { - MenuHandle fontMenu; - int i; - char itemText[257]; - - fontMenu = NewMenu(1, "\px"); - AddResMenu(fontMenu, 'FONT'); - - for (i = 1; i < CountMItems(fontMenu); i++) { - /* - * Each item is a pascal string. Convert it to C and append. - */ - GetMenuItemText(fontMenu, i, (unsigned char *) itemText); - itemText[itemText[0] + 1] = '\0'; - Tcl_AppendElement(interp, &itemText[1]); + FontNameMap *mapPtr; + Tcl_Obj *resultPtr, *strPtr; + + resultPtr = Tcl_GetObjResult(interp); + for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) { + strPtr = Tcl_NewStringObj(mapPtr->utfName, -1); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } - DisposeMenu(fontMenu); } - /* - *--------------------------------------------------------------------------- + *------------------------------------------------------------------------- * - * TkMacIsCharacterMissing -- + * TkpGetSubFonts -- * - * Given a tkFont and a character determines whether the character has - * a glyph defined in the font or not. Note that this is potentially - * not compatible with Mac OS 8 as it looks at the font handle - * structure directly. Looks into the character array of the font - * handle to determine whether the glyph is defined or not. + * A function used by the testing package for querying the actual + * screen fonts that make up a font object. * * Results: - * Returns a 1 if the character is missing, a 0 if it is not. + * Modifies interp's result object to hold a list containing the + * names of the screen fonts that make up the given font object. * * Side effects: * None. * - *--------------------------------------------------------------------------- + *------------------------------------------------------------------------- */ - -int -TkMacIsCharacterMissing( - Tk_Font tkfont, /* The font we are looking in. */ - unsigned int searchChar) /* The character we are looking for. */ + +void +TkpGetSubFonts(interp, tkfont) + Tcl_Interp *interp; /* Interp to hold result. */ + Tk_Font tkfont; /* Font object to query. */ { - MacFont *fontPtr = (MacFont *) tkfont; - FMInput fm; - FontRec **fontRecHandle; - - fm.family = fontPtr->family; - fm.size = fontPtr->size; - fm.face = fontPtr->style; - fm.needBits = 0; - fm.device = 0; - fm.numer.h = fm.numer.v = fm.denom.h = fm.denom.v = 1; + int i; + Tcl_Obj *resultPtr, *strPtr; + MacFont *fontPtr; + FontFamily *familyPtr; + Str255 nativeName; - /* - * This element of the FMOutput structure was changed between the 2.0 & 3.0 - * versions of the Universal Headers. - */ - -#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300) - fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontResult; -#else - fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontHandle; -#endif - return *(short *) ((long) &(*fontRecHandle)->owTLoc - + ((long)((*fontRecHandle)->owTLoc + searchChar - - (*fontRecHandle)->firstChar) * sizeof(short))) == -1; + resultPtr = Tcl_GetObjResult(interp); + fontPtr = (MacFont *) tkfont; + for (i = 0; i < fontPtr->numSubFonts; i++) { + familyPtr = fontPtr->subFontArray[i].familyPtr; + GetFontName(familyPtr->faceNum, nativeName); + strPtr = Tcl_NewStringObj(GetUtfFaceName(nativeName), -1); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); + } } - /* *--------------------------------------------------------------------------- @@ -302,7 +653,7 @@ TkMacIsCharacterMissing( * the characters. * * Results: - * The return value is the number of characters from source that + * The return value is the number of bytes from source that * fit into the span that extends from 0 to maxLength. *lengthPtr is * filled with the x-coordinate of the right edge of the last * character that did fit. @@ -316,14 +667,14 @@ TkMacIsCharacterMissing( int Tk_MeasureChars( Tk_Font tkfont, /* Font in which characters will be drawn. */ - CONST char *source, /* Characters to be displayed. Need not be + CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ - int numChars, /* Maximum number of characters to consider + int numBytes, /* Maximum number of bytes to consider * from source string. */ - int maxLength, /* If > 0, maxLength specifies the longest + int maxLength, /* If >= 0, maxLength specifies the longest * permissible line length; don't consider any * character that would cross this - * x-position. If <= 0, then line length is + * x-position. If < 0, then line length is * unbounded and the flags argument is * ignored. */ int flags, /* Various flag bits OR-ed together: @@ -336,134 +687,270 @@ Tk_MeasureChars( int *lengthPtr) /* Filled with x-location just after the * terminating character. */ { - short staticWidths[128]; - short *widths; - CONST char *p, *term; - int curX, termX, curIdx, sawNonSpace; MacFont *fontPtr; + FontFamily *lastFamilyPtr; CGrafPtr saveWorld; GDHandle saveDevice; + int curX, curByte; - if (numChars == 0) { - *lengthPtr = 0; - return 0; - } - - if (gWorld == NULL) { - Rect rect = {0, 0, 1, 1}; + /* + * According to "Inside Macintosh: Text", the Macintosh may + * automatically substitute + * ligatures or context-sensitive presentation forms when + * measuring/displaying text within a font run. We cannot safely + * measure individual characters and add up the widths w/o errors. + * However, if we convert a range of text from UTF-8 to, say, + * Shift-JIS, and get the offset into the Shift-JIS string as to + * where a word or line break would occur, then can we map that + * number back to UTF-8? + */ + + fontPtr = (MacFont *) tkfont; - if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) { - panic("NewGWorld failed in Tk_MeasureChars"); - } - } GetGWorld(&saveWorld, &saveDevice); SetGWorld(gWorld, NULL); - - fontPtr = (MacFont *) tkfont; - TextFont(fontPtr->family); + TextSize(fontPtr->size); TextFace(fontPtr->style); - if (maxLength <= 0) { - *lengthPtr = TextWidth(source, 0, numChars); - SetGWorld(saveWorld, saveDevice); - return numChars; - } - - if (numChars > maxLength) { - /* - * Assume that all chars are at least 1 pixel wide, so there's no - * need to measure more characters than there are pixels. This - * assumption could be refined to an iterative approach that would - * use that as a starting point and try more chars if necessary (if - * there actually were some zero-width chars). - */ - - numChars = maxLength; - } - if (numChars > SHRT_MAX) { - /* - * If they are trying to measure more than 32767 chars at one time, - * it would require several separate measurements. - */ - - numChars = SHRT_MAX; - } - - widths = staticWidths; - if (numChars >= sizeof(staticWidths) / sizeof(staticWidths[0])) { - widths = (short *) ckalloc((numChars + 1) * sizeof(short)); - } + lastFamilyPtr = fontPtr->subFontArray[0].familyPtr; - MeasureText((short) numChars, source, widths); - - if (widths[numChars] <= maxLength) { - curX = widths[numChars]; - curIdx = numChars; + if (numBytes == 0) { + curX = 0; + curByte = 0; + } else if (maxLength < 0) { + CONST char *p, *end, *next; + Tcl_UniChar ch; + FontFamily *thisFamilyPtr; + Tcl_DString runString; + + /* + * A three step process: + * 1. Find a contiguous range of characters that can all be + * represented by a single screen font. + * 2. Convert those chars to the encoding of that font. + * 3. Measure converted chars. + */ + + curX = 0; + end = source + numBytes; + for (p = source; p < end; ) { + next = p + Tcl_UtfToUniChar(p, &ch); + thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr; + if (thisFamilyPtr != lastFamilyPtr) { + TextFont(lastFamilyPtr->faceNum); + Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, + p - source, &runString); + curX += TextWidth(Tcl_DStringValue(&runString), 0, + Tcl_DStringLength(&runString)); + Tcl_DStringFree(&runString); + lastFamilyPtr = thisFamilyPtr; + source = p; + } + p = next; + } + TextFont(lastFamilyPtr->faceNum); + Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, p - source, + &runString); + curX += TextWidth(Tcl_DStringValue(&runString), 0, + Tcl_DStringLength(&runString)); + Tcl_DStringFree(&runString); + curByte = numBytes; } else { - p = term = source; - curX = termX = 0; - - sawNonSpace = !isspace(UCHAR(*p)); - for (curIdx = 1; ; curIdx++) { - if (isspace(UCHAR(*p))) { - if (sawNonSpace) { - term = p; - termX = widths[curIdx - 1]; - sawNonSpace = 0; - } - } else { - sawNonSpace = 1; - } - if (widths[curIdx] > maxLength) { - curIdx--; - curX = widths[curIdx]; - break; + CONST char *p, *end, *next, *sourceOrig; + int widthLeft; + FontFamily *thisFamilyPtr; + Tcl_UniChar ch; + char *rest; + + /* + * How many chars will fit in the space allotted? + */ + + if (maxLength > 32767) { + maxLength = 32767; + } + + widthLeft = maxLength; + sourceOrig = source; + end = source + numBytes; + for (p = source; p < end; p = next) { + next = p + Tcl_UtfToUniChar(p, &ch); + thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr; + if (thisFamilyPtr != lastFamilyPtr) { + if (p > source) { + rest = BreakLine(lastFamilyPtr, flags, source, + p - source, &widthLeft); + flags &= ~TK_AT_LEAST_ONE; + if (rest != NULL) { + p = source; + break; + } + } + lastFamilyPtr = thisFamilyPtr; + source = p; } - p++; } - if (flags & TK_PARTIAL_OK) { - curIdx++; - curX = widths[curIdx]; + + if (p > source) { + rest = BreakLine(lastFamilyPtr, flags, source, p - source, + &widthLeft); } - if ((curIdx == 0) && (flags & TK_AT_LEAST_ONE)) { - /* - * The space was too small to hold even one character. Since at - * least one character must always fit on a line, return the width - * of the first character. - */ - - curX = TextWidth(source, 0, 1); - curIdx = 1; - } else if (flags & TK_WHOLE_WORDS) { - /* - * Break at last word that fits on the line. - */ - - if ((flags & TK_AT_LEAST_ONE) && (term == source)) { - /* - * The space was too small to hold an entire word. This - * is the only word on the line, so just return the part of th - * word that fit. - */ - - ; - } else { - curIdx = term - source; - curX = termX; - } - } + + if (rest == NULL) { + curByte = numBytes; + } else { + curByte = rest - sourceOrig; + } + curX = maxLength - widthLeft; } - if (widths != staticWidths) { - ckfree((char *) widths); - } + SetGWorld(saveWorld, saveDevice); *lengthPtr = curX; + return curByte; +} + +/* + *--------------------------------------------------------------------------- + * + * BreakLine -- + * + * Determine where the given line of text should be broken so that it + * fits in the specified range. Before calling this function, the + * font values and graphics port must be set. + * + * Results: + * The return value is NULL if the specified range is larger that the + * space the text needs, and *widthLeftPtr is filled with how much + * space is left in the range after measuring the whole text buffer. + * Otherwise, the return value is a pointer into the text buffer that + * indicates where the line should be broken (up to, but not including + * that character), and *widthLeftPtr is filled with how much space is + * left in the range after measuring up to that character. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static char * +BreakLine( + FontFamily *familyPtr, /* FontFamily that describes the font values + * that are already selected into the graphics + * port. */ + int flags, /* Various flag bits OR-ed together: + * TK_PARTIAL_OK means include the last char + * which only partially fit on this line. + * TK_WHOLE_WORDS means stop on a word + * boundary, if possible. + * TK_AT_LEAST_ONE means return at least one + * character even if no characters fit. */ + 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. */ + int *widthLeftPtr) /* On input, specifies size of range into + * which characters from source buffer should + * be fit. On output, filled with how much + * space is left after fitting as many + * characters as possible into the range. + * Result may be negative if TK_AT_LEAST_ONE + * was specified in the flags argument. */ +{ + Fixed pixelWidth, widthLeft; + StyledLineBreakCode breakCode; + Tcl_DString runString; + long textOffset; + Boolean leadingEdge; + Point point; + int charOffset, thisCharWasDoubleByte; + char *p, *end, *typeTable; - SetGWorld(saveWorld, saveDevice); + TextFont(familyPtr->faceNum); + Tcl_UtfToExternalDString(familyPtr->encoding, source, numBytes, + &runString); + pixelWidth = Int2Fixed(*widthLeftPtr) + 1; + if (flags & TK_WHOLE_WORDS) { + textOffset = (flags & TK_AT_LEAST_ONE); + widthLeft = pixelWidth; + breakCode = StyledLineBreak(Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString), 0, Tcl_DStringLength(&runString), + 0, &widthLeft, &textOffset); + if (breakCode != smBreakOverflow) { + /* + * StyledLineBreak includes all the space characters at the end of + * line that we want to suppress. + */ + + textOffset = VisibleLength(Tcl_DStringValue(&runString), textOffset); + goto getoffset; + } + } else { + point.v = 1; + point.h = 1; + textOffset = PixelToChar(Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString), 0, pixelWidth, &leadingEdge, + &widthLeft, smOnlyStyleRun, point, point); + if (Fixed2Int(widthLeft) < 0) { + goto getoffset; + } + } + *widthLeftPtr = Fixed2Int(widthLeft); + Tcl_DStringFree(&runString); + return NULL; + + /* + * The conversion routine that converts UTF-8 to the target encoding + * must map one UTF-8 character to exactly one encoding-specific + * character, so that the following algorithm works: + * + * 1. Get byte offset of where line should be broken. + * 2. Get char offset corresponding to that byte offset. + * 3. Map that char offset to byte offset in UTF-8 string. + */ + + getoffset: + thisCharWasDoubleByte = 0; + if (familyPtr->isMultiByteFont == 0) { + charOffset = textOffset; + } else { + charOffset = 0; + typeTable = familyPtr->typeTable; + + p = Tcl_DStringValue(&runString); + end = p + textOffset; + thisCharWasDoubleByte = typeTable[*((unsigned char *) p)]; + for ( ; p < end; p++) { + thisCharWasDoubleByte = typeTable[*((unsigned char *) p)]; + p += thisCharWasDoubleByte; + charOffset++; + } + } - return curIdx; + if ((flags & TK_WHOLE_WORDS) == 0) { + if ((flags & TK_PARTIAL_OK) && (leadingEdge != 0)) { + textOffset += thisCharWasDoubleByte; + textOffset++; + charOffset++; + } else if (((flags & TK_PARTIAL_OK) == 0) && (leadingEdge == 0)) { + textOffset -= thisCharWasDoubleByte; + textOffset--; + charOffset--; + } + } + if ((textOffset == 0) && (Tcl_DStringLength(&runString) > 0) + && (flags & TK_AT_LEAST_ONE)) { + p = Tcl_DStringValue(&runString); + textOffset += familyPtr->typeTable[*((unsigned char *) p)]; + textOffset++; + charOffset++; + } + *widthLeftPtr = Fixed2Int(pixelWidth) + - TextWidth(Tcl_DStringValue(&runString), 0, textOffset); + Tcl_DStringFree(&runString); + return Tcl_UtfAtIndex(source, charOffset); } /* @@ -489,14 +976,14 @@ 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, /* Characters 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 * is passed to this function. If they are * not stripped out, they will be displayed as * regular printing characters. */ - int numChars, /* Number of characters in string. */ + int numBytes, /* Number of bytes in string. */ int x, int y) /* Coordinates at which to place origin of * string when drawing. */ { @@ -538,19 +1025,12 @@ Tk_DrawChars( bufferPort = TkMacGetDrawablePort(pixmap); SetGWorld(bufferPort, NULL); - TextFont(fontPtr->family); - TextSize(fontPtr->size); - TextFace(fontPtr->style); - - if (TkSetMacColor(gc->foreground, &macColor)) { + if (TkSetMacColor(gc->foreground, &macColor) == true) { RGBForeColor(&macColor); } - ShowPen(); - MoveTo((short) 0, (short) 0); FillRect(&stippleMap->bounds, &tcl_macQdPtr->white); - MoveTo((short) x, (short) y); - DrawText(source, 0, (short) numChars); + MultiFontDrawText(fontPtr, source, numBytes, 0, 0); SetGWorld(destPort, NULL); CopyDeepMask(&((GrafPtr) bufferPort)->portBits, stippleMap, @@ -565,18 +1045,13 @@ Tk_DrawChars( Tk_FreePixmap(display, pixmap); ckfree(stippleMap->baseAddr); ckfree((char *)stippleMap); - } else { - TextFont(fontPtr->family); - TextSize(fontPtr->size); - TextFace(fontPtr->style); - + } else { if (TkSetMacColor(gc->foreground, &macColor) == true) { RGBForeColor(&macColor); } - ShowPen(); - MoveTo((short) (macWin->xOff + x), (short) (macWin->yOff + y)); - DrawText(source, 0, (short) numChars); + MultiFontDrawText(fontPtr, source, numBytes, macWin->xOff + x, + macWin->yOff + y); } TextFont(txFont); @@ -587,92 +1062,1057 @@ Tk_DrawChars( } /* + *------------------------------------------------------------------------- + * + * MultiFontDrawText -- + * + * Helper function for Tk_DrawChars. Draws characters, using the + * various screen fonts in fontPtr to draw multilingual characters. + * Note: No bidirectional support. + * + * Results: + * None. + * + * Side effects: + * Information gets drawn on the screen. + * Contents of fontPtr may be modified if more subfonts were loaded + * in order to draw all the multilingual characters in the given + * string. + * + *------------------------------------------------------------------------- + */ + +static void +MultiFontDrawText( + MacFont *fontPtr, /* Contains set of fonts to use when drawing + * following 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 string when drawing. */ +{ + FontFamily *lastFamilyPtr, *thisFamilyPtr; + Tcl_DString runString; + CONST char *p, *end, *next; + Tcl_UniChar ch; + + TextSize(fontPtr->size); + TextFace(fontPtr->style); + + lastFamilyPtr = fontPtr->subFontArray[0].familyPtr; + + end = source + numBytes; + for (p = source; p < end; ) { + next = p + Tcl_UtfToUniChar(p, &ch); + thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr; + if (thisFamilyPtr != lastFamilyPtr) { + if (p > source) { + TextFont(lastFamilyPtr->faceNum); + Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, + p - source, &runString); + MoveTo((short) x, (short) y); + DrawText(Tcl_DStringValue(&runString), 0, + Tcl_DStringLength(&runString)); + x += TextWidth(Tcl_DStringValue(&runString), 0, + Tcl_DStringLength(&runString)); + Tcl_DStringFree(&runString); + source = p; + } + lastFamilyPtr = thisFamilyPtr; + } + p = next; + } + if (p > source) { + TextFont(thisFamilyPtr->faceNum); + Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, + p - source, &runString); + MoveTo((short) x, (short) y); + DrawText(Tcl_DStringValue(&runString), 0, + Tcl_DStringLength(&runString)); + Tcl_DStringFree(&runString); + } +} + +/* *--------------------------------------------------------------------------- * - * AllocMacFont -- + * TkMacIsCharacterMissing -- * - * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). - * Allocates and intializes the memory for a new TkFont that - * wraps the platform-specific data. + * Given a tkFont and a character determines whether the character has + * a glyph defined in the font or not. Note that this is potentially + * not compatible with Mac OS 8 as it looks at the font handle + * structure directly. Looks into the character array of the font + * handle to determine whether the glyph is defined or not. * * Results: - * Returns pointer to newly constructed TkFont. + * Returns a 1 if the character is missing, a 0 if it is not. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +TkMacIsCharacterMissing( + Tk_Font tkfont, /* The font we are looking in. */ + unsigned int searchChar) /* The character we are looking for. */ +{ + MacFont *fontPtr = (MacFont *) tkfont; + FMInput fm; + FontRec **fontRecHandle; + + fm.family = fontPtr->subFontArray[0].familyPtr->faceNum; + fm.size = fontPtr->size; + fm.face = fontPtr->style; + fm.needBits = 0; + fm.device = 0; + fm.numer.h = fm.numer.v = fm.denom.h = fm.denom.v = 1; + +#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300) + fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontResult; +#else + fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontHandle; +#endif + return *(short *) ((long) &(*fontRecHandle)->owTLoc + + ((long)((*fontRecHandle)->owTLoc + searchChar + - (*fontRecHandle)->firstChar) * sizeof(short))) == -1; +} + +/* + *--------------------------------------------------------------------------- + * + * InitFont -- + * + * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). + * Initializes the memory for a MacFont that wraps the platform-specific + * data. * * The caller is responsible for initializing the fields of the * TkFont that are used exclusively by the generic TkFont code, and * for releasing those fields before calling TkpDeleteFont(). * + * Results: + * Fills the MacFont structure. + * * Side effects: * Memory allocated. * *--------------------------------------------------------------------------- */ -static TkFont * -AllocMacFont( - TkFont *tkFontPtr, /* If non-NULL, store the information in - * this existing TkFont structure, rather than - * allocating a new structure to hold the - * font; the existing contents of the font - * will be released. If NULL, a new TkFont - * structure is allocated. */ +static void +InitFont( Tk_Window tkwin, /* For display where font will be used. */ - int family, /* Macintosh font family. */ + int faceNum, /* Macintosh font number. */ int size, /* Point size for Macintosh font. */ - int style) /* Macintosh style bits. */ + int style, /* Macintosh style bits. */ + MacFont *fontPtr) /* Filled with information constructed from + * the above arguments. */ { - char buf[257]; + Str255 nativeName; FontInfo fi; - MacFont *fontPtr; TkFontAttributes *faPtr; TkFontMetrics *fmPtr; CGrafPtr saveWorld; GDHandle saveDevice; + short pixels; - if (gWorld == NULL) { - Rect rect = {0, 0, 1, 1}; - - if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) { - panic("NewGWorld failed in AllocMacFont"); - } + if (size == 0) { + size = -GetDefFontSize(); } + pixels = (short) TkFontGetPixels(tkwin, size); + GetGWorld(&saveWorld, &saveDevice); SetGWorld(gWorld, NULL); + TextFont(faceNum); + TextSize(pixels); + TextFace(style); - if (tkFontPtr == NULL) { - fontPtr = (MacFont *) ckalloc(sizeof(MacFont)); - } else { - fontPtr = (MacFont *) tkFontPtr; - } + GetFontInfo(&fi); + GetFontName(faceNum, nativeName); fontPtr->font.fid = (Font) fontPtr; - faPtr = &fontPtr->font.fa; - GetFontName(family, (StringPtr) buf); - buf[UCHAR(buf[0]) + 1] = '\0'; - faPtr->family = Tk_GetUid(buf + 1); - faPtr->pointsize = size; + faPtr = &fontPtr->font.fa; + faPtr->family = GetUtfFaceName(nativeName); + faPtr->size = TkFontGetPoints(tkwin, size); faPtr->weight = (style & bold) ? TK_FW_BOLD : TK_FW_NORMAL; faPtr->slant = (style & italic) ? TK_FS_ITALIC : TK_FS_ROMAN; faPtr->underline = ((style & underline) != 0); faPtr->overstrike = 0; - fmPtr = &fontPtr->font.fm; - TextFont(family); - TextSize(size); - TextFace(style); - GetFontInfo(&fi); + fmPtr = &fontPtr->font.fm; fmPtr->ascent = fi.ascent; fmPtr->descent = fi.descent; fmPtr->maxWidth = fi.widMax; fmPtr->fixed = (CharWidth('i') == CharWidth('w')); - - fontPtr->family = (short) family; - fontPtr->size = (short) size; + + fontPtr->size = pixels; fontPtr->style = (short) style; + + fontPtr->numSubFonts = 1; + fontPtr->subFontArray = fontPtr->staticSubFonts; + InitSubFont(fontPtr, faceNum, &fontPtr->subFontArray[0]); SetGWorld(saveWorld, saveDevice); +} + +/* + *------------------------------------------------------------------------- + * + * ReleaseFont -- + * + * Called to release the Macintosh-specific contents of a TkFont. + * The caller is responsible for freeing the memory used by the + * font itself. + * + * Results: + * None. + * + * Side effects: + * Memory is freed. + * + *--------------------------------------------------------------------------- + */ + +static void +ReleaseFont( + MacFont *fontPtr) /* The font to delete. */ +{ + int i; - return (TkFont *) fontPtr; + for (i = 0; i < fontPtr->numSubFonts; i++) { + ReleaseSubFont(&fontPtr->subFontArray[i]); + } + if (fontPtr->subFontArray != fontPtr->staticSubFonts) { + ckfree((char *) fontPtr->subFontArray); + } +} + +/* + *------------------------------------------------------------------------- + * + * InitSubFont -- + * + * Wrap a screen font and load the FontFamily that represents + * it. Used to prepare a SubFont so that characters can be mapped + * from UTF-8 to the charset of the font. + * + * Results: + * The subFontPtr is filled with information about the font. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +InitSubFont( + CONST MacFont *fontPtr, /* Font object in which the SubFont will be + * used. */ + int faceNum, /* The font number. */ + SubFont *subFontPtr) /* Filled with SubFont constructed from + * above attributes. */ +{ + subFontPtr->familyPtr = AllocFontFamily(fontPtr, faceNum); + subFontPtr->fontMap = subFontPtr->familyPtr->fontMap; +} + +/* + *------------------------------------------------------------------------- + * + * ReleaseSubFont -- + * + * Called to release the contents of a SubFont. The caller is + * responsible for freeing the memory used by the SubFont itself. + * + * Results: + * None. + * + * Side effects: + * Memory and resources are freed. + * + *--------------------------------------------------------------------------- + */ + +static void +ReleaseSubFont( + SubFont *subFontPtr) /* The SubFont to delete. */ +{ + FreeFontFamily(subFontPtr->familyPtr); +} + +/* + *------------------------------------------------------------------------- + * + * AllocFontFamily -- + * + * Find the FontFamily structure associated with the given font + * family. The information should be stored by the caller in a + * SubFont and used when determining if that SubFont supports a + * character. + * + * Results: + * A pointer to a FontFamily. The reference count in the FontFamily + * is automatically incremented. When the SubFont is released, the + * reference count is decremented. When no SubFont is using this + * FontFamily, it may be deleted. + * + * Side effects: + * A new FontFamily structure will be allocated if this font family + * has not been seen. + * + *------------------------------------------------------------------------- + */ + +static FontFamily * +AllocFontFamily( + CONST MacFont *fontPtr, /* Font object in which the FontFamily will + * be used. */ + int faceNum) /* The font number. */ +{ + FontFamily *familyPtr; + int i; + + familyPtr = fontFamilyList; + for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) { + if (familyPtr->faceNum == faceNum) { + familyPtr->refCount++; + return familyPtr; + } + } + + familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily)); + memset(familyPtr, 0, sizeof(FontFamily)); + familyPtr->nextPtr = fontFamilyList; + fontFamilyList = familyPtr; + + /* + * Set key for this FontFamily. + */ + + familyPtr->faceNum = faceNum; + + /* + * An initial refCount of 2 means that FontFamily information will + * persist even when the SubFont that loaded the FontFamily is released. + * Change it to 1 to cause FontFamilies to be unloaded when not in use. + */ + + familyPtr->refCount = 2; + familyPtr->encoding = GetFontEncoding(faceNum, 1, &familyPtr->isSymbolFont); + familyPtr->isMultiByteFont = 0; + FillParseTable(familyPtr->typeTable, FontToScript(faceNum)); + for (i = 0; i < 256; i++) { + if (familyPtr->typeTable[i] != 0) { + familyPtr->isMultiByteFont = 1; + break; + } + } + return familyPtr; +} + +/* + *------------------------------------------------------------------------- + * + * FreeFontFamily -- + * + * Called to free a FontFamily when the SubFont is finished using it. + * Frees the contents of the FontFamily and the memory used by the + * FontFamily itself. + * + * Results: + * None. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +FreeFontFamily( + FontFamily *familyPtr) /* The FontFamily to delete. */ +{ + FontFamily **familyPtrPtr; + int i; + + if (familyPtr == NULL) { + return; + } + familyPtr->refCount--; + if (familyPtr->refCount > 0) { + return; + } + Tcl_FreeEncoding(familyPtr->encoding); + for (i = 0; i < FONTMAP_PAGES; i++) { + if (familyPtr->fontMap[i] != NULL) { + ckfree((char *) familyPtr->fontMap[i]); + } + } + + /* + * Delete from list. + */ + + for (familyPtrPtr = &fontFamilyList; ; ) { + if (*familyPtrPtr == familyPtr) { + *familyPtrPtr = familyPtr->nextPtr; + break; + } + familyPtrPtr = &(*familyPtrPtr)->nextPtr; + } + + ckfree((char *) familyPtr); } + +/* + *------------------------------------------------------------------------- + * + * FindSubFontForChar -- + * + * Determine which physical screen font is necessary to use to + * display the given character. If the font object does not have + * a screen font that can display the character, another screen font + * may be loaded into the font object, following a set of preferred + * fallback rules. + * + * Results: + * The return value is the SubFont to use to display the given + * character. + * + * Side effects: + * The contents of fontPtr are modified to cache the results + * of the lookup and remember any SubFonts that were dynamically + * loaded. + * + *------------------------------------------------------------------------- + */ + +static SubFont * +FindSubFontForChar( + MacFont *fontPtr, /* The font object with which the character + * will be displayed. */ + int ch) /* The Unicode character to be displayed. */ +{ + int i, j, k; + char *fallbackName; + char **aliases; + SubFont *subFontPtr; + FontNameMap *mapPtr; + Tcl_DString faceNames; + char ***fontFallbacks; + char **anyFallbacks; + + if (FontMapLookup(&fontPtr->subFontArray[0], ch)) { + return &fontPtr->subFontArray[0]; + } + + for (i = 1; i < fontPtr->numSubFonts; i++) { + if (FontMapLookup(&fontPtr->subFontArray[i], ch)) { + return &fontPtr->subFontArray[i]; + } + } + /* + * Keep track of all face names that we check, so we don't check some + * name multiple times if it can be reached by multiple paths. + */ + + Tcl_DStringInit(&faceNames); + + aliases = TkFontGetAliasList(fontPtr->font.fa.family); + + subFontPtr = NULL; + fontFallbacks = TkFontGetFallbacks(); + for (i = 0; fontFallbacks[i] != NULL; i++) { + for (j = 0; fontFallbacks[i][j] != NULL; j++) { + fallbackName = fontFallbacks[i][j]; + if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) { + /* + * If the base font has a fallback... + */ + + goto tryfallbacks; + } else if (aliases != NULL) { + /* + * Or if an alias for the base font has a fallback... + */ + + for (k = 0; aliases[k] != NULL; k++) { + if (strcasecmp(aliases[k], fallbackName) == 0) { + goto tryfallbacks; + } + } + } + } + continue; + + /* + * ...then see if we can use one of the fallbacks, or an + * alias for one of the fallbacks. + */ + + tryfallbacks: + for (j = 0; fontFallbacks[i][j] != NULL; j++) { + fallbackName = fontFallbacks[i][j]; + subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName, + ch, &faceNames); + if (subFontPtr != NULL) { + goto end; + } + } + } + + /* + * See if we can use something from the global fallback list. + */ + + anyFallbacks = TkFontGetGlobalClass(); + for (i = 0; anyFallbacks[i] != NULL; i++) { + fallbackName = anyFallbacks[i]; + subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName, ch, + &faceNames); + if (subFontPtr != NULL) { + goto end; + } + } + + /* + * Try all face names available in the whole system until we + * find one that can be used. + */ + + for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) { + fallbackName = mapPtr->utfName; + if (SeenName(fallbackName, &faceNames) == 0) { + subFontPtr = CanUseFallback(fontPtr, fallbackName, ch); + if (subFontPtr != NULL) { + goto end; + } + } + } + + end: + Tcl_DStringFree(&faceNames); + + if (subFontPtr == NULL) { + /* + * No font can display this character. We will use the base font + * and have it display the "unknown" character. + */ + + subFontPtr = &fontPtr->subFontArray[0]; + FontMapInsert(subFontPtr, ch); + } + return subFontPtr; +} + +/* + *------------------------------------------------------------------------- + * + * FontMapLookup -- + * + * See if the screen font can display the given character. + * + * Results: + * The return value is 0 if the screen font cannot display the + * character, non-zero otherwise. + * + * Side effects: + * New pages are added to the font mapping cache whenever the + * character belongs to a page that hasn't been seen before. + * When a page is loaded, information about all the characters on + * that page is stored, not just for the single character in + * question. + * + *------------------------------------------------------------------------- + */ + +static int +FontMapLookup( + SubFont *subFontPtr, /* Contains font mapping cache to be queried + * and possibly updated. */ + int ch) /* Character to be tested. */ +{ + int row, bitOffset; + + row = ch >> FONTMAP_SHIFT; + if (subFontPtr->fontMap[row] == NULL) { + FontMapLoadPage(subFontPtr, row); + } + bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); + return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1; +} + +/* + *------------------------------------------------------------------------- + * + * FontMapInsert -- + * + * Tell the font mapping cache that the given screen font should be + * used to display the specified character. This is called when no + * font on the system can be be found that can display that + * character; we lie to the font and tell it that it can display + * the character, otherwise we would end up re-searching the entire + * fallback hierarchy every time that character was seen. + * + * Results: + * None. + * + * Side effects: + * New pages are added to the font mapping cache whenever the + * character belongs to a page that hasn't been seen before. + * When a page is loaded, information about all the characters on + * that page is stored, not just for the single character in + * question. + * + *------------------------------------------------------------------------- + */ + +static void +FontMapInsert( + SubFont *subFontPtr, /* Contains font mapping cache to be + * updated. */ + int ch) /* Character to be added to cache. */ +{ + int row, bitOffset; + + row = ch >> FONTMAP_SHIFT; + if (subFontPtr->fontMap[row] == NULL) { + FontMapLoadPage(subFontPtr, row); + } + bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); + subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); +} + +/* + *------------------------------------------------------------------------- + * + * FontMapLoadPage -- + * + * Load information about all the characters on a given page. + * This information consists of one bit per character that indicates + * whether the associated HFONT can (1) or cannot (0) display the + * characters on the page. + * + * Results: + * None. + * + * Side effects: + * Mempry allocated. + * + *------------------------------------------------------------------------- + */ +static void +FontMapLoadPage( + SubFont *subFontPtr, /* Contains font mapping cache to be + * updated. */ + int row) /* Index of the page to be loaded into + * the cache. */ +{ + FMInput fm; + FontRec *fontRecPtr; + short *widths; + int i, end, bitOffset, isMultiByteFont; + char src[TCL_UTF_MAX]; + unsigned char buf[16]; + int srcRead, dstWrote; + Tcl_Encoding encoding; + + subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8); + memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8); + + encoding = subFontPtr->familyPtr->encoding; + + fm.family = subFontPtr->familyPtr->faceNum; + fm.size = 12; + fm.face = 0; + fm.needBits = 0; + fm.device = 0; + fm.numer.h = 1; + fm.numer.v = 1; + fm.denom.h = 1; + fm.denom.v = 1; + +#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300) + fontRecPtr = *((FontRec **) FMSwapFont(&fm)->fontResult); +#else + fontRecPtr = *((FontRec **) FMSwapFont(&fm)->fontHandle); +#endif + widths = (short *) ((long) &fontRecPtr->owTLoc + + ((long) (fontRecPtr->owTLoc - fontRecPtr->firstChar) + * sizeof(short))); + isMultiByteFont = subFontPtr->familyPtr->isMultiByteFont; + + end = (row + 1) << FONTMAP_SHIFT; + for (i = row << FONTMAP_SHIFT; i < end; i++) { + if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src), + TCL_ENCODING_STOPONERROR, NULL, (char *) buf, sizeof(buf), + &srcRead, &dstWrote, NULL) == TCL_OK) { + + if (((isMultiByteFont != 0) && (buf[0] > 31)) + || (widths[buf[0]] != -1)) { + if ((buf[0] == 0x11) && (widths[0x12] == -1)) { + continue; + } + + /* + * Mac's char existence metrics are only for one-byte + * characters. If we have a double-byte char, just + * assume that the font supports that char if the font's + * encoding supports that char. + */ + + bitOffset = i & (FONTMAP_BITSPERPAGE - 1); + subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); + } + } + } +} + +/* + *--------------------------------------------------------------------------- + * + * CanUseFallbackWithAliases -- + * + * Helper function for FindSubFontForChar. Determine if the + * specified face name (or an alias of the specified face name) + * can be used to construct a screen font that can display the + * given character. + * + * Results: + * See CanUseFallback(). + * + * Side effects: + * If the name and/or one of its aliases was rejected, the + * rejected string is recorded in nameTriedPtr so that it won't + * be tried again. + * + *--------------------------------------------------------------------------- + */ + +static SubFont * +CanUseFallbackWithAliases( + MacFont *fontPtr, /* The font object that will own the new + * screen font. */ + 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 tried. It is possible for the same + * face name to be queried multiple times when + * trying to find a suitable screen font. */ +{ + SubFont *subFontPtr; + char **aliases; + int i; + + if (SeenName(faceName, nameTriedPtr) == 0) { + subFontPtr = CanUseFallback(fontPtr, faceName, ch); + if (subFontPtr != NULL) { + return subFontPtr; + } + } + aliases = TkFontGetAliasList(faceName); + if (aliases != NULL) { + for (i = 0; aliases[i] != NULL; i++) { + if (SeenName(aliases[i], nameTriedPtr) == 0) { + subFontPtr = CanUseFallback(fontPtr, aliases[i], ch); + if (subFontPtr != NULL) { + return subFontPtr; + } + } + } + } + return NULL; +} + +/* + *--------------------------------------------------------------------------- + * + * SeenName -- + * + * Used to determine we have already tried and rejected the given + * face name when looking for a screen font that can support some + * Unicode character. + * + * Results: + * The return value is 0 if this face name has not already been seen, + * non-zero otherwise. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +SeenName( + CONST char *name, /* The name to check. */ + Tcl_DString *dsPtr) /* Contains names that have already been + * seen. */ +{ + CONST char *seen, *end; + + seen = Tcl_DStringValue(dsPtr); + end = seen + Tcl_DStringLength(dsPtr); + while (seen < end) { + if (strcasecmp(seen, name) == 0) { + return 1; + } + seen += strlen(seen) + 1; + } + Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1)); + return 0; +} + +/* + *------------------------------------------------------------------------- + * + * CanUseFallback -- + * + * If the specified physical screen font has not already been loaded + * into the font object, determine if the specified physical screen + * font can display the given character. + * + * Results: + * The return value is a pointer to a newly allocated SubFont, owned + * by the font object. This SubFont can be used to display the given + * character. The SubFont represents the screen font with the base set + * of font attributes from the font object, but using the specified + * font name. NULL is returned if the font object already holds + * a reference to the specified physical font or if the specified + * physical font cannot display the given character. + * + * Side effects: + * The font object's subFontArray is updated to contain a reference + * to the newly allocated SubFont. + * + *------------------------------------------------------------------------- + */ + +static SubFont * +CanUseFallback( + MacFont *fontPtr, /* The font object that will own the 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. */ +{ + int i; + SubFont subFont; + short faceNum; + + if (GetFamilyNum(faceName, &faceNum) == 0) { + return NULL; + } + + /* + * Skip all fonts we've already used. + */ + + for (i = 0; i < fontPtr->numSubFonts; i++) { + if (faceNum == fontPtr->subFontArray[i].familyPtr->faceNum) { + return NULL; + } + } + + /* + * Load this font and see if it has the desired character. + */ + + InitSubFont(fontPtr, faceNum, &subFont); + if (((ch < 256) && (subFont.familyPtr->isSymbolFont)) + || (FontMapLookup(&subFont, ch) == 0)) { + ReleaseSubFont(&subFont); + return NULL; + } + + if (fontPtr->numSubFonts >= SUBFONT_SPACE) { + SubFont *newPtr; + + newPtr = (SubFont *) ckalloc(sizeof(SubFont) + * (fontPtr->numSubFonts + 1)); + memcpy((char *) newPtr, fontPtr->subFontArray, + fontPtr->numSubFonts * sizeof(SubFont)); + if (fontPtr->subFontArray != fontPtr->staticSubFonts) { + ckfree((char *) fontPtr->subFontArray); + } + fontPtr->subFontArray = newPtr; + } + fontPtr->subFontArray[fontPtr->numSubFonts] = subFont; + fontPtr->numSubFonts++; + return &fontPtr->subFontArray[fontPtr->numSubFonts - 1]; +} + +/* + *------------------------------------------------------------------------- + * + * GetFamilyNum -- + * + * Determines if any physical screen font exists on the system with + * the given family name. If the family exists, then it should be + * possible to construct some physical screen font with that family + * name. + * + * Results: + * The return value is 0 if the specified font family does not exist, + * non-zero otherwise. *faceNumPtr is filled with the unique face + * number that identifies the screen font, or 0 if the font family + * did not exist. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +GetFamilyNum( + CONST char *faceName, /* UTF-8 name of font family to query. */ + short *faceNumPtr) /* Filled with font number for above family. */ +{ + FontNameMap *mapPtr; + + if (faceName != NULL) { + for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) { + if (strcasecmp(faceName, mapPtr->utfName) == 0) { + *faceNumPtr = mapPtr->faceNum; + return 1; + } + } + } + *faceNumPtr = 0; + return 0; +} + +static int +GetFamilyOrAliasNum( + CONST char *faceName, /* UTF-8 name of font family to query. */ + short *faceNumPtr) /* Filled with font number for above family. */ +{ + char **aliases; + int i; + + if (GetFamilyNum(faceName, faceNumPtr) != 0) { + return 1; + } + aliases = TkFontGetAliasList(faceName); + if (aliases != NULL) { + for (i = 0; aliases[i] != NULL; i++) { + if (GetFamilyNum(aliases[i], faceNumPtr) != 0) { + return 1; + } + } + } + return 0; +} + +/* + *------------------------------------------------------------------------- + * + * GetUtfFaceName -- + * + * Given the native name for a Macintosh font (in which the name of + * the font is in the encoding of the font itself), return the UTF-8 + * name that corresponds to that font. The specified font name must + * refer to a font that actually exists on the machine. + * + * This function is used to obtain the UTF-8 name when querying the + * properties of a Macintosh font object. + * + * Results: + * The return value is a pointer to the UTF-8 of the specified font. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +static Tk_Uid +GetUtfFaceName( + StringPtr nativeName) /* Pascal name for font in native encoding. */ +{ + FontNameMap *mapPtr; + + for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) { + if (pstrcmp(nativeName, mapPtr->nativeName) == 0) { + return mapPtr->utfName; + } + } + panic("GetUtfFaceName: unexpected nativeName"); + return NULL; +} + +/* + *------------------------------------------------------------------------ + * + * GetFontEncoding -- + * + * Return a string that can be passed to Tcl_GetTextEncoding() and + * used to convert bytes from UTF-8 into the encoding of the + * specified font. + * + * The desired encoding to use to convert the name of a symbolic + * font into UTF-8 is macRoman, while the desired encoding to use + * to convert bytes in a symbolic font to UTF-8 is the corresponding + * symbolic encoding. Due to this dual interpretatation of symbolic + * fonts, the caller can specify what type of encoding to return + * should the specified font be symbolic. + * + * Results: + * The return value is a string that specifies the font's encoding. + * If the font's encoding could not be identified, NULL is returned. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +static Tcl_Encoding +GetFontEncoding( + int faceNum, /* Macintosh font number. */ + int allowSymbol, /* If non-zero, then the encoding string + * for symbol fonts will be the corresponding + * symbol encoding. Otherwise, the encoding + * string for symbol fonts will be + * "macRoman". */ + int *isSymbolPtr) /* Filled with non-zero if this font is a + * symbol font, 0 otherwise. */ +{ + Str255 faceName; + int script, lang; + char *name; + + if (allowSymbol != 0) { + GetFontName(faceNum, faceName); + if (pstrcasecmp(faceName, "\psymbol") == 0) { + *isSymbolPtr = 1; + return Tcl_GetEncoding(NULL, "symbol"); + } + if (pstrcasecmp(faceName, "\pzapf dingbats") == 0) { + *isSymbolPtr = 1; + return Tcl_GetEncoding(NULL, "macDingbats"); + } + } + + *isSymbolPtr = 0; + + script = FontToScript(faceNum); + lang = GetScriptVariable(script, smScriptLang); + name = NULL; + if (script == smRoman) { + name = TkFindStateString(romanMap, lang); + } else if (script == smCyrillic) { + name = TkFindStateString(cyrillicMap, lang); + } + if (name == NULL) { + name = TkFindStateString(scriptMap, script); + } + return Tcl_GetEncoding(NULL, name); +} diff --git a/mac/tkMacHLEvents.c b/mac/tkMacHLEvents.c index 71ce38c..f86d2fa 100644 --- a/mac/tkMacHLEvents.c +++ b/mac/tkMacHLEvents.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacHLEvents.c,v 1.2 1998/09/14 18:23:35 stanton Exp $ + * RCS: @(#) $Id: tkMacHLEvents.c,v 1.3 1999/04/16 01:51:31 stanton Exp $ */ #include "tcl.h" @@ -228,13 +228,11 @@ OdocHandler( } Tcl_DStringInit(&command); - Tcl_DStringInit(&pathName); Tcl_DStringAppend(&command, "tkOpenDocument", -1); for (index = 1; index <= count; index++) { int length; Handle fullPath; - Tcl_DStringSetLength(&pathName, 0); err = AEGetNthPtr(&fileSpecList, index, typeFSS, &keyword, &type, (Ptr) &file, sizeof(FSSpec), &actual); if ( err != noErr ) { @@ -243,17 +241,17 @@ OdocHandler( err = FSpPathFromLocation(&file, &length, &fullPath); HLock(fullPath); - Tcl_DStringAppend(&pathName, *fullPath, length); + Tcl_ExternalToUtfDString(NULL, *fullPath, length, &pathName); HUnlock(fullPath); DisposeHandle(fullPath); - Tcl_DStringAppendElement(&command, pathName.string); + Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName)); + Tcl_DStringFree(&pathName); } - Tcl_GlobalEval(interp, command.string); + Tcl_GlobalEval(interp, Tcl_DStringValue(&command)); Tcl_DStringFree(&command); - Tcl_DStringFree(&pathName); return noErr; } @@ -361,10 +359,12 @@ ScriptHandler( if (tclErr >= 0) { if (tclErr == TCL_OK) { AEPutParamPtr(reply, keyDirectObject, typeChar, - interp->result, strlen(interp->result)); + Tcl_GetStringResult(interp), + strlen(Tcl_GetStringResult(interp))); } else { AEPutParamPtr(reply, keyErrorString, typeChar, - interp->result, strlen(interp->result)); + Tcl_GetStringResult(interp), + strlen(Tcl_GetStringResult(interp))); AEPutParamPtr(reply, keyErrorNumber, typeInteger, (Ptr) &tclErr, sizeof(int)); } diff --git a/mac/tkMacInit.c b/mac/tkMacInit.c index 08c1fe6..ba90fc9 100644 --- a/mac/tkMacInit.c +++ b/mac/tkMacInit.c @@ -4,12 +4,12 @@ * This file contains Mac-specific interpreter initialization * functions. * - * Copyright (c) 1995-1996 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacInit.c,v 1.2 1998/09/14 18:23:36 stanton Exp $ + * RCS: @(#) $Id: tkMacInit.c,v 1.3 1999/04/16 01:51:31 stanton Exp $ */ #include <Resources.h> @@ -41,7 +41,7 @@ QDGlobalsPtr tcl_macQdPtr = NULL; * * Results: * A standard Tcl completion code (TCL_OK or TCL_ERROR). Also - * leaves information in interp->result. + * leaves information in the interp's result. * * Side effects: * Sets "tk_library" Tcl variable, runs initialization scripts diff --git a/mac/tkMacInt.h b/mac/tkMacInt.h index 1a8f1fc..e6478ab 100644 --- a/mac/tkMacInt.h +++ b/mac/tkMacInt.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacInt.h,v 1.6 1999/03/10 07:04:44 stanton Exp $ + * RCS: @(#) $Id: tkMacInt.h,v 1.7 1999/04/16 01:51:31 stanton Exp $ */ #ifndef _TKMACINT @@ -208,10 +208,4 @@ typedef TkMenuDefProcPtr TkMenuDefUPP; (whichItemPtr), (globalsPtr)) #endif -/* - * Internal procedures shared among Macintosh Tk modules but not exported - * to the outside world: - */ -#include "tkIntPlatDecls.h" - #endif /* _TKMACINT */ diff --git a/mac/tkMacKeyboard.c b/mac/tkMacKeyboard.c index 94f272d..122cf06 100644 --- a/mac/tkMacKeyboard.c +++ b/mac/tkMacKeyboard.c @@ -3,12 +3,12 @@ * * Routines to support keyboard events on the Macintosh. * - * Copyright (c) 1995-1996 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacKeyboard.c,v 1.2 1998/09/14 18:23:37 stanton Exp $ + * RCS: @(#) $Id: tkMacKeyboard.c,v 1.3 1999/04/16 01:51:31 stanton Exp $ */ #include "tkInt.h" @@ -137,7 +137,7 @@ XKeycodeToKeysym( int index) { register Tcl_HashEntry *hPtr; - register char c; + int c; char virtualKey; int newKeycode; unsigned long dummy, newChar; @@ -146,8 +146,11 @@ XKeycodeToKeysym( InitKeyMaps(); } - c = keycode & charCodeMask; - virtualKey = (keycode & keyCodeMask) >> 8; + virtualKey = (char) (keycode >> 16); + c = (keycode) & 0xffff; + if (c > 255) { + return NoSymbol; + } /* * When determining what keysym to produce we firt check to see if @@ -161,8 +164,6 @@ XKeycodeToKeysym( return (KeySym) Tcl_GetHashValue(hPtr); } } - - hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey); if (hPtr != NULL) { return (KeySym) Tcl_GetHashValue(hPtr); @@ -190,60 +191,63 @@ XKeycodeToKeysym( /* *---------------------------------------------------------------------- * - * XLookupString -- + * TkpGetString -- * * Retrieve the string equivalent for the given keyboard event. * * Results: - * Returns the number of characters stored in buffer_return. + * Returns the UTF string. * * Side effects: - * Retrieves the characters stored in the event and inserts them - * into buffer_return. + * None. * *---------------------------------------------------------------------- */ -int -XLookupString( - XKeyEvent* event_struct, - char* buffer_return, - int bytes_buffer, - KeySym* keysym_return, - XComposeStatus* status_in_out) +char * +TkpGetString( + TkWindow *winPtr, /* Window where event occurred: needed to + * get input context. */ + XEvent *eventPtr, /* X keyboard event. */ + Tcl_DString *dsPtr) /* Uninitialized or empty string to hold + * result. */ { register Tcl_HashEntry *hPtr; char string[3]; char virtualKey; - char c; + int c, len; if (!initialized) { InitKeyMaps(); } - - c = event_struct->keycode & charCodeMask; - string[0] = c; - string[1] = '\0'; + + Tcl_DStringInit(dsPtr); + + virtualKey = (char) (eventPtr->xkey.keycode >> 16); + c = (eventPtr->xkey.keycode) & 0xffff; + + if (c < 256) { + string[0] = (char) c; + len = 1; + } else { + string[0] = (char) (c >> 8); + string[1] = (char) c; + len = 2; + } /* * Just return NULL if the character is a function key or another * non-printing key. */ if (c == 0x10) { - string[0] = '\0'; + len = 0; } else { - virtualKey = (event_struct->keycode & keyCodeMask) >> 8; hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey); if (hPtr != NULL) { - string[0] = '\0'; + len = 0; } } - - if (buffer_return != NULL) { - strncpy(buffer_return, string, bytes_buffer); - } - - return strlen(string); + return Tcl_ExternalToUtfDString(NULL, string, len, dsPtr); } /* @@ -377,7 +381,7 @@ XKeysymToKeycode( virtualKeyCode = 0x24; keysym = '\r'; } - keycode = keysym + ((virtualKeyCode << 8) & keyCodeMask); + keycode = keysym + (virtualKeyCode <<16); } return keycode; diff --git a/mac/tkMacMenu.c b/mac/tkMacMenu.c index 30d4af8..2ad0e18 100644 --- a/mac/tkMacMenu.c +++ b/mac/tkMacMenu.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacMenu.c,v 1.7 1999/04/16 01:25:54 stanton Exp $ + * RCS: @(#) $Id: tkMacMenu.c,v 1.8 1999/04/16 01:51:31 stanton Exp $ */ #include <Menus.h> @@ -54,7 +54,7 @@ typedef struct MenuEntryUserData { * The following are constants relating to the SICNs used for drawing the MDEF. */ -#define SICN_RESOURCE_NUMBER 128 +#define SICN_RESOURCE_NUMBER 128 #define SICN_HEIGHT 16 #define SICN_ROWS 2 @@ -176,6 +176,9 @@ static char *currentMenuBarName; * DString. */ static Tk_Window currentMenuBarOwner; /* Which window owns the current menu bar. */ +static char elipsisString[TCL_UTF_MAX + 1]; + /* The UTF representation of the elipsis (ƒ) + * character. */ static int helpItemCount; /* The number of items in the help menu. * -1 means that the help menu is * unavailable. This does not include @@ -192,7 +195,8 @@ static MacDrawable macMDEFDrawable; static MDEFScrollFlag = 0; /* Used so that popups don't scroll too soon. */ static int menuBarFlags; /* Used for whether the menu bar needs * redrawing or not. */ -static TkMenuDefUPP menuDefProc;/* The routine descriptor to the MDEF proc. +static TkMenuDefUPP menuDefProc = NULL ; + /* The routine descriptor to the MDEF proc. * The MDEF is needed to draw menus with * non-standard attributes and to support * tearoff menus. */ @@ -214,6 +218,11 @@ static TopLevelMenubarList *windowListPtr; static MenuItemDrawingUPP tkThemeMenuItemDrawingUPP; /* Points to the UPP for theme Item drawing. */ +static GC appearanceGC = NULL; /* The fake appearance GC. If you + pass the foreground of this to TkMacSetColor, + it will return false, so you will know + not to set the foreground color */ + /* * Forward declarations for procedures defined later in this file: @@ -254,7 +263,9 @@ static void DrawTearoffEntry _ANSI_ARGS_((TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x, int y, int width, int height)); -static Handle FixMDEF _ANSI_ARGS_((void)); +static void FixMDEF _ANSI_ARGS_((void)); +static void GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr, + Tcl_DString *dStringPtr)); static void GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int *modWidthPtr, @@ -299,6 +310,8 @@ static void RecursivelyInsertMenu _ANSI_ARGS_(( static void SetDefaultMenubar _ANSI_ARGS_((void)); static int SetMenuCascade _ANSI_ARGS_((TkMenu *menuPtr)); static void SetMenuIndicator _ANSI_ARGS_((TkMenuEntry *mePtr)); +static void SetMenuTitle _ANSI_ARGS_((MenuHandle menuHdl, + Tcl_Obj *titlePtr)); static void AppearanceEntryDrawWrapper _ANSI_ARGS_((TkMenuEntry *mePtr, Rect * menuRectPtr, TkMenuLowMemGlobals *globalsPtr, Drawable d, Tk_FontMetrics *fmPtr, Tk_Font tkfont, @@ -330,7 +343,7 @@ pascal void tkThemeMenuItemDrawingProc _ANSI_ARGS_ ((const Rect *inBounds, int TkMacUseMenuID( - short macID) /* The id to take out of the table */ + short macID) /* The id to take out of the table */ { Tcl_HashEntry *commandEntryPtr; int newEntry; @@ -441,6 +454,7 @@ GetNewID( *menuIDPtr = returnID; return TCL_OK; } else { + Tcl_ResetResult(interp); Tcl_AppendResult(interp, "No more menus can be allocated.", (char *) NULL); return TCL_ERROR; @@ -676,7 +690,8 @@ TkpDestroyMenuEntry( * * Given a menu entry, gives back the text that should go in it. * Separators should be done by the caller, as they have to be - * handled specially. + * handled specially. This is primarily used to do a substitution + * between "..." and "ƒ". * * Results: * itemText points to the new text for the item. @@ -690,36 +705,41 @@ TkpDestroyMenuEntry( static void GetEntryText( TkMenuEntry *mePtr, /* A pointer to the menu entry. */ - Str255 itemText) /* The pascal string containing the text */ + Tcl_DString *dStringPtr) /* The DString to put the text into. This + * will be initialized by this routine. */ { + Tcl_DStringInit(dStringPtr); if (mePtr->type == TEAROFF_ENTRY) { - strcpy((char *)itemText, (const char *)"\p(Tear-off)"); - } else if (mePtr->imageString != NULL) { - strcpy((char *)itemText, (const char *)"\p(Image)"); - } else if (mePtr->bitmap != None) { - strcpy((char *)itemText, (const char *)"\p(Pixmap)"); - } else if (mePtr->label == NULL || mePtr->labelLength == 0) { + Tcl_DStringAppend(dStringPtr, "(Tear-off)", -1); + } else if (mePtr->imagePtr != NULL) { + Tcl_DStringAppend(dStringPtr, "(Image)", -1); + } else if (mePtr->bitmapPtr != NULL) { + Tcl_DStringAppend(dStringPtr, "(Pixmap)", -1); + } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) { /* * The Mac menu manager does not like null strings. */ - strcpy((char *)itemText, (const char *)"\p "); + Tcl_DStringAppend(dStringPtr, " ", -1); } else { - char *text = mePtr->label; + int length; + char *text = Tcl_GetStringFromObj(mePtr->labelPtr, &length); + char *dStringText; int i; - itemText[0] = 0; - for (i = 1; (*text != '\0') && (i <= 230); i++, text++) { + for (i = 0; i < length; text++, i++) { if ((*text == '.') && (*(text + 1) != '\0') && (*(text + 1) == '.') && (*(text + 2) != '\0') && (*(text + 2) == '.')) { - itemText[i] = 'É'; - text += 2; - } else { - itemText[i] = *text; + Tcl_DStringAppend(dStringPtr, elipsisString, -1); + i += strlen(elipsisString) - 1; + } else { + Tcl_DStringSetLength(dStringPtr, + Tcl_DStringLength(dStringPtr) + 1); + dStringText = Tcl_DStringValue(dStringPtr); + dStringText[i] = *text; } - itemText[0] += 1; } } } @@ -736,10 +756,10 @@ GetEntryText( * We try the following special mac characters. If none of them * are present, just use the check mark. * '' - Check mark character - * '¥' - Bullet character + * '´' - Bullet character * '' - Filled diamond * '×' - Hollow diamond - * 'Ñ' = Long dash ("em dash") + * '„' = Long dash ("em dash") * '-' = short dash (minus, "en dash"); * * Results: @@ -757,19 +777,22 @@ FindMarkCharacter( * for. */ { char markChar; - Tk_Font tkfont = (mePtr->tkfont == NULL) ? mePtr->menuPtr->tkfont - : mePtr->tkfont; + Tk_Font tkfont; + + tkfont = Tk_GetFontFromObj(mePtr->menuPtr->tkwin, + (mePtr->fontPtr == NULL) ? mePtr->menuPtr->fontPtr + : mePtr->fontPtr); if (!TkMacIsCharacterMissing(tkfont, '')) { markChar = ''; - } else if (!TkMacIsCharacterMissing(tkfont, '¥')) { - markChar = '¥'; + } else if (!TkMacIsCharacterMissing(tkfont, '´')) { + markChar = '´'; } else if (!TkMacIsCharacterMissing(tkfont, '')) { markChar = ''; } else if (!TkMacIsCharacterMissing(tkfont, '×')) { markChar = '×'; - } else if (!TkMacIsCharacterMissing(tkfont, 'Ñ')) { - markChar = 'Ñ'; + } else if (!TkMacIsCharacterMissing(tkfont, '„')) { + markChar = '„'; } else if (!TkMacIsCharacterMissing(tkfont, '-')) { markChar = '-'; } else { @@ -816,14 +839,13 @@ SetMenuIndicator( if (mePtr->type == CASCADE_ENTRY) { return; } - - if (((mePtr->type == RADIO_BUTTON_ENTRY) - || (mePtr->type == CHECK_BUTTON_ENTRY)) - && (mePtr->indicatorOn) - && (mePtr->entryFlags & ENTRY_SELECTED)) { - markChar = FindMarkCharacter(mePtr); - } else { - markChar = 0; + + markChar = 0; + if ((mePtr->type == RADIO_BUTTON_ENTRY) + || (mePtr->type == CHECK_BUTTON_ENTRY)) { + if (mePtr->indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) { + markChar = FindMarkCharacter(mePtr); + } } SetItemMark(macMenuHdl, mePtr->index + 1, markChar); } @@ -850,10 +872,12 @@ SetMenuIndicator( static void SetMenuTitle( MenuHandle menuHdl, /* The menu we are setting the title of. */ - char *title) /* The C string to set the title to. */ + Tcl_Obj *titlePtr) /* The C string to set the title to. */ { int oldLength, newLength, oldHandleSize, dataLength; Ptr menuDataPtr; + char *title = (titlePtr == NULL) ? "" + : Tcl_GetStringFromObj(titlePtr, NULL); menuDataPtr = (Ptr) (*menuHdl)->menuData; @@ -890,7 +914,7 @@ SetMenuTitle( * * Results: * Returns standard TCL result. If TCL_ERROR is returned, then - * interp->result contains an error message. + * the interp's result contains an error message. * * Side effects: * Configuration information get set for mePtr; old resources @@ -930,7 +954,7 @@ TkpConfigureMenuEntry( } if (menuPtr->menuType == MENUBAR) { - SetMenuTitle(childMenuHdl, mePtr->label); + SetMenuTitle(childMenuHdl, mePtr->labelPtr); } } } @@ -946,7 +970,9 @@ TkpConfigureMenuEntry( if (0 == mePtr->accelLength) { ((EntryGeometry *)mePtr->platformEntryData)->accelTextStart = -1; } else { - char *accelString = mePtr->accel; + char *accelString = (mePtr->accelPtr == NULL) ? "" + : Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + char *accel = accelString; mePtr->entryFlags |= ~ENTRY_ACCEL_MASK; while (1) { @@ -992,7 +1018,7 @@ TkpConfigureMenuEntry( } ((EntryGeometry *)mePtr->platformEntryData)->accelTextStart - = ((long) accelString - (long) mePtr->accel); + = ((long) accelString - (long) accel); } if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { @@ -1039,11 +1065,15 @@ ReconfigureIndividualMenu( TkMenuEntry *mePtr; Str255 itemText; int parentDisabled = 0; + int state; for (mePtr = menuPtr->menuRefPtr->parentEntryPtr; mePtr != NULL; mePtr = mePtr->nextCascadePtr) { - if (strcmp(Tk_PathName(menuPtr->tkwin), mePtr->name) == 0) { - if (mePtr->state == tkDisabledUid) { + char *name = (mePtr->namePtr == NULL) ? "" + : Tcl_GetStringFromObj(mePtr->namePtr, NULL); + + if (strcmp(Tk_PathName(menuPtr->tkwin), name) == 0) { + if (mePtr->state == ENTRY_DISABLED) { parentDisabled = 1; } break; @@ -1072,15 +1102,25 @@ ReconfigureIndividualMenu( if (mePtr->type == SEPARATOR_ENTRY) { AppendMenu(macMenuHdl, SEPARATOR_TEXT); } else { - GetEntryText(mePtr, itemText); + Tcl_DString itemTextDString; + int destWrote; + + GetEntryText(mePtr, &itemTextDString); + Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&itemTextDString), + Tcl_DStringLength(&itemTextDString), 0, NULL, + (char *) &itemText[1], + 231, NULL, &destWrote, NULL); + itemText[0] = destWrote; + AppendMenu(macMenuHdl, "\px"); SetMenuItemText(macMenuHdl, base + index, itemText); + Tcl_DStringFree(&itemTextDString); /* * Set enabling and disabling correctly. */ - if (parentDisabled || (mePtr->state == tkDisabledUid)) { + if (parentDisabled || (mePtr->state == ENTRY_DISABLED)) { DisableItem(macMenuHdl, base + index); } else { EnableItem(macMenuHdl, base + index); @@ -1094,8 +1134,8 @@ ReconfigureIndividualMenu( if ((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY)) { CheckItem(macMenuHdl, base + index, (mePtr->entryFlags - & ENTRY_SELECTED) && (mePtr->indicatorOn)); - if ((mePtr->indicatorOn) + & ENTRY_SELECTED) && mePtr->indicatorOn); + if (mePtr->indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) { SetItemMark(macMenuHdl, base + index, FindMarkCharacter(mePtr)); @@ -1142,9 +1182,9 @@ ReconfigureIndividualMenu( if ((mePtr->type != CASCADE_ENTRY) && (ENTRY_COMMAND_ACCEL == (mePtr->entryFlags & ENTRY_ACCEL_MASK))) { - SetItemCmd(macMenuHdl, index, mePtr - ->accel[((EntryGeometry *)mePtr->platformEntryData) - ->accelTextStart]); + char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + SetItemCmd(macMenuHdl, index, accel[((EntryGeometry *) + mePtr->platformEntryData)->accelTextStart]); } } } @@ -1586,9 +1626,9 @@ DrawMenuBarWhenIdle( if (menuBarPtr == NULL) { SetDefaultMenubar(); - } else { - if (menuBarPtr->tearOff != menuPtr->tearOff) { - if (menuBarPtr->tearOff) { + } else { + if (menuBarPtr->tearoff != menuPtr->tearoff) { + if (menuBarPtr->tearoff) { appleIndex = (-1 == appleIndex) ? appleIndex : appleIndex + 1; helpIndex = (-1 == helpIndex) ? helpIndex @@ -1636,7 +1676,7 @@ DrawMenuBarWhenIdle( for (i = 0; i < menuBarPtr->numEntries; i++) { if (i == appleIndex) { - if (menuBarPtr->entries[i]->state == tkDisabledUid) { + if (menuBarPtr->entries[i]->state == ENTRY_DISABLED) { DisableItem(((MacMenu *) menuBarPtr->entries[i] ->childMenuRefPtr->menuPtr ->platformData)->menuHdl, @@ -1679,7 +1719,7 @@ DrawMenuBarWhenIdle( DeleteMenu((*macMenuHdl)->menuID); InsertMenu(macMenuHdl, 0); RecursivelyInsertMenu(cascadeMenuPtr); - if (menuBarPtr->entries[i]->state == tkDisabledUid) { + if (menuBarPtr->entries[i]->state == ENTRY_DISABLED) { DisableItem(((MacMenu *) menuBarPtr->entries[i] ->childMenuRefPtr->menuPtr ->platformData)->menuHdl, @@ -1734,7 +1774,8 @@ RecursivelyInsertMenu( && (menuPtr->entries[i]->childMenuRefPtr->menuPtr != NULL)) { cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr; - macMenuHdl = ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl; + macMenuHdl = + ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl; InsertMenu(macMenuHdl, -1); RecursivelyInsertMenu(cascadeMenuPtr); } @@ -1775,7 +1816,8 @@ RecursivelyDeleteMenu( && (menuPtr->entries[i]->childMenuRefPtr->menuPtr != NULL)) { cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr; - macMenuHdl = ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl; + macMenuHdl = + ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl; DeleteMenu((*macMenuHdl)->menuID); RecursivelyInsertMenu(cascadeMenuPtr); } @@ -1885,7 +1927,8 @@ TkpSetMainMenubar( } } if (listPtr != NULL) { - menuName = Tk_PathName(listPtr->menuPtr->masterMenuPtr->tkwin); + menuName = Tk_PathName(listPtr->menuPtr->masterMenuPtr + ->tkwin); break; } } @@ -2087,15 +2130,15 @@ GetMenuAccelGeometry ( } else if (0 == mePtr->accelLength) { *textWidthPtr = 0; } else { + char *accel = (mePtr->accelPtr == NULL) ? "" + : Tcl_GetStringFromObj(mePtr->accelPtr, NULL); if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) { - *textWidthPtr = Tk_TextWidth(tkfont, mePtr->accel, - mePtr->accelLength); + *textWidthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength); } else { int emWidth = Tk_TextWidth(tkfont, "W", 1) + 1; if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) { - int width = Tk_TextWidth(tkfont, mePtr->accel, - mePtr->accelLength); + int width = Tk_TextWidth(tkfont, accel, mePtr->accelLength); *textWidthPtr = emWidth; if (width < emWidth) { *modWidthPtr = 0; @@ -2120,7 +2163,7 @@ GetMenuAccelGeometry ( if (1 == (mePtr->accelLength - length)) { *textWidthPtr = emWidth; } else { - *textWidthPtr += Tk_TextWidth(tkfont, mePtr->accel + *textWidthPtr += Tk_TextWidth(tkfont, accel + length, mePtr->accelLength - length); } } @@ -2230,21 +2273,27 @@ DrawMenuEntryIndicator( int width, /* width of entry */ int height) /* height of entry */ { - if (((mePtr->type == CHECK_BUTTON_ENTRY) || - (mePtr->type == RADIO_BUTTON_ENTRY)) - && (mePtr->indicatorOn) - && (mePtr->entryFlags & ENTRY_SELECTED)) { - int baseline; - short markShort; - char markChar; + if ((mePtr->type == CHECK_BUTTON_ENTRY) || + (mePtr->type == RADIO_BUTTON_ENTRY)) { + if (mePtr->indicatorOn + && (mePtr->entryFlags & ENTRY_SELECTED)) { + int baseline; + short markShort; - baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; - GetItemMark(((MacMenu *) menuPtr->platformData)->menuHdl, - mePtr->index + 1, &markShort); - if (markShort != 0) { - markChar = (char) markShort; - Tk_DrawChars(menuPtr->display, d, gc, tkfont, &markChar, 1, - x + 2, baseline); + baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; + GetItemMark(((MacMenu *) menuPtr->platformData)->menuHdl, + mePtr->index + 1, &markShort); + if (markShort != 0) { + char markChar; + char markCharUTF[TCL_UTF_MAX + 1]; + int dstWrote; + + markChar = (char) markShort; + Tcl_ExternalToUtf(NULL, NULL, &markChar, 1, 0, NULL, + markCharUTF, TCL_UTF_MAX + 1, NULL, &dstWrote, NULL); + Tk_DrawChars(menuPtr->display, d, gc, tkfont, markCharUTF, + dstWrote, x + 2, baseline); + } } } } @@ -2338,11 +2387,11 @@ DrawSICN( GetForeColor(&origForeColor); GetBackColor(&origBackColor); - if (TkSetMacColor(gc->foreground, &foreColor)) { + if (TkSetMacColor(gc->foreground, &foreColor) == true) { RGBForeColor(&foreColor); } - if (TkSetMacColor(gc->background, &backColor)) { + if (TkSetMacColor(gc->background, &backColor) == true) { RGBBackColor(&backColor); } @@ -2396,6 +2445,10 @@ DrawMenuEntryAccelerator( int height, /* The height of the entry */ int drawArrow) /* Whether or not to draw cascade arrow */ { + int activeBorderWidth; + + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, + &activeBorderWidth); if (mePtr->type == CASCADE_ENTRY) { /* * Under Appearance, we let the Appearance Manager draw the icon @@ -2409,7 +2462,7 @@ DrawMenuEntryAccelerator( Tk_Window tkwin = menuPtr->tkwin; if (mePtr->type == CASCADE_ENTRY) { - points[0].x = width - menuPtr->activeBorderWidth + points[0].x = width - activeBorderWidth - MAC_MARGIN_WIDTH - CASCADE_ARROW_WIDTH; points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2; points[1].x = points[0].x; @@ -2424,11 +2477,14 @@ DrawMenuEntryAccelerator( } else if (mePtr->accelLength != 0) { int leftEdge = x + width; int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; + char *accel; + + accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) { leftEdge -= ((EntryGeometry *) mePtr->platformEntryData) ->accelTextWidth; - Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel, + Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, mePtr->accelLength, leftEdge, baseline); } else { EntryGeometry *geometryPtr = @@ -2440,7 +2496,7 @@ DrawMenuEntryAccelerator( leftEdge -= geometryPtr->modifierWidth; } - Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel + Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel + geometryPtr->accelTextStart, length, leftEdge, baseline); if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) { @@ -2524,10 +2580,8 @@ DrawMenuSeparator( TkMacSetUpGraphicsPort(mePtr->disabledGC != None ? mePtr->disabledGC : menuPtr->disabledGC); - MoveTo(x, y + (height / 2)); Line(width, 0); - SetGWorld(saveWorld, saveDevice); } } @@ -2569,7 +2623,7 @@ MenuDefProc( TkMenuEntry *parentEntryPtr; Tcl_HashEntry *commandEntryPtr; GrafPtr windowMgrPort; - Tk_Font tkfont; + Tk_Font tkfont, menuFont; Tk_FontMetrics fontMetrics, entryMetrics; Tk_FontMetrics *fmPtr; TkMenuEntry *mePtr; @@ -2703,7 +2757,8 @@ MenuDefProc( * that are lower than the bottom. */ - Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics); + menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(menuFont, &fontMetrics); for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; if (globalsPtr->menuTop + mePtr->y + mePtr->height @@ -2714,11 +2769,11 @@ MenuDefProc( continue; } /* ClipRect(&menuClipRect); */ - if (mePtr->tkfont == NULL) { + if (mePtr->fontPtr == NULL) { fmPtr = &fontMetrics; - tkfont = menuPtr->tkfont; + tkfont = menuFont; } else { - tkfont = mePtr->tkfont; + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } @@ -2753,16 +2808,16 @@ MenuDefProc( GetBackColor(&origBackColor); if (TkSetMacColor(menuPtr->textGC->foreground, - &foreColor)) { - /* if (!TkMacHaveAppearance()) { */ + &foreColor) == true) { + if (!TkMacHaveAppearance()) { RGBForeColor(&foreColor); - /* } */ + } } if (TkSetMacColor(menuPtr->textGC->background, - &backColor)) { - /* if (!TkMacHaveAppearance()) { */ + &backColor) == true) { + if (!TkMacHaveAppearance()) { RGBBackColor(&backColor); - /* } */ + } } /* @@ -2787,7 +2842,7 @@ MenuDefProc( + menuPtr->entries[i]->height; if (PtInRect(hitPt, &itemRect)) { if ((mePtr->type == SEPARATOR_ENTRY) - || (mePtr->state == tkDisabledUid)) { + || (mePtr->state == ENTRY_DISABLED)) { newItem = -1; } else { TkMenuEntry *cascadeEntryPtr; @@ -2798,10 +2853,13 @@ MenuDefProc( cascadeEntryPtr != NULL; cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { - if (strcmp(cascadeEntryPtr->name, - Tk_PathName(menuPtr->tkwin)) == 0) { - if (cascadeEntryPtr->state - == tkDisabledUid) { + char *name; + + name = Tcl_GetStringFromObj( + cascadeEntryPtr->namePtr, NULL); + if (strcmp(name, Tk_PathName(menuPtr->tkwin)) + == 0) { + if (cascadeEntryPtr->state == ENTRY_DISABLED) { parentDisabled = 1; } break; @@ -2855,7 +2913,13 @@ MenuDefProc( if (oldItem != newItem) { if (oldItem >= 0) { mePtr = menuPtr->entries[oldItem]; - tkfont = mePtr->tkfont ? mePtr->tkfont : menuPtr->tkfont; + if (mePtr->fontPtr == NULL) { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, + menuPtr->fontPtr); + } else { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, + mePtr->fontPtr); + } Tk_GetFontMetrics(tkfont, &fontMetrics); AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr, (Drawable) &macMDEFDrawable, &fontMetrics, tkfont, @@ -2869,10 +2933,16 @@ MenuDefProc( int oldActiveItem = menuPtr->active; mePtr = menuPtr->entries[newItem]; - if (mePtr->state != tkDisabledUid) { + if (mePtr->state != ENTRY_DISABLED) { TkActivateMenuEntry(menuPtr, newItem); } - tkfont = mePtr->tkfont ? mePtr->tkfont : menuPtr->tkfont; + if (mePtr->fontPtr == NULL) { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, + menuPtr->fontPtr); + } else { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, + mePtr->fontPtr); + } Tk_GetFontMetrics(tkfont, &fontMetrics); AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr, (Drawable) &macMDEFDrawable, &fontMetrics, tkfont, @@ -2887,7 +2957,7 @@ MenuDefProc( MenuSelectEvent(menuPtr); Tcl_ServiceAll(); tkUseMenuCascadeRgn = 0; - if (mePtr->state != tkDisabledUid) { + if (mePtr->state != ENTRY_DISABLED) { TkActivateMenuEntry(menuPtr, -1); } *whichItem = newItem + 1; @@ -2900,7 +2970,8 @@ MenuDefProc( - globalsPtr->menuBottom) { scrollAmt = menuRectPtr->bottom - globalsPtr->menuBottom; } - if (!hasTopScroll && ((globalsPtr->menuTop + scrollAmt) < menuRectPtr->top)) { + if (!hasTopScroll && ((globalsPtr->menuTop + scrollAmt) + < menuRectPtr->top)) { SetRect(&updateRect, menuRectPtr->left, globalsPtr->menuTop, menuRectPtr->right, globalsPtr->menuTop + SICN_HEIGHT); @@ -2932,6 +3003,7 @@ MenuDefProc( } } if (scrollDirection != DONT_SCROLL) { + Tk_Font menuFont; RgnHandle updateRgn = NewRgn(); ScrollRect(&menuClipRect, 0, scrollAmt, updateRgn); updateRect = (*updateRgn)->rgnBBox; @@ -2946,7 +3018,8 @@ MenuDefProc( } ClipRect(&updateRect); EraseRect(&updateRect); - Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics); + menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(menuFont, &fontMetrics); for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; if (globalsPtr->menuTop + mePtr->y + mePtr->height @@ -2956,11 +3029,12 @@ MenuDefProc( > updateRect.bottom) { continue; } - if (mePtr->tkfont == NULL) { + if (mePtr->fontPtr == NULL) { fmPtr = &fontMetrics; - tkfont = menuPtr->tkfont; + tkfont = menuFont; } else { - tkfont = mePtr->tkfont; + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, + mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } @@ -2990,18 +3064,23 @@ MenuDefProc( menuRefPtr = TkFindMenuReferences(menuPtr->interp, Tk_PathName(menuPtr->tkwin)); if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) { + char *name; for (parentEntryPtr = menuRefPtr->parentEntryPtr; - strcmp(parentEntryPtr->name, - Tk_PathName(menuPtr->tkwin)) == 0; - parentEntryPtr = parentEntryPtr->nextCascadePtr) { + parentEntryPtr != NULL + ; parentEntryPtr = parentEntryPtr->nextCascadePtr) { + name = Tcl_GetStringFromObj(parentEntryPtr->namePtr, + NULL); + if (strcmp(name, Tk_PathName(menuPtr->tkwin)) != 0) { + break; + } } if (parentEntryPtr != NULL) { TkActivateMenuEntry(parentEntryPtr->menuPtr, - parentEntryPtr->index); + parentEntryPtr->index); } } - if (menuPtr->tearOff) { + if (menuPtr->tearoff) { scratchRect = *menuRectPtr; if (tearoffStruct.menuPtr == NULL) { scratchRect.top -= 10; @@ -3152,9 +3231,9 @@ AppearanceEntryDrawWrapper( itemRect.bottom = itemRect.top + height; itemRect.right = itemRect.left + width; - if (mePtr->state == tkActiveUid) { + if (mePtr->state == ENTRY_ACTIVE) { theState = kThemeMenuSelected; - } else if (mePtr->state == tkDisabledUid) { + } else if (mePtr->state == ENTRY_DISABLED) { theState = kThemeMenuDisabled; } else { theState = kThemeMenuActive; @@ -3230,7 +3309,7 @@ TkMacHandleTearoffMenu(void) { if (tearoffStruct.menuPtr != NULL) { Tcl_DString tearoffCmdStr; - char intString[20]; + char intString[TCL_INTEGER_SPACE]; short windowPart; WindowRef whichWindow; @@ -3340,6 +3419,7 @@ DrawTearoffEntry( { XPoint points[2]; int margin, segmentWidth, maxX; + Tk_3DBorder border; if ((menuPtr->menuType != MASTER_MENU) || (FixMDEF() != NULL)) { return; @@ -3351,13 +3431,14 @@ DrawTearoffEntry( points[1].y = points[0].y; segmentWidth = 6; maxX = width - 1; + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); while (points[0].x < maxX) { points[1].x = points[0].x + segmentWidth; if (points[1].x > maxX) { points[1].x = maxX; } - Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1, + Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, TK_RELIEF_RAISED); points[0].x += 2*segmentWidth; } @@ -3476,6 +3557,7 @@ TkpDrawMenuEntry( int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0; int adjustedY = y + padY; int adjustedHeight = height - 2 * padY; + int state; /* * Choose the gc for drawing the foreground part of the entry. @@ -3483,11 +3565,15 @@ TkpDrawMenuEntry( * ourselves not to change whatever color the appearance manager has set. */ - if ((mePtr->state == tkActiveUid) - && !strictMotif) { + if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) { gc = mePtr->activeGC; if (gc == NULL) { + if ((TkMacHaveAppearance() > 1) && (menuPtr->menuType != TEAROFF_MENU)) { + SetThemeTextColor(kThemeSelectedMenuItemTextColor,32,true); + gc = appearanceGC; + } else { gc = menuPtr->activeGC; + } } } else { TkMenuEntry *cascadeEntryPtr; @@ -3496,25 +3582,37 @@ TkpDrawMenuEntry( for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr; cascadeEntryPtr != NULL; cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { - if (strcmp(cascadeEntryPtr->name, - Tk_PathName(menuPtr->tkwin)) == 0) { - if (cascadeEntryPtr->state == tkDisabledUid) { + char *name = (cascadeEntryPtr->namePtr == NULL) ? "" + : Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL); + + if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) { + if (cascadeEntryPtr->state == ENTRY_DISABLED) { parentDisabled = 1; } break; } } - if (((parentDisabled || (mePtr->state == tkDisabledUid))) - && (menuPtr->disabledFg != NULL)) { + if (((parentDisabled || (state == ENTRY_DISABLED))) + && (menuPtr->disabledFgPtr != NULL)) { gc = mePtr->disabledGC; if (gc == NULL) { + if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) { + SetThemeTextColor(kThemeDisabledMenuItemTextColor,32,true); + gc = appearanceGC; + } else { gc = menuPtr->disabledGC; } + } } else { gc = mePtr->textGC; if (gc == NULL) { + if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) { + SetThemeTextColor(kThemeActiveMenuItemTextColor,32,true); + gc = appearanceGC; + } else { gc = menuPtr->textGC; + } } } } @@ -3523,24 +3621,22 @@ TkpDrawMenuEntry( if (indicatorGC == NULL) { indicatorGC = menuPtr->indicatorGC; } - - bgBorder = mePtr->border; - if (bgBorder == NULL) { - bgBorder = menuPtr->border; - } + + bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->borderPtr == NULL) + ? menuPtr->borderPtr : mePtr->borderPtr); if (strictMotif) { activeBorder = bgBorder; } else { - activeBorder = mePtr->activeBorder; - if (activeBorder == NULL) { - activeBorder = menuPtr->activeBorder; - } + activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->activeBorderPtr == NULL) + ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr); } - if (mePtr->tkfont == NULL) { + if (mePtr->fontPtr == NULL) { fmPtr = menuMetricsPtr; } else { - tkfont = mePtr->tkfont; + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } @@ -3596,13 +3692,13 @@ void TkpComputeStandardMenuGeometry( TkMenu *menuPtr) /* Structure describing menu. */ { - Tk_Font tkfont; + Tk_Font tkfont, menuFont; Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr; int x, y, height, modifierWidth, labelWidth, indicatorSpace; int windowWidth, windowHeight, accelWidth, maxAccelTextWidth; int i, j, lastColumnBreak, maxModifierWidth, maxWidth, nonAccelMargin; int maxNonAccelMargin, maxEntryWithAccelWidth, maxEntryWithoutAccelWidth; - int entryWidth, maxIndicatorSpace; + int entryWidth, maxIndicatorSpace, borderWidth, activeBorderWidth; TkMenuEntry *mePtr, *columnEntryPtr; EntryGeometry *geometryPtr; @@ -3610,7 +3706,11 @@ TkpComputeStandardMenuGeometry( return; } - x = y = menuPtr->borderWidth; + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, + &activeBorderWidth); + x = y = borderWidth; indicatorSpace = labelWidth = accelWidth = maxAccelTextWidth = 0; windowHeight = windowWidth = maxWidth = lastColumnBreak = 0; maxModifierWidth = nonAccelMargin = maxNonAccelMargin = 0; @@ -3628,15 +3728,16 @@ TkpComputeStandardMenuGeometry( * give all of the geometry/drawing the entry's font and metrics. */ - Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics); + menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(menuFont, &menuMetrics); for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; - tkfont = mePtr->tkfont; - if (tkfont == NULL) { - tkfont = menuPtr->tkfont; - fmPtr = &menuMetrics; + if (mePtr->fontPtr == NULL) { + tkfont = menuFont; + fmPtr = &menuMetrics; } else { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } @@ -3652,7 +3753,7 @@ TkpComputeStandardMenuGeometry( columnEntryPtr->indicatorSpace = maxIndicatorSpace; columnEntryPtr->width = maxIndicatorSpace + maxWidth - + 2 * menuPtr->activeBorderWidth; + + 2 * activeBorderWidth; geometryPtr->accelTextWidth = maxAccelTextWidth; geometryPtr->modifierWidth = maxModifierWidth; columnEntryPtr->x = x; @@ -3667,13 +3768,13 @@ TkpComputeStandardMenuGeometry( geometryPtr->nonAccelMargin = 0; } } - x += maxIndicatorSpace + maxWidth + 2 * menuPtr->borderWidth; + x += maxIndicatorSpace + maxWidth + 2 * borderWidth; windowWidth = x; maxWidth = maxIndicatorSpace = maxAccelTextWidth = 0; maxModifierWidth = maxNonAccelMargin = maxEntryWithAccelWidth = 0; maxEntryWithoutAccelWidth = 0; lastColumnBreak = i; - y = menuPtr->borderWidth; + y = borderWidth; } if (mePtr->type == SEPARATOR_ENTRY) { @@ -3685,7 +3786,6 @@ TkpComputeStandardMenuGeometry( fmPtr, &entryWidth, &height); mePtr->height = height; } else { - /* * For each entry, compute the height required by that * particular entry, plus three widths: the width of the @@ -3705,8 +3805,8 @@ TkpComputeStandardMenuGeometry( &modifierWidth, &accelWidth, &height); nonAccelMargin = 0; } else if (mePtr->accelLength == 0) { - nonAccelMargin = mePtr->hideMargin ? 0 - : Tk_TextWidth(tkfont, "m", 1); + nonAccelMargin = mePtr->hideMargin ? 0 + : Tk_TextWidth(tkfont, "m", 1); accelWidth = modifierWidth = 0; } else { labelWidth += Tk_TextWidth(tkfont, "m", 1); @@ -3758,10 +3858,10 @@ TkpComputeStandardMenuGeometry( } } - mePtr->height += 2 * menuPtr->activeBorderWidth; + mePtr->height += 2 * activeBorderWidth; } mePtr->y = y; - y += menuPtr->entries[i]->height + menuPtr->borderWidth; + y += menuPtr->entries[i]->height + borderWidth; if (y > windowHeight) { windowHeight = y; } @@ -3773,7 +3873,7 @@ TkpComputeStandardMenuGeometry( columnEntryPtr->indicatorSpace = maxIndicatorSpace; columnEntryPtr->width = maxIndicatorSpace + maxWidth - + 2 * menuPtr->activeBorderWidth; + + 2 * activeBorderWidth; geometryPtr->accelTextWidth = maxAccelTextWidth; geometryPtr->modifierWidth = maxModifierWidth; columnEntryPtr->x = x; @@ -3789,8 +3889,8 @@ TkpComputeStandardMenuGeometry( } } windowWidth = x + maxIndicatorSpace + maxWidth - + 2 * menuPtr->activeBorderWidth + menuPtr->borderWidth; - windowHeight += menuPtr->borderWidth; + + 2 * activeBorderWidth + borderWidth; + windowHeight += borderWidth; /* * The X server doesn't like zero dimensions, so round up to at least @@ -3841,6 +3941,7 @@ DrawMenuEntryLabel( int indicatorSpace = mePtr->indicatorSpace; int leftEdge = x + indicatorSpace; int imageHeight, imageWidth; + int state; /* * Draw label or bitmap or image for entry. @@ -3859,30 +3960,29 @@ DrawMenuEntryLabel( imageHeight, d, leftEdge, (int) (y + (mePtr->height - imageHeight)/2)); } - } else if (mePtr->bitmap != None) { + } else if (mePtr->bitmapPtr != NULL) { int width, height; - + Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); Tk_SizeOfBitmap(menuPtr->display, - mePtr->bitmap, &width, &height); - XCopyPlane(menuPtr->display, - mePtr->bitmap, d, - gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge, + bitmap, &width, &height); + XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0, + (unsigned) width, (unsigned) height, leftEdge, (int) (y + (mePtr->height - height)/2), 1); } else { if (mePtr->labelLength > 0) { - Str255 itemText; + Tcl_DString itemTextDString; - GetEntryText(mePtr, itemText); + GetEntryText(mePtr, &itemTextDString); Tk_DrawChars(menuPtr->display, d, gc, - tkfont, (char *) itemText + 1, itemText[0], + tkfont, Tcl_DStringValue(&itemTextDString), + Tcl_DStringLength(&itemTextDString), leftEdge, baseline); -/* TkpDrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, - width, height);*/ + Tcl_DStringFree(&itemTextDString); } } - if (mePtr->state == tkDisabledUid) { - if (menuPtr->disabledFg == NULL) { + if (mePtr->state == ENTRY_DISABLED) { + if (menuPtr->disabledFgPtr == NULL) { if (!TkMacHaveAppearance()) { XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y, (unsigned) width, (unsigned) height); @@ -3930,9 +4030,10 @@ DrawMenuEntryBackground( { if (!TkMacHaveAppearance() || (menuPtr->menuType == TEAROFF_MENU) - || ((mePtr->state == tkActiveUid) && (mePtr->activeBorder != NULL)) - || ((mePtr->state != tkActiveUid) && (mePtr->border != NULL))) { - if (mePtr->state == tkActiveUid) { + || ((mePtr->state == ENTRY_ACTIVE) + && (mePtr->activeBorder != NULL)) + || ((mePtr->state != ENTRY_ACTIVE) && (mePtr->border != NULL))) { + if (mePtr->state == ENTRY_ACTIVE) { bgBorder = activeBorder; } Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, @@ -3971,17 +4072,20 @@ GetMenuLabelGeometry( if (mePtr->image != NULL) { Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr); - } else if (mePtr->bitmap != (Pixmap) NULL) { - Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr); + } else if (mePtr->bitmapPtr != NULL) { + Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr); } else { *heightPtr = fmPtr->linespace; - if (mePtr->label != NULL) { - Str255 itemText; + if (mePtr->labelPtr != NULL) { + Tcl_DString itemTextDString; - GetEntryText(mePtr, itemText); - *widthPtr = Tk_TextWidth(tkfont, (char *) itemText + 1, - itemText[0]); + GetEntryText(mePtr, &itemTextDString); + *widthPtr = Tk_TextWidth(tkfont, + Tcl_DStringValue(&itemTextDString), + Tcl_DStringLength(&itemTextDString)); + Tcl_DStringFree(&itemTextDString); } else { *widthPtr = 0; } @@ -4242,7 +4346,7 @@ FixMDEF(void) * None. * * Side effects: - * Allcates a hash table. + * Allocates a hash table. * *---------------------------------------------------------------------- */ @@ -4272,10 +4376,39 @@ TkpMenuInit(void) tmpColorPtr = TkpGetColor(NULL, "systemAppearanceColor"); tmpValues.foreground = tmpColorPtr->color.pixel; tmpValues.background = tmpColorPtr->color.pixel; + appearanceGC = XCreateGC(NULL, NULL, GCForeground | GCBackground, &tmpValues); ckfree((char *) tmpColorPtr); tkThemeMenuItemDrawingUPP = NewMenuItemDrawingProc(tkThemeMenuItemDrawingProc); } FixMDEF(); + + Tcl_ExternalToUtf(NULL, NULL, "É", -1, 0, NULL, elipsisString, + TCL_UTF_MAX + 1, NULL, NULL, NULL); +} + +/* + *---------------------------------------------------------------------- + * + * TkpMenuThreadInit -- + * + * Does platform-specific initialization of thread-specific + * menu state. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TkpMenuThreadInit() +{ + /* + * Nothing to do. + */ } diff --git a/mac/tkMacMenubutton.c b/mac/tkMacMenubutton.c index 6f7c8cb..7c169fe 100644 --- a/mac/tkMacMenubutton.c +++ b/mac/tkMacMenubutton.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacMenubutton.c,v 1.2 1998/09/14 18:23:38 stanton Exp $ + * RCS: @(#) $Id: tkMacMenubutton.c,v 1.3 1999/04/16 01:51:31 stanton Exp $ */ #include "tkMenubutton.h" @@ -110,9 +110,10 @@ TkpDisplayMenuButton( SetGWorld(destPort, NULL); macDraw = (MacDrawable *) Tk_WindowId(tkwin); - if ((mbPtr->state == tkDisabledUid) && (mbPtr->disabledFg != NULL)) { + if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) { gc = mbPtr->disabledGC; - } else if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) { + } else if ((mbPtr->state == STATE_ACTIVE) + && !Tk_StrictMotif(mbPtr->tkwin)) { gc = mbPtr->activeTextGC; } else { gc = mbPtr->normalTextGC; @@ -162,10 +163,10 @@ TkpDisplayMenuButton( * foreground color, generate the stippled effect. */ - if ((mbPtr->state == tkDisabledUid) - && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) { - XFillRectangle(mbPtr->display, Tk_WindowId(tkwin), mbPtr->disabledGC, - mbPtr->inset, mbPtr->inset, + if (mbPtr->state == STATE_DISABLED && mbPtr->disabledFg != NULL) { + || (mbPtr->image != NULL))) { + XFillRectangle(mbPtr->display, Tk_WindowId(tkwin), + mbPtr->disabledGC, mbPtr->inset, mbPtr->inset, (unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset), (unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset)); } @@ -221,9 +222,6 @@ TkpDisplayMenuButton( LineTo(r.left + kShadowOffset, r.bottom); } - if (mbPtr->state == tkDisabledUid) { - } - if (mbPtr->highlightWidth != 0) { GC gc; diff --git a/mac/tkMacMenus.c b/mac/tkMacMenus.c index 7e95391..b624e63f5 100644 --- a/mac/tkMacMenus.c +++ b/mac/tkMacMenus.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacMenus.c,v 1.2 1998/09/14 18:23:38 stanton Exp $ + * RCS: @(#) $Id: tkMacMenus.c,v 1.3 1999/04/16 01:51:31 stanton Exp $ */ #include "tcl.h" @@ -80,6 +80,7 @@ TkMacHandleMenuSelect( Str255 name; Tk_Window tkwin; Window window; + TkDisplay *dispPtr; if (mResult == 0) { TkMacHandleTearoffMenu(); @@ -120,7 +121,8 @@ TkMacHandleMenuSelect( case kCloseItem: /* Send close event */ window = TkMacGetXWindow(FrontWindow()); - tkwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + tkwin = Tk_IdToWindow(dispPtr->display, window); TkGenWMDestroyEvent(tkwin); break; case kQuitItem: @@ -251,9 +253,11 @@ GenerateEditEvent( Point where; Tk_Window tkwin; Window window; + TkDisplay *dispPtr; window = TkMacGetXWindow(FrontWindow()); - tkwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + tkwin = Tk_IdToWindow(dispPtr->display, window); tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr; if (tkwin == NULL) { return; diff --git a/mac/tkMacPort.h b/mac/tkMacPort.h index 76a61b4..620379b 100644 --- a/mac/tkMacPort.h +++ b/mac/tkMacPort.h @@ -6,12 +6,11 @@ * #includes for system include files and a few other things. * * Copyright (c) 1994-1996 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacPort.h,v 1.5 1999/03/10 07:04:44 stanton Exp $ + * RCS: @(#) $Id: tkMacPort.h,v 1.6 1999/04/16 01:51:31 stanton Exp $ */ #ifndef _TKMACPORT @@ -91,11 +90,12 @@ extern int strncasecmp _ANSI_ARGS_((CONST char *s1, #define XVisualIDFromVisual(visual) (visual->visualid) /* - * The following functions are not used on the Mac, so we stub it out. + * The following functions are not used on the Mac, so we stub them out. */ #define TkFreeWindowId(dispPtr,w) #define TkInitXId(dispPtr) +#define TkpButtonSetDefaults(specPtr) {} #define TkpCmapStressed(tkwin,colormap) (0) #define TkpFreeColor(tkColPtr) #define TkSetPixmapColormap(p,c) {} diff --git a/mac/tkMacProjects.sea.hqx b/mac/tkMacProjects.sea.hqx index 6ac0a54..de12b03 100644 --- a/mac/tkMacProjects.sea.hqx +++ b/mac/tkMacProjects.sea.hqx @@ -1 +1,1273 @@ -(This file must be converted with BinHex 4.0)
:#d&bBfKTGQ8ZFf9K!%&38%aKGA0d)!#3!k+*!!"Cp0Ej8dP8)3!$!!#LLA*-BA8
#r`#3!aErr`!0#94VAde%48BZZ8qk"T+XA!DE&S)!N!J'QaL%eK)!N"311`#3"2q
3"%e08(*$9dP&!3#[m-k-Xad6fJ#3"Qp6!*!'$E8!!"0L!*!'fT81!&eef[8q0h[
c8cahHe&qXD+EA8pi,%Sii8pE'h"kR-U8d#pkr$*#qIVKQ5HlGE*ALjqj*GXMQpb
@F(+EE-)PR($bl2D4fbIC4rC,ET2E*pRQ4ID6falCK&mRZAeN1mJQ4QiIfH6h'q&
NNpmcXQe!J38im8fbj%HId`QRaJRh6"lC(Z&("Mab@m)IJ'aJ[!'2[!EK4#)UK2!
)BC`Pa0"(KBMF,F5+1mMQ)X-dk&H*,c&Jp`C6U8JLC395LEef1*faeD6)5N1-M,M
+N4%$!Y9Qp3XjI&L)5dE`NBNK9Uhd*q,"F')ZUM*aPUJd[QAHP2N[#N@b3SK92I[
kr8h0,I8()NRG5YQp*&He"DcfaLXDm9EllA3UFCfGfZGBlF&VJeEhPLlVE'2EAAF
DfrCFZV[6kVTX5*aKGH0[CehY4F,Bp68K6[pH6@fl',4fGe)i@qQpP)$aUbK5eUm
AUf@STbS6X8'BK9T&f4Y8X[MSf@TH,`jjRLDGCq-K3EkiLKZD"b,T4#UMENR%daQ
P6*H,X+j4)1L%Je(,PiJP)e%lkjRY#*MMNILJNl96rUhQrHP8-'[Q'hE5LCKeZAh
pGBR830DZ-4bf(FF+"00$@D1G`j(S`&J%&qbiR,)`B,IDmB*08m3*1SiG#q@c!m1
15(aId@3XZElhq,CZ(FqY-MZ5@Pq,Ri,)CMVJ1j)3f%`N")E&K-!Nd0`bUKqV[S#
[dBP4HF6YD-DSbci`RV1HB'V36P[GGMTG5&S,HE(m`@45@VR9+Ddk)NifdVBZUc1
CMX3L"h*"qB2KcQl,Ee0Sa4`dfD(K`8%lCDQiXq(f")UHpZqiJ%SjE&0`L6JU2@q
mhHS)aJH(Ja6INFbG+k[,S[+b8d%iceLH0ekEjeZ0!`4Yj)9!#BQN@-H6e68FTa6
E"8aSM5C#l(-dqDM(DH2H5,`,j9qX3L4l$"0J-ad(M)Zi!"-p!FmpPGjDHLek6kG
h#ld9p&E5H`DpUqJ&b5LRed[['RUVk+d'"DAh(I4ZiPM@+hiS6T08"!4$L)hd%TQ
A"+@'hK2S2C2HYI5H51mkHNqLPdLP1*RH8qKp*leeS,,d8K0!R%h[Zl3&,-h0!A+
'2#!(b"9bM*`MAmJ*FSYD3Ik41q3518DqN@2N$h@#A+-Z8#ZS)p32DJNeJTST%$4
i!dNAiNC*jA0rjF6C&(h,LV+4*U$KN[%ckeIrNZbaMJ9jF4RJZ#$,bJ(5Y$[39Tp
-fAXLqqFU*KZ+qjr2+r+-'S"XjeU#Y,Qj)!PbM8!3+ZS-FT!!k`Eb@DiIb0HjKL$
IjjU#r)CV$[)debE5JUabCJeJ$I)$h89FYp"GcV80A6rA0(6)"c!"1QSq5@b!lK1
-$p"pLA%#ZJFB(k$l+H-%G,pR[%"T),r!#ZKJ!lb!VMk,RHCPM%(3AF2B"ef+m4Q
k@aQRSIX#ic9d$c*Z3rF6aQ6SrX`BMT*%2D!@S%2V!"J,(H)'eN+(1J$H3ZF`lN+
(ZQ6mpAb'IZ"Imb*-bN4V+M'FY,D6RMJa,1V$3V,MqQJN*"VB6Ah+5B9&4b4NYF@
5L96D3Vr!(qM0UhF'Sp&%)QjGCNH6`YpVU@D$G04,l&Kf9D!PPLqS29#)40,aA'p
MV+XbfNdTGJ4'1`'&(XXBQmrh@Sld@(,ajhXUa9j+XBI#[C0XHk$3EbKd0#C)ZIC
4A2i,cZVbAr",Prq#flRm&hc,jErRdq[bAaqp,[rYiPJJi')Zrm9!K-Yr$p$VmYm
2dH[bhir4braAI**HPpPrN9lQ[q)ER"r)GqPPrL[!@jRrLPr6braAr)9HPrmL[bl
rKEh,Im&6AIi,MZMbh`[TKrQ[!Bl*r0G!+j[jVh%Pe`KdHqL(qDm"lXRmGdUm9(U
QV,Nb+V#9k%NdD)%!6HmK!1-4%TU4J0*Sd,i"JSX(p1XKTU#Ai`Hb(Gl3d*!!$NG
he'r6YJ'$L`I82eJK1c-6!a+k&DN3jZT#drSeJG[AA8m)FQ'LDB4@fQlMS&&KIP"
l8!9Ve"$0%SD-LG[`QhHLhj(qILFG6'NH*V`0f@j86FGMrZMYkZcX+4LeGZd1Z,T
bGhb%`QTTkfJQM`ErQmPCf*LdT"C(CK$[@CI`kZ%"HKiLbjV,d5,P4cC9XhlFA[D
S(aN[[3b8d+&K5m0*aLd-JG$AF'[l"+iDYmNX4mJUe!4Tjr$VCAd*5@-Jd#&c@GE
8dGSAhKFC`1"*EhI!9kL5mNa,IVafB,''4ZZNj4YB,6&+l`"8lZL!IND)h*Hl%eX
P,"%'E6c!LeRl[[Xe#,Na%$RV6"(J58d0$'9F9qIVE'UZXqUD'RXDk6I3jZ[K+89
pLUK"hM`P+C1k&AHIGZ)M3VarVri&)l3ZJS'Z+ZDdeFclaVQf'MFlN4&N(GZIa2V
0r(mbfjh#ifEVHBcX92DrJ6YDTmQi4TQ*XS(`U,U*B)i-T'TACD(AS%-4,G`dTK4
690BS-TKEG&58$DVYpUCJB8CM-SNjD3e!((jramk5Rp`Z"mVXT!prS'14!Kb0SpI
AT!I)DeGhee5%,mI4dpcA8amD%Q((Z8Ci(Ve&V0hmPBb$Y3mqMYr#0JXA$1i*B)N
IE65j@Hi`NA%XM!PP&Q&-9iFEapEjR53[aI&m3Pk+irQYH2q1Bck3!18il2dDJ$9
p-SkK0qX9b`GN(![Cb1imQ8QXLS2@P'J#iJM2ClD89m`,Z((-)G&b(!Xp-fb"19U
[MKLD`fQe5%j)S(C0ah#kcpHjb'2J)l16CLUh!iR`m0XB"2kK"aJZ4"c18$48mT2
EY$-0)%jk@"-3"k5HLZ50['+dM"Rh62Y9rm'i+E162PjKh$0aD!-BGqI1GYl@052
&09!6S[PJlY0CIB@j,mDaa0`AieKLlLr%FBbjPq,3,c$hUAbmaYaR%[XbFbr&XF6
FTm*iPEQAiY!)-(Gl8-cL0!+4QhNRQ2YY%UHe(ialZ["IBGbc#+X0B0bdp[@mFkh
FdYDL92k(-9%FmmK`R$%YaV(%G&k)iaM6+F9a(-QRiRJ9b8Ya,)!Ha5(ArCB3iQf
%bF5"PC+cNZYXc&BDaC%)cBq1GSEf,XC4iApZR)2&krIlX290!b"(NC0@,U1LAiJ
MqMcRT$LLY0%bZh4b#KN'E'bVd`(Np5eNb($b"@kr(%F*J4IU,&-IkINb1bUV*,Q
GaCJUfF@mmCpaBVdc,2NCbE2N6"G6#a#(,qSiJL#'!'3k$Z)-b+ZBklI,lU-@)"q
bDkJ&L-2Y'Xl&XG`e(%V(SZ+aJ)UMphlckSCEc)1NAeYpPpRf5dXFI1`4dKmdVlc
`,R**Zb4Vrd6kQmcJNk[0pM*jM)+-BbqUD#BI,pBCGfXLbGPk4EGQTXZLiX#C"`*
h-,a9pl*ES`@S9pQYd3,%!9&`4XfErq99aN(P-GI0HM'1ABQi28mC$,mrS!'B0FI
fb-AjpBhkY`Q+1AQ@#if*jRD#)TQFReSSj996-)RaPZL6*M&bPiP-1LRA6c"h638
ce3)JTei"U9k8dKS+$8K24q1bKf*10!5p'2hU(SVPAXaN)&U#I4Ec`[XXjN@rYFq
L0&`VeZJUTQZA'*aqBdTA(c$lH*c"6H9MH@C4fc)el#iCedY-$5q[6YF"L"jSjli
Z68jblmGL[GSiA6J2J+r+dXf),"+MM#K0rYUZjm5pZSGNPJ39YRhV*2+XR4'XhFB
e4[MhdM,f*dC'lR1[-0,0LCk'0qPC4!q(!ZTiKcI&($mZjVqLMMDTh0@jUp(IA0r
FeccT4Kj6*B1Q(rjrjJJE$mhFP)QBNbj1Ce63&AmHf"8R)X[*R`'lq+LG"eH&R89
fN9'le45('jrRbDaG$GNC0kRimRCHLNr!MZ,,fq'N9,%0*`k+kXMYUJbNA4rpY#Z
ld-pPT5Ql6p1EPRC9MhmE#H+m)ViGbYrjZ(k-kp*c-IfX8IjqJ6Y,qH)c$biG@kI
mQIH3!)k[2r2qMRif+(rhiSSr[J4Y,9hUj`dSIpZIJL0PYi%QMSabCGHl$BRJI-!
[ahF19ZrcY@JHc&YAU[MZr`MTq(+d#PaJ9UAm$@$+P2XA'fqJq&BUZiEVN8YPYqR
$p(1aX[-m$0mF"bi%9(&8r32E@[M5Y%ed1)RaK2,AMf[AZ2p9J80q1%p"e!aIS&E
ahNbHUSIqK3*3GYDep21!LZqTQdR(PkQG6MNfeLYr(d$qq%Ue,ELJl8jPGi9ld52
*jSr6McaY894hi5)X[PjY#ef0D+j@mAd60F'AV0AG4bA+GPrq)aR`9@[[TU[CkQY
8(&GKLS`[A+[&a)-95c[!Z4c1eej"2i&B@Ni%jqcUk)K6!UPd&"L4prFje!Vj!rl
Pl-iN[$!haG+$4C`,IBVXcSNP(I+AYp[m%,!ld%'AI&EI#JcLkpYUlmhLDpjI,6#
2mT(%I&dZlJV-UA!Gr1T[!!MfKb[K3US1HX!%q2#F!DS2db[Ya#(NQ#pkZjVSKHG
FCIF3-)Q[HkX&VLRm%`1`i8XA,I!#EibQGdGj3"fZA,`K&KbEX1krMY+QF0hc-+D
8H@[-0CqRRajPpr52!"aXphIkZ9hDPE8q#L"3GN%kEmG3p9h@LU%k[U4ac`mSVfA
5cR[iVf6!9cA@`UqU$qm"i$&If'KKpjfbUcJ$H-EA0Vl[CiK9fDe%I(c6LS8MJ43
ZHRm)MX*A10EKNMZ1liirN!#1,h)FqM(ph+EX[N-Bi&lR'!&Z+"lMr5fQfH9%drm
"!!d09'Y-D@*bBA*TCA-ZZDaF"TX@JJ#3#!DE')6+@`#3%4B!!%e)!*!%rj!%68e
3FN0A588"!+r"3l5c(48I!*!&!Q*A!*!'2Td!!%m%!*!'kU-'q)i[acX[&djBLqG
LC-G[iHXb)0a+XP"Z(pQ%GB56@lLECKGYSA*k#r2D62),*hc"8m0c'TlT'mGI&H9
fba&qC,Z3!)8[%NjfE2&kIYChZ[#&Nq0jbj&p(FmRQbb5KI!D%%i@XL@h*6X*Maa
Ib%+iQqc)mQ6KLaF[,l,MC1&NS9MKG4f`cQA%VPZimTF!Ne[)L*2"3QiKYj!!`5B
,AhIVT2Hl[!CQ&q9R'JTXB*1FqGREfmRe1MZEfU9E1krc'Q6QphPpqi8%EUM3-kr
c%YSH`*fM6,)0DTj0c'[BQ9HhiHlD"afe)9R)!'S%(VRP"-!#1&[2*XbcDEHbLfj
pZ+%Xb'q4,'ebF-IG!*[J$hL80V#4CFdSLNk+SXTj8AAU&k*UrD%SHXY(mIPQT9T
"09pYYTMXM[-mcI,D6*lY64VG[UmMj3X0DX(h&DT&UH2h4p&CC[Fp%Te@qRifqSj
5Ic+URXLT3(A(jq8@1QcmIeq![+)M"&jH[G%E$XV`m0S4VD!59AJY2dVXdB`$pS+
H@Em[1K@4AiR@bJci[Vp'E"2LjU$bNHhD0IdkEZ6NHYD1'pRa0`T(jd@R9RkrHQ0
I6hmkNeqSRPjjjU3YdINm`rZLk+NVSY-(lVlSe&dcNf1G2,NkA6fDTANK(MGCfmU
B&ipP+mF4F9fSED1)[V0bS(*+pITKP,bb'U3LiT9N%)9[42N'rZMdqZkVjTB[6q,
&*(rAjKprmDe5Ael[q6aRRDa1NcF01'V&([dIdDdI5lUb1S3m(&lFYlGA&bi(",Q
'&MD@"8NThGCUUhVZ5AF033JB24GA&i9aLjFr"H`#D!mF)*rT1h5j+jN%6A6Mh3%
RlJcJL,FCNHLN8qH@Ia5%VfbQ#rp6+f[YF`I8AM+AMJl'6I$P9FYkYK9Z)+#cZ6"
9EaY0Ir5HbSh9aNQ9)G+Q3Yii4)MP5-R)Ya0T-IGfj5qf9`T$a2C[bcF`hq-P#TM
[$j%4XrfPLPe5*Tp#Xde#-F-#Ad@e0-*XV5L#&2i9P"+cr8Z8N@Cl$mSSXcf"-YT
Xr`9PM0Rq(U8df!*kil&Q@i"5CVE0+12-eSibhQ`[4lR"E,q#8Qkf$eLpB2X#LTj
l+0YIS%`)YU"UifDc68DCD,E9+"9QiiejIfcdbm6"pPU8+@Cl1mT8XrdZbM5cI3P
PZYNBZF`)YT!!kQUQfI#ICECDP0PQ1i`baf`2SX`efbqMc$2Eqe%UcICP&)8EfNB
G8cY!!4Lad'bmk5+cmFC9CJ-r&TZ0iGS5XldDCDRCIK0PQGNqB[L$l3p3EM(EAk1
X#,CmiFK+Xr(@Umbf(SAFXHe(@@-f@J["kI`$+(VqS'c89VAC2SC5BlErK%+pB2Y
E&2)#iXLlcQc8r`DcmEiEcEBGCC2C`-YkXrdF#ML$lGG3C%a4m!$+9V0p&DA"E05
CB(4B'%eHf-#D4V04-lHDMGbS0@`d4deQHaLPf@cr"Q@RfIipbLkcI3+Pa@bmr@k
cr3q82F%@%HD#9pM!NEeQSrEfQBdFU$YXGk%F-0[2Sa`d'cA(*!-EHB0&f,k*)Ne
Gj1p3MJCE9*MHCMB`kjMCU-rMCL2[fma'Vh$#E,q%!TjM8cf2QTSB'pK*E@,l,JU
i4%Y#hh+(fF$I1me'VY,f&ZTp6jX0A1'GX9&EGj[YJbKRc2B8LXc##[m#KIG4Aj&
UqPkcd62FCcD`4&VK)YAULme'$QV%UQhr'NAkc#,e3'!iYLqL[04Xp#)2QBdq(aa
3h`Me-0+9Ma$q[XaXB!Ip$MEHpa9Q!kI",Qcr$S@q$p[(89jPYQqJ812Bk%9q)GL
+e5[qSYR!bhpK0[S(mX)'YVl'E03@[3mfhZ"4Xj%rI4qf0k+!iGMS`rk9fHJlAfF
fqNjU"0YISB!$f+L$e`GELIT*DKBE24+p$cEk!ASpE'#I(Y!T'lM`UfEMhAN(E2L
rb@c[4!(EXAd8jGI0"Ukrf@arMX*#!6Ckdpm)YT(#ZEHDM4k2RKSEr3rp%6E`J"V
%"MDpc@c8&EL+M9M[-"Y[`*YJqaS+Q)m0I(eAX)e5IrjECU-AIEIC`(@`"4[iqPk
cJD&J+6B`JMi4'r9!2@)$rhlEE*p&`Bi0r+2I8GpSc4SqC$EkC,9SS@eJdSI04Jr
cQ0R)Qpi3'lMf(ma'$G-ABq10H(0Xj2elCL0[qMYXe"cBTEiaHQp`!a[p)Id)0Yl
lNfB$FcpP0R,pY0QSQFqBM4N!m`GXp'hNMJfmH6,B5Y8Id`YJSmrmR0RSH6j[0M#
GA,#"(H!j0Yk,RJAERk$3Mf2lRbKI#EDakJ["'@c8lZqEMCk02KSE[3SiJ!fX"#H
a8EGI0aZjJHIB`+Sr#VBbp8Erd@c-'ZJ6XG&hdVYK!b2rXpR!k'qCMEVmBl2a4V`
KYVp"B9DM[R'DZAcEE-`)[Q-fHY6rDMCkT$me'aK0A@-$8hJVE,`T[3mfHRIU8Ah
MKDrd!YMSArqEfHM$k3'a8B[d,kk8,cj*Pmm*-dah!(`(VbUkF6lLB4h-cdU!A64
ki4hG$SqTCJHj25+Qlp8c-dc2r%`dN!"-pRCEGqFfU,$ih&qeX@SA4jZB4-r65&4
*ZMdQASI#(T'H20'a2b,39I+KrScF2I1j+&EqA!)EEGRGTX3L4m*Q2l9(8,)MhKH
20q1L5)UarDP0(q0Ikq4-EFH@pfKbj5dF*YH#p(V'iAm2lTVjE#NK5qT*0mqZ6I,
PSUB+V*Mp`CfeYeFfIH+HbUDV,pXeAGYjqClSKfZcdQSfRR0T9,Q#BG@N4cHFXb0
DUZd+!hXTk)IA4N(mf6Ip[cRi4N+mSk[QRhaVZEADTZ8P2m2*r,-URlhm`FUG&iI
PS6I+6`qUJqSbITbPVcI5C*6*#*24*@YDM0-C$l)Q3L2-5KHVA)cG@-9L"B[9*-D
*M'MT4eKlS!eQ6-Xk#@XNM+0C!f"eK28"eUKBf@*9Lj%MDeUm*'YCV$,B0Sre!ND
JGZ'0F5pM5ITaqM('RS`''A-bhQ4%cQLF%5*MFFEKM-iCSc2DC3c1q*Xa2#0(4Vf
-faRc-XjN"-lSQp%TSfj'h)`K'@NcbQBFb4LEm69MDmE9M+NChc1HY'0L4T+-)Zd
D#L08"J@XQl$'`TS+24ZM@pC,@(0KQ-"k#3dTkb5XN6!DC@f%G4&'eV5GV)@`$X+
iR282"L5X`l$b`DS(ihY@+aJj-fTQa-ciPh8`eX!Bhl)#aZSA)e2@EeMGB1@,95r
@*KMh-R"KABD9,0#'NESHILM*U*J9(dDVV$@`NXCU''XZM)3Cp6,bCj@*Y5r@Z9J
(B1f"G5r@jKLQ-*TRE-c)RM8jaYk-NKPc-pjQ$-dSPa%bke5X8E''aIS9De4dBka
0XDE&b*Ra2QXpV(L`JX+)Rj8M9SeBm@,0L28LQQV'pDaCX5,$@*Ue"&DU@-GJ2-d
D'#0heJCBR@)&MG8c9J8BA6-UBN$!+*j9$9CI@(PKeB99%PCN@(9KaB@a15XfV0#
`fX+BRP8@9PKBA@%&J989aYqXRV#5`ZS&b-lU#@X$V1+`EX+D#HXPXPEL%2J5G@I
A5XKAeN8d,P+[e"LB5fe4#l`K1![ZJTrJ+$J,6S&$e!A[bAZ"SI3*i"SB#Rk"-q!
`'%aGJ*rJ(,J+jS#Ai$le3Sm#lS10p#VJ)(9&6B'cp!J@Pm&0DSYk!5ZT4@V-eLJ
e4ef#RhEe"`bPcX"DqK5`P0UQVk"r!$[!D[SMm*@q)i'ae$FB4Xh5Xi$(p&2J-aK
16d3YJrr816K2cG1$d+23(p",d(r3$e$rp!2J,cd,[Bc&@c!BA!@[,BjEM,IiRX"
eLmmCE,DB$-k$Gf!F@!FQ@ibcH!QfJUYJ+IJ)lS,&B$*B$GD"er4hp),dFI5#p(r
d1r5+p*!!p&$dNEE(T,qN$k,rSFqNpdVdQ,CAT%qNMl+p)[d!r5*p&,dL23*p!6d
"[B(&p`bf@dbR6`",`A$EUpSqeIBkYXqK2k%IX[d%[34p)IdKI5)p(RdTZ%r25Kp
-cf0lRI0IpZT&iibYUbDrl#$92A$A`N6apeD1ZliJ%@4&ZZX,%@%`IKi4q[eG!Z2
Ch$f1h%[Ef`YL*9Kk86pfAd6'X[lbNSlDbMG@*BmLfj!!aj!!aj'h)8mJfj%[3R+
&L(M%c81U-`k-H[@1F!3C44BLf5mGJ5a'PL"()8FMab",N@14CFKab!R)#Z3Nj'6
N&148j$6NG13-j%cN,14Xj"cNA13mC#9b2R)"FL&b%E)+Z35j&,N-Z4aj#h)&FL9
b&A)eFJeb,A)GXKTCJka&VNI@)6FJ0b)h)HZ4Qj&EN!"EN3h)EFMYb%ENVFJGb#C
N-h)RFKHb"ENEZ3ICLYb,h)IFMcb!2)JmK$a-E6ID14J(c"j8kFEakDd6'fXEYfk
Cfi,D1$NqCrF&A#QI-qDdM'V',lC@&ll%MYEZIlN'mdrja)aG&eId(TKEi,-0pk8
['d-eP4hYT0Dm3dKUl(1qK9CIYKIhQp-r,!NYhEamppcb9,U3!-IjGG&-RM5b9LG
YTXPL,8`6cN6eZ&'E@ilQDq0CUj@eSqe*1mR6dXHE1P4f'RZLlM,"DY*Z+qk-0Fa
k6lHEYA[@fUbCjAhM2ANaY*j-1`YCR#rf(0DRF60EkP[[MUrYf6CNl@l2YQPUBPr
5lKBpHhdllIYZ5Djl,U1'T,ebf(ENZEI")jD'ZZ6R*EmM@8S(JCSDHA1Krfj05EZ
IB02+`V9THc'lYTp(5fPZ@1U(DfRe,,YRZbX,#R4r3e@K,@hKPHpIDNKVEm9,L3c
hG00Q'6EfmM[EkHT&)@p-6BfiU8KRPmfT1PrD&`aRXj!!F3d[)BCBIAV&@4Zhpfh
*PEDa(3j2L+QQ&`jMI5Y8"EDYD6XNME%aDeih--DM0bHViFN`lZ`p*%CU`aL6T9r
E@V6S-E#ScGTATjEhUAD4f9Yl!&,AlZBKrESmlrN!$&)f4kfd0k60"(N@`0,QZq0
@b'AMHC5ffSN`U'j-3IQ-H,jLK2Ea4[98QPY[kpD&X'bHhp8b0-r@qk86@cAV
'@!eX6B[Z3VCUH0$HaaG9&h'N5KML'*J'Vf0&dAZ2lCeZ$kSDimCb-*b-'m'l-8[
E[EII`DA+lI[Lm"Ca!&(SGUVCA)K$N!#QT%NBEBS9-SDDZ6`*mE#Z6iY3!4MMYD'
YGbiQiBQa0X4jH"+-cA%SD@`a,'M1VG"MCE)V,9EXP3bD+Y2T6Q2BYKKVdalX[SR
96TChDkSYAqP4dH"!Cm@jY6`TXT@mN434M8YcSeRMEKM4PHZCPBk#qN)qlB4S5H*
PFVK6bT(#`*eX+T296Y4Y0,&,pUPZjXaBEZLHYYYSBQlB1V%0QcTKTXDeqS5CHT,
PBj['LMh0K@K54AUFSZ9&UkqBRDb0MbN1jSDi@ckdISiG+qeZ#S*TaaDcBY6BfCJ
fPT0FjKA$@fR84(fVV",PiU[2l$jXVSQEc5aVdrfGl*!!8XAiqH2[H%F)e&+EL3Y
`3PYh*2ZMQBPYKd16T(e0,dRP%Np%M*))9L@VLeBd2ckpVCq0pSXRKeNP&bZ2KYQ
TQVdeqDkIQLTG1LT#1F8,aq+&UZr+6j9eV)2@6qqDlmG36hF(81dEheER4@1JXL(
0LfjY0PPUd9(i,JPM%#P%%kVL[(HQ9feHI(Xrlm4MQ"!aed5K'PFTISQMheKja)V
*[(h#@j93(+bDPfR0fj*"pajVhMA1a32aT!TlF&,[S&0,2H+'q2!cfYFhkI-BjQ8
bMj&b6i'MIS*Np+20B4PUk,B`[Z,`Qc1B5$SU"qfS`IjSXrFdUHaddDDG%dmP,Pi
`HH0Bd2LJ!(3q'($k60lS'arV@DJ,cem(VQXY*1TMUMZG*-lMGN"`jEKp9K#T@`T
9PXC"[CTeU&dTk0-V'&MFPq@,4E5P3D0b"TJmZiIk2T`[*B+IXpfd[95!4LH6@Mh
ZG%TVc8VDA+a0V(EcZ)Lf*JXV5dY*AJXaH@+0$@TQSffU8@-SG-G#Nk5p"m&NMaF
ES&E$(T!!4$f00UX,ahH@k3TJECLEiAAZ6*V4j-kDHXild[d%8ee"2$,[Dj2(PNc
HHha-#Zf0,SpJZJ**F@&Y+Qi[VG"@aSYJ8CPD46Q-1Ub@ehI4i*%@elBX,UEb8Nf
'kBJeqP9XEfB,jQ)HM*c21EP@2MCJe6CP)GY5q[BLpSrC#FH2fk6amImi4h"Ye(K
UlqjC'VPrL+QH)ADkmXHI%q*kLEj9DMZEl1FHZ%9kpI1ZPcbl$TBpFCdqE'f(fUV
ULd-3ir[$1kr+%UNRp$)9drqlH4$E1L$jd0DTlI10jA44MBE')`pDe0-c4!mJJmJ
38LeZq8j'&L$$b(CN""P&&L+,N!!MN!$&b",N+#6Rc-BJ5j&MN@A)FFL*b!VN*14
Nj"6N913dj(6N$14-j#cNE13Fj&cN2'3PFMjb!A)KFK&b-A)*FLPb'A)jmKEN#Z4
+j#VNDZ3Dj&VN1Q3eXJCCLeb2V%0Z3'j%EN,@)cFMYb#h)KZ3!0Z3!0Z4MFKEN6Z
3!%h)CZ41j#jN#h)hFJqb&ENAZ3qj(hN!H4$*rCXMb+2)0Z3aj((NEFJ64ii9C`p
bLdF-(biJQbV5EG0AE+P2M%h-fk(1c2I-+U$,l$D@+q[ZNQaFZ3lk3,@D&8!'N5%
Nji`,N!"Pb2()3Q3%14*CJLa'PL-RP2Hp6,0,[pJe*NPrFV(D&-R3UrGiHMQkR%i
jkBk@h6ep#NH1k*KY2Zp%MZHAq61qQGLpX6,jCGqdp`d5-TGIpZd'hhE`rE)e-2J
'[Ikp-AVIldSY$Vp4IcedC$4B6fi"$"KqlfGU0peeF',$0LHFVl!-!$JCBZFKR!D
a$!!irf%C!("+`c)!i$5'lE)j6@)C!($+aAD(R')4"J$k[)S`!0"R5i3"J$i4BlN
LF1*&'!$SNbUfRf*`,3`!p&NPB3$Jdq9bb`#!0a)'!(lj#!-!c6a!'!$iG3*&'!$
iGG*%'!$iGE*%'!$iGIC$'!$iG8*''!$iG@*'cP[iGFC''!$iG8C''!$ipFE#!-#
[8bebjX1[%bl#!-#[8cM#!-#[Fb(#!-#[dcE#!-#[mc(#!-#[dcV#!-#[8dUbSHp
A(FJZXIpV+-)!`2qXe6*P6Ud+!i#!DN)B!!6dAX)!)#"rB3!3d!NBB3!3d&NAB3!
3d0N8B3!380d,!`$0SN!B!!48(m)!)+!c1F)!)+"62-)!)+#c2m)!)#!-%!B!!Cd
)%JB!!ChU%3B!!Cd"%JB!!Ch6%3B!!CdJ%`B!!CeH%JB!JDqLf)ZGIiFL$!##UJ0
K!"!8eJJ$J+"U@dkU"&@(`J!JU$U4`@*3lbJ-!),+64J!"(A@4KJ!"(9#4KJ!"(8
H4KJ!"(@D4KJ!"(9#5"J!"(9H5"J!"(8L4aJ!"(8+5"J!D%B)`J!JU(-b`J!JU(0
,`J"!Xd-3"J""eB3`!!MUI*8`!0#X%B3"3&#AT)8"3%Ki+3`!3X*CB3!3%MB)!i#
3!$"&'!#%922#!##NZK)'!#'pSc!!##Q@-!!)#4Z%!8")f#!-!%)kJ55V%L'p[6!
!#1RXN6!!#1N%Mc!!#2A1,'(MA*3`!!MTe*3`!!MTa*)`!!MT9*N`!!LT2a!'!#&
GL4B'!(RU2B3"3&l[K"!fF&BB!15TlQAfNLFX%!B!HDSa@56+dhX*!i#mhUNfE*b
a%JB!H6SA*3`!mY3I#!1!2*e[NL@*2*eh%JB!QKQ$-!$)dkNSQ9IRU3F5"J"j1MX
R$!$b[SiL$!"BCl!-!2,9,mQ0K(c9Y$!!b"IH#`1!I''Z-!$)&ji+!i"miC3`!-J
A4JJ$J(c9RM!!b0GE#`1!I18M$!$bT3X$J(cK[6!!b0Fj-'%!N!#[%dR#!#"Ijlf
%!8#qDPFB!16VA*i`!-JAPJX$J!,eKm)!S%#e+``!#P5l`J"!-h83"J!&kKq%!8#
"-&%B!"5SYS8"3)(H9"J!&261V@'MEa-'!!A#(Q%!8+"6Cm)!S%"pUM!!+&"r*J`
!#S5l`J"!YmR#!%!cHj!!8fhKhKN[E244`J!JV$j%'!#%KIA#!%!cIK!'!'(KN6!
!#+[1K3&!@$8Q$!$#HNYK!""@2X)!)#bm%3B!BCe5Nj0ZBI86`J!JV,1+`J!J,&B
@`J!JV2j5'!"%p,$#!#!L["%'!"(eaX)!3,1)%!B!%G@P-!$3M#+%!8"%rC)`!0$
X)S3"3%3pJ$!!L!K$K3'!CKSK$!!LUQGK!""4r3J$J)MH3Qj%D`B5`J!JSMF@"J!
4eDX`!)J)Ei3"3%4[,!`!SZSGK3&!9$fd-!#)USFA"J"4pFE#!##URPBB!%5($!#
LkZZ%!8"8IC3`!)LUKa%'!&(e!-)!)#SX&JB!8G@d-!#)#V1%!8"805d-!++U(f%
!%&A1`J!JU[Q"-!#)kSf&!B!Hb`J$!1I"TbVSh*kXFr9,(H0aXRaU[8q'HUkhcf&
rISma'mZ@kPb,h(T64q,8c3jeam[FjRRkBr(BcZ$rmG1TQrbENlb9YZ2ZDqNV320
c$L*fKDBRakd[1VX0[X3j#"I#k3A[BrH@h5Up@mD3!&S2Tqef'G0T2C@f$SbPhdr
)m9`0d!lf$,q1S"cCCG#H$*)rM-1%-T)6L[P%piULcEarTG,'L+mkpXG)A'V1a1j
IPdhNPhL*e*+PrXkp35,E91E$+jMCGqTperiBESCIPICEh[[TbThADmNRIKT9Vej
'Y2Lf'qc9Li2Ijh-K[%C@6bh'$UrAjYD6&I-*YpP4%,[Xl(ejAAAXMTILG-B-iZ`
&k&($imGb&#rpZ3!S&`cF!1Q,%U!cB6[erda5%JjkNU+#Kc3`86SM[IJN46Nm)%I
A`Q'ZIbS,VdAV,CGcQEJS,Yq`3qTITmc`*M)H["Iqkkp3DRMc1U@'iC,k)H90,qk
P5MXI)8QA3DRjaXSe6V["TL'EfmU,PbVSar&S[+EMm&TKMd0"4$`1k"Ve11cE&hS
F"TP&(SIGfa%HKlXFa4i(A#[a1#b1M[3ih2SBjA%dICbRih#hBBc(B6qme11`Vec
QF4KiMI-il!D2pcMF+,R"ih#rT0cMF0[N4Sr$V[a0(SIGlFRp1"U&Zq*`ff4D2dk
#+QiU$RG2TRXFpUPRH"cZG-cd11c@cr)ih&QClA'i,c$(il$#0GIMd*I0mcMFi+M
d11cCcrFiQYl2dh'iJE,3ih"(CT((B94FjA'i2l2Bic#b@q*af-eIkR'iEl,-ih#
RBER(iAl)#Sr$ECb9(SHl1DXm$[F(9RXFERqXm6LXlDle10cC@1GaZ2Y3lA'i4e,
MFEMp8qYa@(jDlh'iE92RFEJRY-(MF!0LSmGKD@U6aq%f5,h(i@E0CSr$ED-Y(SH
l4eXp$UXK$4j(8hCk1Jkh3ECl()DdM4k(fcDhHKcZ'Zh`10aZD[)iV%XeHaaZ2Zh
d10b$fZ9aZ"r6iR'i)lAEih$rD)r(iGC1UmIK0Y9HMm0GQ(dHKhY&qcd1pki1H"a
ZB4hd10bq1Z4aZ2ebf10`AqZ)aq(feP'2`efZ0Sr$cDjM(SGlAXFp$[HpTV``[ih
&-lHrTRSFEJ*0m$MF$,[Cih$6DU,(i8j2KFIK$YNNMm10XXG'"m4aCr"SM$qVRYG
EfQl-P#d011EIPL)@-fP,-5j"$F[0m'AHV2Hp,+@Yc*XaEmj3f-V5c'+HDkPSC@M
3@ITc'5TCPLiEXe(QRZi$5Q#@qYS`(6",cme5Gl1dh4*dh3CTH9RDACNDT2kS`jr
@)(@@U82U`P)#Xc6$h!9e51e4Lp6KMfLCZ3pU%%`km$T6"hF")MX)ER-V9fF!Yi$
H(Z*([Pi-Cm$Va'kbH@`pR+YILQQ3!*2PFp2IC-Yp6KL-F-4m%Bl'Rk-,GHec$ja
#Zh5dcRaZ!J"c3$!4-Kq$68e"9XhpfT%2)CZ3!-h)RFKGb"ENEZ3HC#Yb,h)IFMr
b!2)JmK$b#2)SXJej$(NFH4[b",)4'88@)SZ3!#13!-A)%Z4)j#MND13BC#Pb,,)
-13ij(RN$XKaj)r)Qj!6NcFL*b!VN*14Nj"6N913dj(6N$14-j#cNE13Fj&cN2'3
PFMjb!A)KFK'b#VNBZ35j&,N-Z4aj#h)&FL9b&A)eFJeb,A)GXKTCJka&VNI@)6F
J0b)h)HZ4Qj&jb(aN!6+-I""j'RNAmQlN'H4Cj$h)Hj%Kj!2)qj!!3H6Yb*2)1jq
l$lc#U&*9e01LmIcTi"A`C0XKlP9#a#VPI2rQG`djB@8mBi5`-Sk5EYT6L*ceT#V
H-9j@+Hmk+&UGqZH3!$$F5l[SUh-pk8X0#2fYP(1'9&I+1dQa+q@DT059FNd4kXT
iTZPeCGblDLY"[5[pILNLAPRRRXU5Hd6T@[(SH(9i$MbG0rc[F)5i9kGAGl8Q5(f
PA*2%`9+Z'ITMDEa)NL&,6QY6#*Pb650NbMQ"N!!GRP)+(Blfd91HJR)T*iebkFG
+)fQAGkcH8pj*K1bZ!8'cP(-')92H5B4-Z5B4-Z@D3-J1cb6-G,Khe9B#)G2[Pd,
)V(02a3K#TQ[&3mJ1ci'Rma#b`a'%l26UVYB%3UCFN`LCFXdJC"TV1K&5Fjh,iU0
al%*(ipU"MA'rC!R%h9*2,DPhS9h50efjaMH*TXE&`e,Md)Q'UIG1iTCal8C#ipZ
*JmDa%`@0B`F'a[dkB56Zh&P"(HJR,jE&[S4V9rdNF8qUiKcUaIhk(ZXFiXAGiRM
Rq@5VX32VM'-RdKR(ET`6&%LLR+edlD@j3+DkaL4T[FjTJlTTGjSYk8l2AI8MAQC
"cTc#bq*f-YA1YNe5lI48UDDmHP-e&G#CU)H(b63p[eL5aUFMa439aR0!QAC2BQA
D0e1qDIG8"DHGNe#EpNfJEDGV%X-kr3A'1MdYDQ9+)%f3!$$VRHC,Q-(IY&HbG01
qLHV0Z[BmNLhZY0[&qXidCYhZ[FqEk#8kA3G,-F''XF16TL,Ve[hibGBLlC[X,Y+
qkEihlCeSI6YGZam[d3$hBQJAH2DLCMGFGZ&N&L$lN!#a%a+c@0J$JMhSPiDp,Vc
,!PdA`Q@JV4r6HX'X&m@bm0@(@jf!P8'U,%4eB9-A+2@J84D'1[%R#cb$$9aIpcE
BZ[AhEAe0@fr(0Y5ZpI4U[BhD3*Ffd+*epQGpc9P[CpEAPQ9lX[-0f@!h0YL+pIC
K3deB6`H@EEpkHkqqaUZ[kdS08$SiLbDmid4$1eC5kPBE55$hf69jb55@mSiReM(
*ldR-2'9h@S+&kD6L8(`ZT84eG*5!"kpH!D6DbXk8%K@5C8fDLY$"S66Plc%U66P
fm5Y0P9%fqe5%MZa6rPlf+FH"l%eap1GZr(Xc0plRmMCZ[Ca5Kl*1q'HV,HkGV,@
i@dr@AIJTV()lpi[1-9cYf0Lj%!+m14HL"flY1h4XF9c)S1XG1Y#j*d3D5P1[%1m
9Kk)2[%!FGcY,T42+ip@BkP@(S[G8BYq%URFmPI%EbLQjpYFpZA*'Iq(bNMbhc0J
M(PrHCPQa&2Li1pZ1Y(#R!'SP5Jf1KV[9iq%"A#C8Ih#Nj(YrCK4FIk#)*i%(pl6
6e9&ZAB+("rN"$qk(P,BM$Jmder)9Pe`#JhYeXXRC0PHbH-"GTK3Hh"'2CTXaHRK
3bZ8`[bdX0Ued1PRH[56`(h+U$CFX(UJ$dU'!"h%UC8hGZ,dBjiYX%mR"LUDTf[J
P8GSHCBB2ARp3pRbrH*3PYF2Gd@XYSiF(B`d2'V)mdC'!-l8,aYijG['S086`m'$
FL,LV`1kifp$Z1"cSrG`%[$hi,$0pTp[A-$XjFFCNZj[NEBjDeDefQNbSRQ8f8Tq
%X*A*UR'3!(H[IB(S64YHCFG5(UJ8[I$"DkHkdc&DqLrNd9#I%[fES8pYEe4-YV6
H`mYfafLBQ4*Y("G!(LhMSU(M!(MA(E-lMf9i,BrQLIQjXB8p8D-SRSiUcp`FREC
MF2dQI'pTUiQEc5aVebj2QRdHZIj$Gj6X32dIH9aTQ$`J06A`0HbZK8YdIG9KmjJ
M+N"1J$c12mMrcZ-mIGiIjM'8b08m9#[Q1hrrCD&HhhYScpSh,k[+A[S%a"0Hr*X
4aqGmhmm3)EaGp,&mq(iCHETkrJfebYmmAV,IdAP!hZVr[`Fc#*h(qI)J$lRGerq
`*Jpe0Y%4N!$(dI@AcEdV(,"X(S0)G$@2#kffbS1+(ITd(QHL2FGafK`Mp*9!E9d
c1,elI2T%(d1-$Dpd-QeCBqA92()I$h*hNEr506b6ac"P$RA8m@*rGUDl-L)J$lj
+LZ3Rl`Vr+1Qi[9ZJkFrpdA&hmSJehl-GGhmHcS#1HrZlGiM-eY$A-,2la(Xi2MV
h[PGpYR1rQ-IPc[eL(TFlpdYj201jjr,)GHjmdVRl[rc&65-!1[HHphLqFqprf'Z
GHbk2bjel6aV2GHkj2"`#RIZaTGIVh[R4FD[cUYdaRZfiqr,JF`4dh1VND0@&YH'
4d23AHDeM8RN-)F19MZPL(TFlR8Yj202Tj2+iJZ3pH6b(j,Nm,S#HbN1IQXdK4#A
(S`Ep[BR%3)@S2%iYL-*LhlGpBHq*2#,e9dM+KH[eFC(FF`"m2d!mGDDA5Vb8amQ
AHd@9adN1YXH2r[C8G&XL-T-ZJ(HphM2%HZN,2IR92(,)HD(1B[9aGVh-I[!9PKI
m"c#QZ*`q[U[prXUKJbp1SE*II!VelCrU6aqG!(R80SXL!Q)8J26PSE#HGr8GRj2
VUD%6i$hdY-m*N!#(RIB0jR&efRHLffT'0d&[M6aHp4MHMeDHa&jfcDE+l4rS4'q
Vh(I$H6IG@,RR63)64I'aT)hr)jAlmNp@ERq!H*,(Le4&rHmaA'FbC@R[[&5[M&J
d%!hNd6Sj8i['pUrR-I`HHXVL"+KA2@9a!Z6"Cq$-pkeheAQSm[$pAheXbpS[Vhr
kkr@C%3#N'@(VQ'XpI'H-RYKmU*fqpDACP2PXM3eqZSGa!Z5aH@pqp4Mb*qp+9qU
Zf&NFr,+p81D,pd)[e%Hm&hUKASFRcKI(cHV6[G"er!#"@p21L3fFiAGe6dbZqD5
RqZGheAR38ef[Mpb+Pqrl4VrYH!eq9cXGYp+1erA2XE6MGEUchThQh[A+VYK`jal
E&E[q18"faAS!j,PGX6kNGJAXLRPNKVU$&)bHk0`G&CfT%`!jh3T)0IaGT*(XrTM
T1&`Zj3aq$S*CM"[S8Xlecl&d+HIU,+Bl%4I",1Cm$,Qi-r5jYblZj0ErI4Y'9Hc
rAqlJh"Yh"+jdAMej20pjp6r)YFiVPiGciMl#eFkV1a'h`*d&NmHap6SM#A9Jhc3
&!h(F!"f"cX-TFIH"%m&+cDq'-m(UX(6bAV#rdZl(8F,h"Sm64!el(#l44$a1(QU
Kai(D9G6MF-5ib11%88GiR!KUXFH*STCiR%,8N4kR#(@8aaQ"1YVM&+11m6JPU+8
HCa4UQFFCM6V1iia"(Hpa5P&[m$KM8FXp6KRUM4jR(1T0(QFLkM52`rEJG)mc#A@
'ajQ-1Y2M6%'GjA'QSXlf1003jhLFkDKc23jXiHGjR*QSP4jR&ZTmMc-EGB((SB0
Hk((QSLlb1203Uca1*HTLMc-IGBR(i9E$8Sqc%(@CaeQ%ZYcM,%CGiA'@S+ld1(5
qUcc1-Y69(QFjkPU2F`[UC)m$Tipe(QFPkKU2X`UefZ1X4Uha1'Y3Dcd1e1$AHac
1!G4jR'V8$4k(6D10(SFjd5D2`kC3[FHT3phXFCMBEr8i'e'hH4bZF$9iR(V8l4j
R-fUMaf(rm9D2`bED$Sr6J0VNFEDK0RZFlDJl23jMZ&dHjeE8&Sqc!h@hafP#hH0
aQP&E2Fj1e,dHCaIU2Sr6JVVIiqa'2H"apU!Hp$LYU)FmcPl8`ajR(qS4Ml-IpDM
(1B$DjR%1SKlc1#bm(2Fic)LR["$('P3FCY*623lhfbGi(0D2ErBih!+Dk((B3+r
`11``62)ilDL2H4aQif12aBPr"F(a*ha+$Pj9G105'9SIF&amVJ,')2iIia2EcXU
"bLR9kiIHF#cmk4GJhB$"ZL1J!Mb1Q*%4GK`aAA+Fr``R5)FE%Tc$!q%-kTlML1Q
3!113!2Uc%!C(c*qP9QLeID"bhh[R$p0U'hP,S09frlH*1V6DR!$-9PaJ(faL!L@
EQ,c"p@ER(*XB9aX-C2&!f+-ij0KKM"ija`jMc-KlGKKMrkdr-%M3RSa3ka#mrX#
`dh,*X38T&I(CLc[[cY2[G+Gappcbl"iDBeG,!6MKGNli&%GRL$ZHIS%HTD@KUH)
SiE[Q9EUD+JJAm1rf10"j2Z0aS1Pmcb!1cp!9"rV0paf,%aV'J9EcLcdID$!rH#a
1hM!10*KIqd)qATfah[bSai&QmZXmMVVekpYh,-l,KR&Z3(h()%ih6dX9TaceJkr
5k94a*U$qcL!1jGk9pmfS(r+mZH,hN4IU0K12Cj%pUD(2b4q(aJ-'UHMKqmmqmjb
eYG[81b8rQPE(mHH1ZjH49mlp`Z`[M4Z9Ibr$2FHfeMR(cYPCcljAc4FGFrH9&"j
NlbZjhHkR&)qFZlH90eVZhTE#!mZqea&hAdRK3HPS16E'#Jr+"[Hf"RK$18mrKAb
1f(YEDPXeHH!)B+L)[V1lc1M)j9)8cBdQ$A*p1qfQF62GRfc,ik9@dMj1&L2e(5b
km6UhM1(mQj1mPEEMlRqRVmXi2-UPISHq!-3m92HMIqI,9lTaI(VVa-EDaUeEjVD
J0Nk1cfdFV9)!6KJ-F-4mh'cik4IieqZ!2rl8Br!HdCh6dh1(r5,EGqlUXBVa[f8
Q6l6FdGj-Nd9SBqN0-"`h6%j0m"6Y`f#"NqNR+qC%-E2-h*Y-EcDpaI5GTZmbIEI
THdard24@drHD[XrdrDBI-2fJkBG-2f,k8G2E6$pQqR(6Ec2pa2!CJfqF&lAE1c*
GZ`aEJ01QhfAkhDDI-IfXkIHBIUrTMF2%3UGZ$f[ATNDU,868p%,6Ld`IBAUak5@
QMc4pP1QM64pMHURTBdfhY6M1p2'Qhf"kZHNhQRk6k40-[pRdLDCAQ$l*p-QQ6c&
pUZR66*pZqJc6CjSqbr6CTXmaIDlTmdb[0(fqk3Y-AfMk)Y1V6&pXqK,6PjUqc26
PTYpLqJV69jUqb[69TUmaIDhTkdbhp9YMHUhTkdf[-hf$k4Y0hf4k[HQEKa#4rch
PY,LLN5dQYA0VF!`kYC)h5UC""3V(j9V4JkD(60IPUR4GVNV2-lemQ&j"Y83H$Gl
+Y@$S'Mk6H9!&jd0BjP1TR`P,Rq#K[*00911'dXF2SdG1k5m,@p"8%5+QD`45ZNB
`T9X%XjRGE[UGjPmic#akqZiNALiA5*4b41RC#Y$!+,G8ejfmkpFh4!F2V[9NB2G
6d@&lPqcSLGbV&d$GF*-T"rF85)A6dafPjjYZr4i`r5@Q@q5kEm6!&%MTTrjV#U3
LR4b*-!95B4r#4dq"p15(&r[E"0YhERaq+T5bakC!m!riU'fTrCjY0AfX[-EULai
Zf5,iSXrB)Ha2@0Im5I2rP0QrE[URcHmc*6X$Ar4)p&fPrPQ,rk60m$p[HAh"r,j
SmEpKqTFXMbrEHhc&iRa9F5NFCIZ92SH!`&(1"*5X8Yr3Ma-kbTN!6&&U(bF',`k
FcMa1$1Gk54Z(er-i-I6&iA8p6JapFEK62XhM`(9KZXFT3ThKFDMHQ4i(lJbc2!l
F'@Cl(,Jcc2%iSe$RHTc4U2-mcKM85Sp6LMVIiia&AH"a`1#&(QFFkL+2!eH)+Sr
$[I[&(JHZ%%XmcSfS5ch16DM,2!lF)jCl(,K(V2!i%e&AHKcQkUXmcL68e4jR-ZS
DMc-&GDh(QBUkcZ0-3khf1004Dc`1biZe(QFQkRU2-`ZecZ2-4YhJF@$EZ0(Mc%A
Gj((QSGClR%V8c4jR2ZS@Mm0Zq&D2Xa#e`H-X3YhQFDT3YhZFaDL0(QF*kUdH"cD
01cc1-Y3QMl-FYGRMh)+kdq0`bQ'AaeQ*fZ*a9U(ZpMLV8IGiR$@SV4jR,HTHM`2
&q(dHTaTe[mH"[I!"M`2hc)-H"rE"Kca1(HTKM`-,f#-HCb2U8Bqc#EA0ip5M([-
iQe'2Hab'KT-p6K0UJFGK,b,XFADL4Mc1,Y5SafP",I3iZe',2-iHe"%HTa@ef12
X45ha12Y34hUFrDLM2-i"e0%Hjb$U')m$@Ga5Mm-4Rc+2!jr6F4kR$A@mai'kp`d
HjcKUZFH"[IQ0(JIqVcGjR(E8r(kFe+@A4"b@$RlCjp@`aBjc'NV&L9'3!h(Bc2N
0cqF8DT`,82!S*am9"`Df8hcqI4IU9)r$[E-*(SGYKTXp$QXB%cd12'NV2-kpU*-
mcRfSFBj%SD-FL93F+#[(14+&MR)N8Pi[3Bec*1U[a`G4(r2hBI-McU8SH*4,dC8
iXBGeCQli1M&H+K#pDF1Ve1XFAQcMMaE&de(PQCZMdhB-6SH&lbeY@EEarN0hP$I
Ir"pjA'QiQ0M'$p3VY00Y`AE8klF(pHT1BK[[%Q!*Iq)i6JY,q*kkph"DAIZqQ2#
&clh&0PikpriMcZ8M2cThpE,G-ClYh2[cF!CdlY[I[8-EQ80I`mcZ%qrKq*J!p,h
UXa1!LhPFRJ"Fc12b"1"5(Xp-!(*j2$d"f"c[LdF)6!"khZ2j#8$r`ekE!16bZ$`
"k%RMZ3P!,Sm,%`#9am8KJ*N!(&Yk[HkG(ahhdXhD2qVmRZfiqr,JF`4dh#eTqk)
,aDkrTq11[0BapE2d[pBaAFcMFUGc+BpR1TeF(PH3!,`RMqH3!$bAa`A38hQSZVr
8Q9GbR'I3hjY)$&5)bZ28`YlMH@aIf(XLMdMp&5DpiATpA&[!$S$["iKA'bVa8Ki
RAqi994iRik,3q5pemHcFimBUZLh4aU8,i&f[p`baA[T#6hieMaabAULc@(fFA5q
c(hb&C9-kJ$(&jI6aAHhh9`iGr-rZY[0,G,HakD-6))rDCP&%3)`#N!#q2"6@mkk
qir0f269d!Vb(R[Bj!I+`dll"2+j1qdjd@meSkN$)ie@2X5*@8*h(ARE0TZSC9ci
@r8jel-VjUBHVYFF2%9,Gm5Pj&2q29mGf2PXpikBb(jh(Le4&rHmaA'FbC@R[[&5
[M&MkTb-QMpE*Q9SdYRmpMq(hd&-@*d#pkLQ,%b!22J0R[QqpUmj$PFIJ&'SiMfe
C@r[`rCqrATmC!F!dKG-IZGE$GmESLFf(fZPEAjT0QFr@f1#RHaJR3"kEpqCAMb&
rmUjdTHk+hFI",pX,CEji,r4#IF4lS4IUe4f`FkClSH[i!3+hTTd6'cM$lqUHQ&c
c58recqqUmk#RZPiI&hRkZ$qfXae!1ek$hp91akfdihApFbcYH*hZV(HRZAGe%@b
,Uefakjm$C&HX"d#HfaAV3fTA`+kBkG`ENRcTf&#dB24%jqkSk%bG!-MT9N#Ui5p
hF-IPGA&Rm(-3c',F3"GhVRq1TBXl9fFahBNi#5lh$(ebZ@ISFfpGh-QYrrXfM+V
BrlrF`ENhlJKFkEakmRLqmqTrN!"VR9FZ$qI%IB5VR9Gh)Qk"1`XQ$deLT1mM#F9
bdc3&!h(F!"f"cX-TFIG"IGcUjV)$YpZjbmkFQfPL!h+EdT!!TlX9Z32*VAAZU(-
MRI[Rh$EREMNhbENhcLealS4c%jY40MZME#'!8GbEjqfT)lL(D)lm5X+Z"%iJm2f
!b`Fm2H$J!Em1B"GH(($HJ-m'A$AJS3(($2KM`!d$hKG`ZS#["9`Xi&N"K`Vi8E#
&"Dm*1%[!4`+Z%I#)J#-%r"rJpJ"["cJjJ(j`DB!R!a`Bi,I!cM+m&1#F!*m%Z#,
!!i'+JVm"h!cJA3#R![J5`)8!RJ0`')#I!1Z2m!TJ)JT@-BRNMMqG2!H619l-c@,
ZBA2RR*[SI&`hTMPQiBqlh03k1m&-D*N6F$2E$I#41iGIihH6$EZePplreJprCQh
Y0Y@3!,[YZbh3NdRL`L[[2r[02l'fpL[#3hIEGi+QKIiYJ3Z[ZIrX-qR4CMmcdJd
A2Q!FK4+im%C`)ELfpZ5M)pe``IAeZH)iElSI2MFp$eGAC'IUa[M''ZQDRldp1LF
h"@J1XGP9Rr[YSJaemc`$Bh02`M)`lQ"H6"A$[0MF&l$-LjqbH*mch6)arRfcri(
TAc2p$dhrJVf2C@Tm(Y-X#"Xm6[)A9%BA69rVlUNApd`p1(A``d&4&'je6(2(I)(
Sj'mAE9MY22T"RHfjSqJHk8l#Ap%j)1@ARJK1j)C25(lT'cKqhHLCL4rhFK+[p'H
@KmS[q&F$[derbpQK4d*q#EmTj"H8RmS[iCGh&dUdNm-r12U6Re,#NMGhMbB([ef
k9'1Zf[JU0k#8PRk44jl#CUlBq#S(8&iAiXh3[5"Ki4%8MQ`1mElk5dVBq"9S(,m
mq2h0%pL%c8RqRk'-#(l[r'X&%MpbA4$bQkD@`9c*mEe"pj&-IY%GZYpNV[AihNC
1)I1EU"Y%h')Ll"m0hZqhlmA'I5DHPeY+j5&HLlBlc,8Ihlh8FGR$`@rHVqTYT'l
HcCXAK$bqp`dFZ1e%(Vbpj2IAIi50Hdri!905CcYd9iSha)mk+`jqcEVCa&dSh[A
Ab#rIkT)E6pb+STlHJl)Qj2FY[4rhSr"ll5#20Zd6Fe-+9H'0riRJ9kqE6GbC)Yj
hqqm8hDEmZ$ePbpDm8q5hGHZ*He5i2i(bUH$hYYk0+P5e6qhrhT!!4i0`NlY9K(d
ebMZ#hmY9`paN)MrUX$,NmDDIaNEpUQr@Xp4#8I$lX2#*QeIUDmUSIH-ArF!G1(!
(5hfIC`Z`kRd@MjbjMD@q'ETPp8LV@`KI[HX!Ypp(+FjXGFY*[1Fh%ccc%qmNH5E
m3Kp5MDTii+lR&rb034drr,L!@q*a-m[JCH4cRm-Q@iSKeEI8fHbIaFEG,XVN&31
me*0Sm)FbS6i&Yb+r*Z#@2$l3alr)ahm''cHrm2[f)0i*hIAL$KMia-d[Jkr4(p%
00'k$%Hr42Vj'Pc8N%YS1kqmHi1@Vp"EF%#-2kN,HEmb(9DL5"hf+i'@MjQ[F'P1
9-[+K!9kZ%5C+jcXA["DmM(khHJ$HKrbS!mP[P(,J6KPqh&S6(2S6i5khbqJ$2MM
!Z9IS[K[hc!LVF0ELjB*E9#['ElVUeH"PG+[`M,YRj2'*34kRe+-*Qk"ep!q#Pj%
2lF1"qfMd$I4*mNkhraifF)Bm&12N'"imMSdlDZTEU9ShH"Qpl1qa5DGBrH8"AMk
Lqh2F@e2I+VfPi1A5*e@lmRl8Ym(,k"AUAEM,TViperIa-RV6eh$J9T[kALCL21)
AZ8d2BHTbaV8$[(bhDS)qK6)(0bX-,kA(irXq[89*C(MTqDhqZRT!`8[2ElcfZ#a
HHRjqiBM8m42[8`+#dr3rdPmfUZkj,8HG+Ib`rG2hG&11QP9Ic6m1m(,H25T8b3-
m%0`kTKULaq%*rRl3ArkZ-&%fCi+U3m'r5DSrQA-%K-(5Akl4fmKQ5q#MJrcZ&ZE
b*ZSlq)8qANBHdPa'*XJ"pDbfVm,'I8$HLIF`H"Rj,H9JZ)clV`3,4ai)m9kT0qB
0eEIhj`Ci1BCH8pma*!9k@DQ2Eah%*[YcjF)H`D&4ZQ%SQd[PRahJh"6G0H3'S[V
fd3GB[+c4@h!A%DLKra#m2+'qKeZ*i!6e+AR-8HmZBjFfm-2fPrR#5QU+H13[G9#
UqhrF@F52RN2HU84[`He&pHhAE%$`XPhp!IFBeAIX(rTi'IQ#X*8HAhd(G*r4i'A
N@HA!Q`0VB+(dPam59[,Qk[YjqJ1,PbG8fm4AUGhab`1mE2PG!D[aqacaUMiIm[L
kHMJNU5NFMH'Pc$k)GqC1H[D`i@AFccI12-ChUH'PjcGHZ'ca-ZiAL,i%"VDeZN[
2cfrmqcq'mpa@Tb"H`ZpYq19&-e0&Pck''3Qh+QN(e(c)cSfmH,iEk*Im0j-hXcZ
[VhhTrD%2eRiHIVq%2X2h5I2chUpFGUQE3hTMlQ05(amHp#Y2UPIN&LHirK8eMFE
[MHS*j#END[9*4``[QD1!Eq6hm##r,fSf)@FKbTR(f2cZ8SmSKa[bQ*IBr*i5hXX
XX&Cc%FR[-qTCCGDi8VfTj2FDj8dZq)%ANYqpLL9VS`(0JL@rlfPQ)6GEp(0*I[p
,EfNfJrd2%VHdecr&'5RjriRk$XL2qSRlqID#pl'jKHFhA[9XFF,cHihkb2FCVRK
qDc@hQ&Uq4p(&`V+A'ql5iaVF,IS"pCIdhHTV9fpUqUULHp4RrjcPmE&qhe08@mA
'fr*%#LmP[beGe4EpNITZ"rmN[bd2D4k!RAN!Y@Mbfh+"hZDYPJHc4T2IPSpT$N4
r66eaRkHp94c"4GqH"iCqhRYADKi@"HIShlaiPHS*6,p9GDPk'(TH)%le%1-I#hj
r*5a4F`rmhN$2)Ae!eB1DIl`YP2dLm2,'@i,IRcf)apY$IVI4)dTr9[@(jDa,m)a
jN!$THkVZ8QqUm&Qr"c9KkU2Ujc@cBhC(2(SQdeG9AD8H8XfTq&j0AbVpfH+hUUI
j,DX$CQqQ2k[kaZHad4Y5Vq#!j&'Yf4jeS9*i-r0%kFm@Rk8jh(Y$[2AU(H@p'eA
Elc2mBpjNm+qU81fq2rJpm8A+VMli[INAF@!H"6ia[c#iZ2L(0"p5IB6'&HB+"KH
VeTj@$b([6FpRq[,&0@%*G8h+a$CpHG9IDVC,VI'ZB)28dcXe$f-q3"ldq9*2he-
GdhHSTbj@ACNqF[(CQZf#-mV[,I4'dNG@II$6H(`Nj2(!Rr6lb+Sec4IT!DNcqNb
TJmFe#bDQ5Z'YB)cdN99I8Jrhd4$[&l%&hPMkqECTjXZ-5,Q-iXf#&`DrYfLQ#Dj
5Ir3h"Tpm(rm$E"m2ITqNrl"jr(GQSZT1VFkMM0Q2cH1lIiS(mb[H#4bA2,kU'L!
ApAfDaX6Q-9E[qUQ3!-G0B)r0ia[#4@E8e#[V)C,(fc8rqdailpp8hbaj2+kj*R0
Jj6+*1VCj2+@DrkcP3Dk5adXdHhM5qK@&(ll6@QcIaM'Dr(j(q2,"9RaN3cT`(PM
P$r1Bi!(e+dpCh6"2E!jqLp@[N!#MqKi@M[j5m(Y!lfIBIJ8Z!)rp'i,I`jSYIL(
ic3+hE(krUMVlSZA"qdTq(p'-L6GAmDDUAL@rdqSMQIXT[pRdHcBr[hT#qPcP0iF
jJFf[AIdZ@+eF5[6HNYphP$2i3fY2Ab(jKG@cUIN5I[2!&C[Ikp9,Ibhi96,hXIR
9U8GP&NejmNk5harr16EU6X@EVcjHm[Z%-2JE`@q"jUD5ha60UjJa!MZUI`S%A!q
[#H2Bd3"hrlcI0d6HV,S%Lm!KqQrM&rk%QZ*[QKrpMrJG[KdEqadUjEh-(Qaqle3
0Im[`Jcj"iVeIFcKba!pm&,r[D*B(QhrmU(2a1kMq4[AAj2F3Fel*,l*CFcAQU-6
Mh5AH%pr%T[TSl8HYb,Z1e1`91hdY18Qme`Z,rc6Npalk02YqIb(-B0j#2(SlLIG
0p5M8#hldKH,h*FfIC#CcZr$-c%($Ap)Xqbr0MaSeI8piAM-eDK-rjKf5aj2URjM
j-!HL,c4pG[L2K8(dJ26CmIfBm'lPV2C"I0(r!`#3"!d+9'Y6D'9XE(-ZZES'NUa
F"TX@JJ#3#!DE')6Z'`#3%!il!*!)rj!%68e3FN0A588"!+r"3mZc(49k!*!&!i4
N!*!'90%!!#ED!*!'6i!'!'[m&Rl@dB9$&T4(GQ6$-llZLa0Z4pL1CYD!FKIKb6c
lEQ94Q8,UX8eE)R$IZ[(8NckHLFq,icpfAP@Eh8j)&U&ab#&I10a`Rq@93XNqU(!
EJEG0Z)X(Ej-GKr[J2ZK&pX$PHVkNm$MF3LA`YE6MF0FQ#pQ3!'ai$#[mbI6L9UG
NBGh#PFF1VZ3J18Jff4&)CR!6H*XX(,r*DNfm'RJ0[+D@,3lXfICXiYGjXE2[[1K
YjQD$['aJjRI+(D9pjiEl1Rk,mFXmXMMTc-Y4MZfpjFbhXdRAMLa#Mm2IA6XIQYG
j$Z$Z2E*)PJ0h$R)#M!9`9RjjT9eql`GC$[BPZqdY%A!rfEiEJ%'!$(MNC6A$d$I
'A'*-iATcLG-bPbcHDFa,rcAfeX*3!9Gl'X1@Zq"%N4G'a@S8(R@EbBD[*q@8phS
K'19qKM(Ac"K6Y2E8Zma`k[`@FfRkreBcG$'R+[@Gb5M+-cEqj+6*UcT(S2*5a`T
R*1bHEhMT"NTRIr4rHH(Z`K9$Gr5#Q-*@&XcTdfFm[RqkS)0TF[E,qHfh'[0$Tr@
*LqfLA2FPA5AY3l#8H9fD8[4AFEDVr#f(TT,EG!+Gmq2Z#m`9PeA#`'Q'jl2-Q1[
0#`SI'6Ujm9mS!pG0KCmVI'RSmfBACEMAQ2pmb&bj#3c9Kk[PN8lN,RPVjfUTIi'
jR"p6@+dXTqT-Z8fJBDPMB+kX,$6UU`GFTq9'0irIpNa@24R,PF1HLV4GY'AXIe`
#BkR)SLCZ'"2FbN8Q#UlT!9e`p3qVE',D21ZiRj6922@535irDldpP+8(KI0PpMY
Jcj@&K`X2AA**(h[!N!"#+)XVTKbZaHMrd$pVc*qSHHf1laEVUmAV!C3RrKp!AP'
1$da8Ul2'A&@X2T3(!2!AF8*MNA&aKMci[m$Zf-QMB-93fZ(1h)k--3,i(2UrUSH
B2cfV'h(LT$rEmaS'(ai"&KjP&0!cHmqC+51CqLfL%*K'i6m8IZ15T6lQTXcMh2r
%rFrFramhfG83F"MrYG`MZ*QMB"r*2BTlY%"-BZ$h2lKKHT25cNqCImZpQr[Ch),
1+GAj18)PZ5ZjS8Aea#E2-GaMZFGaMeFaY@B6Z#IDfN'FrKU6e-33(@QLJ$`$FJZ
)&e#(e-HjraJEf2m*l[r%rBIFIm6p*parb[d!paqN-l@8q3,halRrNIXrFrmAl[r
+r8RZ2q2qFqlra[dTlVmJjKRmIjVl-p`bKd[p+[GIF[p(I*r%r@4XAqAr+Gc6ZD@
r$'-"-U9qJHVf3ZiABD02AXcp%ZilZAqGqkAF[m(pQp`[)!Dera+hc2e5[mlp-Zl
IiRijpbX%bR+rN[Y9h+rQIJda*r2r@ZlAFIm1pqZjhm"p&rFEZGr%rII%QF,rQlR
I`[delRrKrMVh0lLT)c@Njk@1i%4+YCFDTc441iYl"VId@5"Xq*rF[m4p!IIMZ2m
Aph1jIjRlmGbr`Jhk6q-qRIYXlR1)$BkFbhdHprRF-lRT5fSiLhXf0h9LP2Fha!0
cTR+IaJh-IC2l@pcrb[eYlNAF-NN)K#h#ie)9lNZi&h+$FBZj@lJ[*JEBpEIFMGb
AFmrMrKchVGbrbMfIqhRF[mBpKhXZpl1iPa"EF#Y9iel'[Ccl-QkC1+CH`Ef#HbA
hdlN[j2immF!hZ+#`J%#i*4JBJ)'"m2+Gh1r#4PhIcAd2ppZilqB@E%lGcrelh'm
P"Rh`$pc[i2ibphZiIjrl[Gc[ihir0jcb!p`Ij,kIQ26+KlJrc2d4lSpb`flIMUr
dBk"qr!VrdVm"[4ZSAlr$r9hZlh($#cG`Yq),2Yr![C(l1ZlVZCP4EqEH`VfH'1$
i&lMAF0r%I5hh&lP[ilkGHbhhmlR[%(@6qaTZD13fBS2p0h*[jflMKP'Yiel&[C0
l&rF9h&GbrfrL`3qZiVik0i$*14S+ah'$'M"+"bX'[pc-3I$,F"N1I3kRiB!jCZ+
PZ!!AiY!(m#!1rH)i$K`*lX)"DqbXf[)%kX!"TahESiIK3"`i#rM,%@jN1"S(AN2
G1'!MZ%PjU5QiK`d-!bHaJ4(BX3RZ'ck'$3bQRl'"Er3r0V#8AX9'rp'(f-!#1!X
fq"iF"a[p$UCMJpq!kGM!16!0'jJ&"Q+$He%6E'!dIBH0ZS*Af-"q1!HY5Vr"1l"
4Ac!-'rr+Sp2#CTd*TF80i$2BU"qm"K[eJrYJShld!MD`#Kk%$3i'(m)'Ri)2B40
m0V`)'eJ-2m)QI06`(@a`4h!$Qr!#`hf``E[K30LS+e`)f!%[i%6Bk%2k%4XeJKY
K)bkm#aYp5CfaJDY`%'aJ-aL&$AkMFkNbm8`cQ4#EF"$$Fl$"$q!lf1#rF#4Xm$T
i%MBi-a`*'h`"I!!H`6[K9mB'[X#rX0(Em$"Xp"*F$4ZedqP[ZIlT6@a`+,!8'hb
$fQ+$pm(MX-%Ri(2Bi-l`-fc`AZ&TaJDrJUYKJa["fE$"qq&Zf+Ja@)d0VJ+(``E
H8!GXe"LH#1b$eh!5E'!IR!3EZ!!h`8EG`4CXm"cP+"A#IZcBi-Ad+6CQ!A!QE("
bq!)f1"kF#4[c$IJ30ZBB`VH-MEk%Mf&MIJ-[`qDi'r3%,"%1CfaJ26`1'cK,If%
$"m&!E'!6YF)'MS!Kf1K4(IY9UYE#fib0I1"Zf"b(``D2imC'[A9+9UPj"j`1'l-
+Z"dfqKAHL%hQ0)ERBf0q!eI#aMb'Z4)f1,[1d#Seaf$'*+G+h)`C"$Ci#l-)E2!
@kS#0HZY8XNUB#$CL!b1B!@#MCjJ$B)1IF@0M$J1Ra3C["iZ``@2J1pMJCh!(E-c
(C+CME-adQ2PJ!rZCc@#$Ec2VNC-4pk0(X-'Mi)2B`(ZC(aNE1!YZB!0VQ#9KSrr
!3fcN$qI#"YjcBa2qEqC*f+JCpF3'aM"I`XDFLcN60ZC24NSJ0[U-Z4-fjLr-Rq4
NK6(-SE#"-6+2-MDi'6-TE2!IqKdEI!1XaJCf-k[#4LfC@@%$Gq"Cf1KrjPIBk$e
i-6CU#QCL)aCF$"Yc%MJQ0ZBNe"`EZ))[0QCqc&U`-FX$Il!aAi%6B@-Z4SpMSdH
CdFLT&SGR4S-0cXbX"KXmNjN00V!6$-F'Ek%1f1!2c'f`JDG`4QcJ#h-FE24ET"(
`'T`I#9hNJ%JbKcD"Tff1li916$ZE4kIJTk9U+@9b1P8!"dX55KTN-P222C'lMR[
5(bPL1Q8R9Kp"%ZPXe&1@*KRT6[SUjpmjIJF*4pM'HCf4dp1%D"#+bTJbR5&JN!$
lp$2rLG5Q(ELQE%Nk+U6iD*IUl%%[,'AIdRdF4[F'66*V$MV(R*,[a,%EMjc`,-I
2R9APD[(Ja#[&hjLpVANUKQrQZ)lKVUQi543HGk29Z+K'DkLpE,ji3f(dIHmZM#l
Y1caAR$q`BUiYe[3hGmFeVf$J+JapkLHfAh23,"F2Cp1[%"AQ`PiEBCq0X1T'*L2
cQ,V0JiA23r8b$lBkRdR8I-"K2Xac!92$"5KC,QD+F$%a,Z(r%TMc*8bk&M+G@mM
dB5(UN!"&X2&&6'%@`A3ASB+jP%RUTF4VJ[Nd-HPTJMdhiGF-ZfhZ2P96'G,*j()
a0@PKiY,#a+X&jYk#bZKCe10CX0eR`DUA-0&F!KeEJYp5TQG,Q@!XBlUpM!R!-LB
5bjL8,'G+YjaT`h*Bm@ANIaN6ZFZBe+`JVa9-PPDJ$&N*(UqNCLZC4+`NVmZTeq8
`kFYKlCIM[iVTj#UQ@DZBE&l"C2B+TL*AS+5iNZRKP8b$VQ4+Ha8pG"A6akZBU&`
&NlqD1Pc0G1jUHQ!eM(ie8jh9j()0Z9b$XQJ0F,k'UG8DDVN'YF5e6&+[C6*c,C2
GY8a`ej,A@Y3@kkMa1LBUkjJbVJHlec2aAXq%EMd6M[@S9UjM!RSGrAdGFDqR"kj
R-R3p%r$V8@&YB)UrJAj[CDVD5QqfiRF$dk`EU-X06#ifdPFEb@dMbUC0e'm6Nip
0p0*QTPQEQF"YCZUdKHRr&UD*@jK)E)A'EQ@5ZK89`9EU[id*lMEU[3eeb$B`i%B
8"$I5HcFb(Gh1G'-l2E@G#FTfTMaYe+'0#9BEkSiGq1d!$hE55cZC-1jN`V'6AYh
&9(dANp4Gp1XZ&&)hJ88hd5mhd5mh-r@pQ8RQcH$2EUE4ZqQ2hIJpQaM2eS4FDM1
JSd06D6@D!A-lEZEA+h-"e*Vp*qLV1AY(#$U-+"kd)8-d0$"MLH2mbLHJ,Zc8eFC
+kBlDX@8#TQY5BX"["[Y1p@+89E"NSFR'JC'q'G1l#%k$j66rk!&-,ND)*3k9Cd+
VXLSAfXQV3JIQbfC'Eaaqa+k2$lIL0XL2!q)"3&N@a#B9cS-`Q(&49$J#!3!3CF3
41Ld`!Tdc&%6ZU8q1'Q3H8*!!UNHYHKa!FPAJ-2jfRF!Sf8QEk%KA4Z3$VRT!V*-
f-FjedLENC8lDa!M95CZ%))A5*U4(+QdbFL190J8#Hj8f"B)((@J%bPZP63ED9GS
8D(5XdUC!Be+90J@5DMTT%q0DP6BC1C!!5T[5NQHSY#QYdE0+Qp)#'j8fT38Y+Qe
+5aUJdUDd4YmUE8TVR+[5TV5N&bTYNU8*SE5T62fMdUBbqDLdU8a5(C8fP3RA90T
8*YQ&5T[+02C9D91CaZ!UE5U6h%ZP6@@5SkUdU8`51d@m-SfN9GT8VYUTY+PF-L+
90T8,B&ADC13d+QdU9piUE5VAb&fP6HAUEj8f'AQ-5T[+NEFkDC14`DLdU8*e9fP
6K54,+QfU%'5VY+P#Shb90P9)8U(5TJT*"P6D9+(q9QP6K@5i+QfUN!!84k90PF)
GP6C9UUp8fP3TIb9TPH)1+QfU9,d9#5Z9YdUEM1a%jp#95#@GY+P5H+E5TNT*De6
D9#PTPNUEUS3l+QfU8XqSY+P+2LTYUT+F4k909C)ZU,6*5%G8fP3PLB&+QkSN8eC
T8j9`9+909C+fUV3T)ka8D90'Z+$5TScUU0+QM+3&+Qh+U1G8fT544%@P64R9AU9
0'8N-90U8NE4'T8dC5Ea8fQ6JAD90@H'X5TZb`LQ90QA9mbTYbUTR90U893iUEFU
+UDLd+5ZTMNUEXUU05TZb`Pf90Q8Pae"TNj&YU,3T+da5D90@NLf90KQTKNUEUX8
h90T8,Ha@D91eX%qP6GA#"C8f9DYR90T8VASTUkU@P%QP6G@5dkLdU9Te8QP6YD3
S5Y'VK@%UEDU@$&fP6G@5PkLdU9SiUK2E)H*M+QdDSYj5DG-3iE)5q#(#(C8f$9%
IUV4TL2a9fM4%FKk90Jf4A%@P6813!+FlDG-3bD98fM4%Z+,5TU(#-j8f$4A(8'R
681'J5TZ'#MY8fM48[DI5TU'UY8UEKNUqT0+QSHTGP6B0P44IT8e$aCP8fM4-A%f
P6F2%Ie6D0%cBVG+QBHT&P6B08`qSY'QBqNqP6F-NQ9&Tdc$*,&AD0%bm3D90`m9
,9GSdA0LTdUEK`Nk90JdA9UQdDEKk6+90`m9p9GSdA&*UP6B0e`S!P6B0&pp9D91
0q+G+QfU%0bTYUK&28'P6MA"0T8dekN190YA)Ak900H*r+QfU8DiUEDU4A&qP6EA
LYbTYUK8(8fP6VI"-T8fe`LD90Y@UIe6D9#XTNdUEDL@l9@P6VIT'T8dMe$FUE4S
KEUR5TK(L15TY'L&-9fR6#1'15TY'U%p8fM4#(%ZP652%-e6D0%)V"j!!S-NC+8i
1pm3'*b3Q0MJ--RCXi#BpL)fHTdH`892NlGL3!![U@(#NT'Y`"cQM0-YJ*33fq$R
BL!eHLL38'e`,,SB0AS%N$KYe4Fk,$8`"fl(4'q!E0Q+41cC@B,"b!K[pbYa!cQK
a1+5"f1$0m%eXm'4Q'YMJL["IE(!NHK-E@-XF!"ZB#!r#4Tr68pLSR3aCM3hC)AL
)$@k%T%p1REJl+bb`-FX!@l$"jq%Tf1K[iQ-$JkNR0[J'FR0Xi#cV(l$4fr"PE03
#$SZ0f3`bEMReQ[[!3E!aXd!'M3hHcN`$'l`46SH0HS[8hpMJ*dJRXB'jp$8fqKp
1JBfDXL)"'bX-b&h1'-eMC-f"XB%Vi"Xfq#Sm&aXF$&k'$Al#5K4Xi#Bb6@cd,4*
EE16$UK3jBcAl34D*$@j"[f1$Yp&hf-"lX!iE2F3m!4Xm!4NP0M!,(S'0[S+MB5-
I*-KbaJR[U5dfCJr-Il$"ZA@0ccM`dShmaQQeJKV(JCGQ$3!f`@@cNJ5Ei![D0Q1
6HV'LJM1Hq4HV+Sa0jLaQC38fQ4'`IXAB'-AVr'mmIFNk&Q-6($GV@E!*VTNe-GL
NhmaD'6N6m$%VB,#a-NARIa1BICM9)YL%EjY9*0L%%jUe)GL%KjL9)0J%Ema+$fc
86qGr%r%hXdGXV"c4qGp%Z*&C9B&0q,PCEB&01+TC3i&0H*GC-B&0qY+XBm%Qq'M
@Yf#6rM3V9q4-JNqBY5VBK$HEG4hBC"jKeRYJ)cqGrde5rA6q0dPV(AAq0`PFB"d
(Cc*eC#f(XFNXc+cR`#CFh+b``5EFcUbm`FCU'Chr6BEAXCE'f!5hc(SDE+c1d2R
IC$#&96@F+HTeRIp0d5*&RIrj3%kR+Z2!ML8'iqNYrh)Ll21[)%+[[`G!&1X9f2Z
S'F@Pp8XXZU3@MlC,6VAaBq%%AG%JpL1hk4"G9ZB2f(iQ*#[H@LF9,@kYbffP'm-
iS!c+5`hm!2[T"YSZ8McP0cLLJhK)`r3MG6Q$)DP`036'F%EXVmQU)--fQmIVHR)
F!`6E-#K"kkaQ'#``4`UI,[cL*@N@Z[h-#9Rm-mFIXkT9G!A0EV6X&ZHf+&II#B@
,i&$je1cq)me9Vk9ec5YU`&H[T&!m6q1Zj8jc9h"RZ1ZiklR(FirK(XXpMRX#pd6
Z5Gb6ZDG`0rbH0MdRC"YZ+Fd*,EQ0ErD[MZ!Hb6f+Zjjl$2GBlR(Fie-0[GN[LT3
ZpGhF0Gbeh0AF3lL(jP,3c@L,E3i,%i&H$L#RF0GbXb'LJRXFphMZ#G`6Z5Ga6qD
HbThKVZ1Zjal,28B*M1`c`,D9(qKdQQG*B)i"-Jq$!5,Xm#i``%j")U+H!c18Dq'
*qrcA`ZN1c'!%[D"pFTFMXdXBC1Gf$qr6-S,bI6IH-QD'McY4i!A,M88[LFe`+A+
Ga*hdNVE6-F14Hh[ALpa@c6[KQZ&f'#FeEhR+@rB5-ccPaT4LGkhTq2JZ@fhXGj0
AHR(AmFe`qA$&@Dl@NSM%*0hDb&hfL,BE#VA0MC*eXkfqZY!Z"dY2eA5GfGCb1mP
+0BR-YKR2pqHe*$mcXZ`Qc48(RiZF)!afhlM(r1Q4dSS6'(I5DDiZ4f%hD#ei35X
mAJVp-$*AMp4A1c8hbAbDhD!l5I6bIAYZZF8-iiYVmb'RlDD49PI#Bqkm'e0T'p$
dapPQf!Q@IEFFc2-[GCDP*e)(L8"eT-k0BEYMkecZVR9m9EZY'B@q2p&-[$#JiQ[
0pT(TpL)a'eIFjQVUNDNhr8E&m3,c[5104M--MY%@UjHLX0d)h11q&lMa4Th25@X
f-kd(YR0['8A&YB@K'R'DeDFl9[HlBCXffMh5T!+C6ZL[ejaMVYQ@V(FShR@KfAB
im'l[ZZ8T1QP(f1h3Kf''jjT,IAFT-CHZcbdYTGR15V-92mRfV,3r'ThJ@"8!N!$
LYRD58VY&p6F[9eI#**b*A2@3!04iBGYCGUHmZ1-lkR9U-CEBc8kcj,Y1T"kmeSR
8'9+E@MPZG1@N(9F,K0#3!1[S`khGU%RpY%,RTIAJleaKeTB`mCE@Tpc%mDa-%2@
A@llT&QfLjN#YTQSpSqj%[BP+b#eE4Hf%JJYP&kT"Z!LU0K3P+2ZB)+!)4&@(HJf
fKq)5K5f+@&3pU0a3NU,S3#Q+'JJe$N0%e(XSBG`L204+U%"4Hk(S40Q)BJL9#qS
ee!a-d9$ZS6"!"B!U6jI-'[8DbM-8CbMZ'!qM"N90L[)-"35+1*4YU,QBHU*#3dQ
"!Jfe!BTJ9"NS,9"'SDa$2BED$J8)5JX8(p"*&!NSGP(DSI4&YBZLN8%K3fZ8[DK
q85LJ4N*jK%)"C4XU$C34U#QBPk"33,Q&5K%P*LS4&(BSCe(*SS4$'B8b54HY'V8
E5P@8ELJhQ)fMUN$jJ)S1P5+U)a3HN!"69+QS8@'E+!$G)Nr8*QC!,$H+$P5`+#4
4pU#f40'('K-P*BSlKT3S)e%"S3*&4BT5&88VDNS8FbK486mabN$"JMS%K4*U@e6
,+*3CbU%)36A$`"-9*T-"Z#rU'EGdP,Ne8)B#&T8@5KPi'JS99@6h(DR`S-5Jrm6
,1PEqh[MlrmmR0*D@CjZY!Ak"ih3()rUkJmDCbYIH+p!j`T+1l*TXRGL`P&[8rp2
MJGL4$MMj2fTiA-A`NmPU2(48Jp2Pq4$'d(E'$*(VfrJ51jL0,a+brX`HPf6MLcK
#1R)EAq,3A4YI*16i-lRN0lli++E%"j'Jm'U&Kh8c,AESkS&4BBcH8CUEQYj4h$%
e8CrJYk9FUPXYT#rP#)15SGIL@K(bf6$V"DY-flbVjlcaeAGPBTPPGUf,Gq8)$p6
G5,khicIE2q`$H3q,c2!k0Q1'6cpU2`GNfh+3!+%JeNC#NTY+LN1iGV*V+KNl*&0
*#Bf-T'mU+4(#aC3(pP"+*'3L*T4j")Fi6,DKdf6BRfMXF#"453)Gclq0CAXD`'-
MGrI,M9Zp-DX2I$%b-"q#mXE`XREQNDK(JY+hp[llDqLH2FK5NFHk0FfSHZJB&'Y
)9j'8)[G%0k6[6M,GUZpM-Y*,9%lZ[69qJX0ZL4qVXQ)(3rr&1%DM#IRrX5SVGM"
M#E1r3XFFdM6fG@9b!%HcqG4&3qKX9Tik"p$+U+IC#m*"%Qh`fd9!qfbfQqT,S@K
)XqN"9$GV6&eSP0"QIkN,M5cD,#j9a9MlmBP05IIdX[GTpBGClp(Xa!QbY2+e6XM
L$aC5c&R#`DafD*QFklM"e%aY2@LDB6CPc1Pdr&Q[cH)2@A$"ZSajN!$C,@kT'm@
XfXK8r6!TXmC#I&XQ$a"[JCC1Q1MPX4H`XQ'lQh5M`'h9@8JKDaaQMMp9dr*pBlY
CEL(TY6K4l%j%bmF8kd`Y[jJecM)1@Bl4a+D+K@brZ*Ni+Ep4MGcBM9JR)G4j8pK
FE5`&XGRHGYBUBFYEmYaS`@XP+p5P-3b@[19Zj%jfNi4+XCKLYECDV)QR)ZHiXqL
lT6#-@LcHN!$SFpF6VH"SmpQLB4D40&CQ@@'b2M$EbS6F0,mFT'Xa@'eKYhFX@jd
qjJBXdC!!fTTkRDRe'@IY6[pQDA((M0flp6GV0+dT+cCQMH1he'Za2S2qQjGY%T(
fDA+$CDTQZR)qkFSD&&2KE8j5BXm*@Fki9GR-(,q91La00ilSDJeG1N)&@*JaBrG
B@JGXCpfUDX`D[iRe,AC,arb!T5'TBHAAl,"IjH,bM,Qk9TilI)3Ul1c8h6@l2b8
e2&YK2BGNHKRE19,$mmMVjl%UCTR(!T@KM3CE89CVf8KV5`JKbf3%BGJTXjU@BY@
),#cC@NlFYYP'`kr)qSbP)r0EV&@*%%9Acf3@&m1eY)kekJ%TaZ,&Sb5qdfF9$"j
Qk8LUrS6+E)8AVaLFRmTfTLC[-A)LMe)YADG[0rFGh(D40T1SI`AD&JCH`ZD8(DY
ePYSBJrL&YU@hGjh)a55T2B@%Tr[HSUQ[BVSd04QPTl(-193VccMAhqMY'QrG8"T
4!%PE!ZaBi9r-$4[HaY(ND6'dE56+c#ZIY,YUL9ff6H@+,IPZC[P+DX&e91dYQb@
R8,+Id"A+Q66Np"CYY6!!kkpcQQkr3+R+3QNHG*'@0Z@KR!fPN62Kc9UG&Uq*Q$8
XA[28p!b9D9[T&8B3H5eEF9Tpcfd9Xbd-E@PV0SK%Y$BG3C4Vdk9Xp*%`ZG*&ZaZ
QGjTT1mmF'4f*9hb9-M4*+R'PQKHX05a-P+[8*fcjKZZ3!14Z,1SCRUQ[2N&`pPF
G**Q'FVX64JP",c@9kX+QHDlMqf%B81*0(3V380T9fVNc#l5L@(9L&L-Cka,hK+P
1cfb'MM-eHb5M6-@HbdD0QJe@ZHI%EA1N0$HcNC,abf@)1Fl3l5QER6DKY&#U8TZ
PVd-m@Rd'Mr!ci*q$,K-*"("@EE6BTG#-lA#AT"H&RcFlZqRL8Yka#U0U#hf,Z#%
d62mJ!""EJ80VhfhfEN)HT#"aG+"04,%[6F%16fN'JKT)NIb,cRCpL29A&aGXil[
19)-NFfc!j*KiZV*B6jGI$XYXNZfZFHE1XleJ0P"SeM4#()iK`2SqmFPZe4aGDmB
JDPdYiSBCG[6%RP)ee&+N&D$0m5b"X)5FL(0#d3`baAMXkV8(aABdr6ij@qZIY3K
,&'2F6Q&,Xq-,YJ+-'!X0C&ffaa&BXj'+bCUU0VFifIAmPTRaSMJTeYcPYRMpl%a
C-6Y,D,h[Ri%JEELeIUrMT-)@eh1mU1$ZbZQb-I"L,4'R,83e6C&[p&`)%m&e$SQ
YJ31YcaCf8IA%)3GcF46AjT'258M3C)qAkrR%dl#2SNXBDHjq@qkSV(2hCpdLb#4
E`YB%'5Qer&+fJ`Pr-`hC-%&FfrjcTZ[6FVZiXGQ0BEI0RC[BE"dajjXZef&l)h8
d@Mk5YHEDMFSZR[KDD4G2C,893e+V"(U+Zb+XJ`611aKC5qT3',LQe)f6X&fmc9d
rRJj6jM3"fMDBiSi9)0CXU42SfT%`6fS$bD3FXLPZ@fUec64r,BQFf%bjLphPC6F
UCM'"6X11,fE8K8hQ4#`rfFaiE([US!A"j"k`DlNUUr!Ncqh@,+rFCDpJQqfLe%b
p5R@fZ,iTcaIR1[!-@E8(-hpf,c)&GmPM5j+2ZJ'6%&llVd@`a&K6M0T&2FiUcV,
"EbIlkA*Y-500YS&XedIC91,XAYR1+8kd@TkmK(P6,b'PMQ8`Q*SEYYBhf%E$IMp
FY(&XA5P0dFP,G$cf-P!f1)F$cklML9M@r+-&$#Dia`&B`VhmlLA#qV$YiUEY`$l
54PrpQah%SGM9'h(BE*FlYrEMQ0GCrCmi+-b'EX54*`XRGFc&35PDXa%RHTefHac
8TE@$1+K64`cLS'5pi1Rk4!C8UmmBa!("jJlLS*!!EAbk(k-i+&JcJcLS8kX'F9M
!1UmATfXGRlikDriJ$XYVVarNcH,E$B-iE#aT(F4K5FKGJcJX!,QM&bITa`kYUm6
j2ZFJ!(Yrii4l'D0KXRIe*#*52m[aSHpPC1c-k2rR'k"#D8$A"LKI`iiTMZpTFdV
!9T4'9L$),K2CHV%md-D4&Qr0pGQ)XDflb-D"eEjHmj'kYY&S*Bh'f-f04JFmE(A
mKK0&cRUMT@H6l'`QB64c,0fPBYH4Q0dKqPJ3NBBZ4BKX9RQ`MD8fHeE*20)@McA
48c@G0DCY)'IYdGrjHl4EC1BB@cl@*%i`eSJDRDJ6N@eQK"8H#`jefAijICUY&TZ
UE01ifG1V286(+*Y0@T2pNE2%CSke2X*YdE,b*!rNQ5)jhF,D&AP)52Q+pRr)&T%
Ck9k4Xr8hFqaQRP4LA[qK1e4'em0PhNdL)lEeHU2*p@jD@pRXJXHbF)*RTV!eC&e
)dka[X(#&kNK"lGk9fZVN,*ePhP`b*dkhb+ae1MqFCRefQM9r-mGZiH%LXX8Q0E`
NU6B[1$(2-T'DXEK%Ym5d(IGBE,)q[PDe'VV%hK#hlm9ZA9R!IK0H(G,@B4['C6`
44EEIc+2rGVJEffq@*Uf5#LKb@AQYLI6e,(HYb4Y9T"dAc*GZ['A4LHPmD@a4MMk
YqI,G0qUK+U[4emUE@Tl@r(-[hcfQA4'bM@*VK2P#eESeY0Y-DPQT)KVT5jbJKFT
eHE9UYVHklIEkC,Sij5Dl[8EAYE#[KY+QYNNP,3TJfDbbTGZZTbTkfI9b0VYPc(0
C4SmFS3[F$Kb9rUBZTG&@TPf8hmmpfiTS'bTH,$eVj#REAjC)P+X+hF6hj['EqeV
KGXG3*pcZTkQfjfmAA(5PUFkK-MGaRSp'9lSJm9N3SYG22!cXGf@ZP9FjG1*Ed&J
RcSRJ1[&-p0@*CejFhHlBVV4ZpqjXTeL$R5pFAT!![FHhUjP8UTe[N!")Needl+e
C0'![qL(GlR!UG@FXkNim%peiiPN3[qHK)9(#al232!BQRZdBQ2M''&Kde!BSqVP
Djr0[am"1jl"Y%fI&`-6(B'$LN@"JUI)+@BP[!3-6j`3$%mm%!a22'!1,MJQH&,d
lfbR'`(cKmKLialHVQ43$m`d5B@$4XEGQ%3B@rF$!$UG5GmBBQ(JQ'*Ki&M!`$`d
*"NDVQr)3'$Zf)f$X'J0J`8q,Ah"cC8j5EdHr2EjK[mDqLRfaLi'qf#&"[Xjk+dl
&VJAFLhd6f)XG%p5,(@23+rJPq&&`hY0"-H)P&FX$ASGVUAm8lT+ZL0#Zi0G6V!M
V#Qj!AG'RXaYMS)XG%jb,(3X`Pk"!JR+-Jr2`CMcDFFhia)!@1QKT3lZVRmfV(EY
LTl$TM*1LPE%CQ$+@"*q55LQ8'*m#)KQR")U-4i*"aL-'Rp!KDH63+bjcM$1f!(Q
!LAcb49C)XB@-X#4dk-Jp3Sr3$QcNM%Pha%"K2"+%-"i&D,!YPf##Dc,MaAE(r+J
J@926-8f5`ImfC[mGMTG9cMTel+**f&L5CJGKec3l(#A0a+NMc4J0Nbb,h%L6,2T
*MV&24iUQUj,FFS#Q5H8F*"YMl%LMIA9C%HS+rJRU&C`,R9r`ci0!`6Z"ci*cM+5
G[JQ`G3C3M1Yd$CFT&AUKIEP5bEepf9+4hKAFNTBY1-IG@r,G@bVAj3@rJ`eIB&$
GrMePMQP'TqrqaSc)4kFV2+6NepdXT1#G%TH$FcNB,lM%alI6YVQ&-9`XllST
)@`b3!0mV9[!ZB'da3"jXLqi*fKDpBlJY15GYABUJ29(bl@f+214fqiGJe1([PLH
fqb@S@r51BEI,ZDGJ$RL,MKh)@`a4J0kp!AV,(B0[bIP!QdE`@r)&IlXFplC$JX"
&l`5#`m@#456-H5B3Q(-VB&r1Xh2G(Ri*fZAFBTM,Hb@0NhI9MXNlZBk)UTU(XS*
Mf054S`@[R%1#@MQh'+lD[6V+i!!Ujp'"6$RI!L392IH8,3DK[&Gh%d@`NhF#EpS
pL[9-%#EReLY+k9Lc'$RR9L-@e9,ccqM-`*rLl+L3!&ALR-ZUU$mTCK92H3T*aEk
jR!Scr@*+CY46b-8ijC))akR&k!85@dLNi*r,UC2q&Y-VNS*#IKe%0Nb`k&V+-!F
+KG3LRK$QP2-T*C2!3ZFQbb4!aeV,a$hDFCRiP4CH*Y$4QAN5S#2ca$h+22%VC4i
$6'ILXAp(hV&hP(EX9XVD)&*RZXDa)drM&L9Sl+A-#VM8Q@3K4NHqK3K4kJAA8K@
+i09CKQ+3!)ik&%0%K5MkPLU4Jlc1%Z5m1h,2q8C*jja+fAD4-GehhD'U,'jZ,FS
9$d3!aBX4ZULEUd&4eABJIUN'4D*AM&!LHUi%"CA4rZLP!K4BB6&!RK@ka%1p59H
m8USKGbakpR"(PflRq(d`Le)41XPQ-8J[fA3&+BdR$qC4+NNa5[Y8Z84IHmChK`X
D6Cp,[Kd$P'),j!GCaC6c!jNqprCUjiPeai#S90qmHh&)&&I8kh'mX,[3iQGVH&U
12fiA@ZBElchhUabrh1X#l-1Qh-Zb-JpmhiYi$G8Z,Be2MRhi[2IYH'4HSK"X2TJ
pI*[+$drZM3BeAcQ5#r!bJi-[8E![F$2Gb`ZR23&Ji-Pi0R`(B2&!4VRC`Pr1cE[
L+lQVZ$2F@HjUlQ(F`lQRFYG`eh+2j"l&2CUlMVZHH`chH1i*h"1j'lK2iqEKe"c
H*N$p+33mLcFAm*Sh0V@kKkAT1p--cD*6H@m"EbP`,hcMh3+m5B$h"[#@!0i*`"X
!H"JhZr[CbmqZrrh2Q(biMFcM'1L4j"RkhBFDjcTXAdiHK2irFI`JVjZfcm3@j"$
eJcj2DVUHp&hU3*p#Zi1[!krf-(c%l#f@(rd[F4Jp%J)-A0plKd*akE',!djHGbj
1q$32I56Ri2XFp!'FJqppN!!ii2#FFqpNL12`FXqV"R(!rINEl`$ScGYc%5G%UYa
V"ahrF5mDM$Q3!([a)(`TIZNJI!Sq4-j`)Pr"1Il5lKJZmp"CCKq+phqI$bLK+8$
lX`Bep,mpDe!GNQF05R*dRDN,lm,R6IPK,M`!R`I$K`km%TrAfYYFiK*VFPki!@&
cV6ap9IS#YbeX%*QreZ&KE6p@hbedXl$6h68pH0r6GU!P,qGq"IG[Flr5E)0MT&1
+8C'5G5qF`![@UBmLi9Rf`GkpbpUPd0V-E31'#!r+-MbBcE2'j*9-hMCFF(KJKT-
*(QafmYNi3S3(GF`5JVhpTdBXj6d4kjcSc)-YGqp0h`FjfhK"RKP34(J`0X-$Xc9
NDEHMefE1YK)DRaT4F(JJBU6bVq&"q+T,IaSL4(K3FACq`$0Jeb6jDb1%L#r@@ca
S4UI#8YbfiZk4'dGZc9Y$K!J2aX!AKfbrX(9XI+D%IqaF`mdEJ2d!H64ACLF[a'P
r`@rT0&GRp4jd(d!H+dT6q3"eA9+E2jIKm6b@64qTMbbZQ'BF2fi+Ahk$'6lB8c&
RhT2DNYF51f6iQjp-RqBBr03M5X2QXIDjI*1R%AFIQmH6GZB&j('J)$r)im#,RAk
Barj%MZ8KmX(8VK2lXRkpjl'9dlqlEdMfdCp"G,cl[@QJb3L9-rYE-SR[*lQh$He
kEE(`QiqNqR#64jGdrPJpd#QE2!kd4rXVQ2[UZShGkTk!216ad6q[+`*QPmFq*$U
@4lmm92,JSG(lMmQMcDbFafPpAl3"DZGD`'NH(hdJ8aXMHC(dRL2[d$C#l8F1"6&
[k28#j'(H+0arfYpCA6TY56FR)!q1HDchcdm,Yc,Zk0N!lFIr`ELPXPda6M$ZhMb
m!BalmH6"iS8ilFm-,ah2"h2[UHS*jMkBaa(Q2TM(%HCq-)r$c(dJMambpq"c[c+
D!m$FZq[a-(2[,HaajMk3!-F4jYkGaN2-I5#2IZBq50YG(QhZm[0plreJh$a%[(4
1-1kH2$LH!-BYDmM2(L[feiHhRq`h'C2NX4mCMM+Q`6b1-*f$H4aQ1J0j(%AblM`
H3[+"22T"6r)`kqF(%-+m"Vr[4"1*[Jk42,BZ(MfIKca2I$#2E1AVbpmcP8VT`$I
JVqFmL(LbZTp12*L([,L`2`pj'@"Elb%!h4fpcPh+#DMV5Fi3FZPq6RiXM`(Nl1q
cX$pfE,ACJfG)q[LA2S`CRNiIl`lZ+McfeQHQ8*dR0iAkh'XfTSpHJ$`Dr6Jf3)`
!5%mHJ[A80A9q6QkQKPk!HTKTRaFJ$cIYfjI(X@RIKU6YQe1XabD2far'qi@&cf+
[[hfdF1mp(A1LF0plhhMUC1(G,a5Bb-V0QJ$r@`Vh[I2U`VdI)*lQFB1kU,FHKrT
-TbbYR@IlP5Q,!D+q2(JdCNT[kccCpfE+iJAS9c0Pm3,N`E&`P[TfA8dHdKkT2qk
2Cr+Dc2f8)DK8UMN!Mj&J@HB!p8KGP6qKI'LFZr2L@a4FMqdlKX0i!I*BG$4D'Z&
qT+k`8Rq&CR(IkH4#KC2M3Sre4ii,2GD[rS#*Xq&#*r%$"&lPG5iUF!l9e6maZHB
SThUdVLD2rZIF(XTM31+9qP2jEaU[IHFBdr%VDEa1(Xq5aQYECiZG$Y698k!91hN
m)&UaEJ"j5#[@Jp5q!+eBp"+kVL"9q42-h92"6,d!b1PA3+T$Cr"j6[k2QBl(C92
1[Z-KQ-AiJ6EPR$bHT8djafBaABRi#'Ba"f,SaThpalqeF@G!rTrDRPHKrcr#i2`
EH`51-UrZ2"jQAVd&1Fkm"[,`6Za(1-DmZK,a#qaCX(R)UrMl$NR)6P*,#[VLq!%
BJFR$+l(h`6kbD-RFA(h6UA,rr1%ce3SZe4-EaC!!R5R26[1mPE6pVlAriqcrH2X
r3ImmjdMYNqcr42YId8qZiR++[6P-3Q`Q,hPG5jf0RqR(5@q[0reG2*XTA#XY6X-
951TABImVE@"MPhpMPi6UlEmVd%Ml2dVr2"P'r`2lAflpapMrXITR$Aj8N!#blEA
e1((E6a4NU#e%P3fFXBQE4-4[Q2f[XAkZFdc&jGm85[a0CdN"6B%NMLQ!f%If#e$
j23ZZShlBFVBT6$%PPXP9FTVDMePp06LhY4[aMYf'kl6paVb%-@VYb6Di+C!!r$Z
lD@(jGi8aR5Ir$6EZ&0XKpG[0SimqHZC1,rc1hC[fdYhlEU,m'dE'jp5p@F2A"J1
GH+"[@[()[@'N,RIZ$52e1IK[e[$2[A('0rH'N6'jFfmB-@pUmk`erpl6L`*q1(c
Bqp$*R,UYFZ1&IMjlG9[lLkVmp5rd1i9H8,Fj0C1rrS9q4[hU@@[q[FIATfk,ED*
aLhIEpldab@0kG)1Qcq9iiG5-jKbH*ZbeC9!aH)Lk5PS+Dq93jL0)RD36&)+01,`
G,cZ))aYK8brUaC%0YVPcDcp1*EreJcLSj%HGLa2RRH&hc+!q@Al(RXXReBp6cHq
i3Gl$q*ei,Nj&2mj`INF-kP2$EmdJ$J[*D`Ga4[,lp+IV'1(!+(i[(-3CcHp&JcK
er$BqACmS6MfrQ8'F-Ia@$H,)+m058ldiAD4"[-Ea1hm3Ccbre`rbRX$[KN'FLIb
f$Z*-iRI6S$k6qIfYAKcca--34k-i[%IS"B1mTr*leb$1DIcHF3i(`L*)R'Rm[Zp
#2MRJ#PA[qimr0)i2)&&@b33T55lV,DiEb-ThGU,9)5,mpFbY$KQ91lFkC24hh!Z
V3pbU#(rFkK$hd!Trh1S3XeV)XpEmHimI$J85,5)R5&@)[TqcZK%RcYC6Y6`)*dJ
Ih21,NfE405*V2d!pr"B(3E`AKJheYB"c09,'[%4BM$iD*QQD*,K8ba[bHZV5B9'
!RVi0'QPHU%D[H@(kEI51dYc8p)lLMUQ*qJ5r,H95I8I15JGB)2C-(0N[!(VYh93
5EZk3!$J3VVfE5Z)iE!cCZ`QN["m(!0flb5+Z$jXf"MG25"`fE3aZRT!!1'c3k0P
m%X9KJmDdFh(#$4$La3D0RSdQ84`fD!aZq"![0QM-'F4KJmETJrU`3@2[*T!!Z#r
BS,&h%dJFK`dDHcGha((BS,&hFdFFC`UrHcGha('BF6hq`XB,LF-'MEfE0Z*m6ZG
hF00'Q+"hGB1'eb%15cF)Nm0J1aBpii%A[qeMaZc0HpRkjhXj)qf'XaJACMc`iTq
qrr6T4cqHkiB,Nqem+XD&@3pmhiX@6TrqT1BDrVD6KN3@F'(G!bpqqbZ01AarVKX
ZV!)8Q$2%Z(!&I'((kG0[eUC)Ip[CbR!K0c#fZ2$,c*efRMlpTAbh$HYhkLQlAEM
`)ZPG[(FRI+l"HH1h2IeXEHrTDCbT!(j[VRRYMZr@9r0FRfXJLr)VR*'`qrp@69c
%Q91YcJ)UYac4bmj2([)*MFX,GaHZ',VME)3J&b$,j1cCBH)$1Tk)(5E5b0Rd95S
0FrmAid*m-c,!HE2lMc4A[9Be#SmZe+SPFhQQkAd%-8bRq"hDa9mc013YmrhX+'B
rbNaNTHE+Kh)3DK2dHG)`#cp$QH[TCYrTIb"-lB@T)GaXkL%#f`S3RU"#KaXK@N,
SL%J&V1"j&826[2A*%h*('dMm"4Ah)'!jG8rrlbH)r1cK4$QYMmIY00I+deH9Jm5
0!MFT6UpeI*CVRKM$,h5cX02G06hahmYfdZD&fc-T4dZeG%l+-5&MTiqGDlMRG$T
q2N!HcCACb3YaC2&d3lQYcH48YLY'Fh9f*LFJMa@PUAb!ZLkTcCr,m(JHbkD2e%F
@9d`cMKmhK5qr`3`Il,(Gc(Y5fec(pm-`+"j`rFiCeq#aRaa0rercL0+`HDap,Yr
QK@*T9fRRcMrX$TI(NhEQ"H4aS#!rb#-Xqbrbf*r)X6b%LU9fRGLApHXpMkfFrYe
p3l+2rJb6NYh[0I2Z#I0R'$TNpVF88h`rbEeYD0GVLiAII#5G2jXmqYH*$05$)Bc
*id"lN!"(La-h(IrC`YSmeX4j!AQXhDVX3&dCUlNmpL(4X6ckU6EY1R"-(QeQj6a
15aRQa'f6!V9c,H'dl&SI6,MrV#c0AH4$a&M`G8Dd,QafRkm&KGdH4epR(iIcD&[
a&br%DCQq8&A*BdFh*b!2cR5Dj*'kYR!VFqm9BBl2r@$Z8YQZ'#HBHfmHhJ$Q[RM
bi-@9aFh9KB[em(a-!(UUHQ)#-*M(N3R!B"j(*J!(mcJm!4M)Bf!#`0%*32#jAaR
0!CJ!G0IMi3P!Ef'26`!'mMJb!HK1ik%*`%!Hr4-!b@0`#'!R!1ZARqpll`IM2Qr
mR)$k"12ZbB2M#@$F+laJceKaEIcQFi`lqdh'*(RX4iDMM'N`Mb0-jf!HKjR13"j
(NE`lMiH3!(`JMhl3NcbNl`mbmqQqYi9@d85LVd-NMkf,4mrRXAMak-8mXT@Rj4a
k-T9+kF!hi+rR2)KiM9NR(XaMdh0F8I,Bj-4aXF568Z3K)BALKKfpcPh+#DMV5Fi
3FZQ65cjcR,`I1I[l,1b2(9YYpZ!CFY!jjTc(Q1(Tp2(Zi+l#BfppCJV9HA*6U-q
pCQ2kk!A)Sp'2B`2%#)$dj#&B6ee6jqIYCQVS"DL(QICj!I*`dljpH4bEpQe)fVi
jaCCrmVMpBEaI@2JXp[VE4`[hhY-aVbrFGrreTdi@h[e#JBNX!Dm*m,qPF0r2IU*
`l`H)ThRFS#lUVFHK2Y-T5f[RfAjPa'+!U#q29H9UdBbFf-VM8$h-P-8,d+pQbZ)
&b)0Mi5celEUD2+3p8RrF(mm-JqGNT%'P8Xd"f"3PiRMEmI[SlBMm#H9$ipbG&jF
%Z4lEG`b(m3,NXHKSY$6#r8KGBDAq#ZhM[Y2*K3SRai8HkimF&hUXArd"QM2$K8l
L"`LmbZYF91!FUUYrBR,088leD&e0(R#UNrdaZ'I2rk(1pJ"T[2DGBdc(Vk6a1RN
m5aU[ECdYGMT39aq"@PbdBLH2"d3VeJdJ$fR&HT!!fKHJ&BXI0&ik9IN6c0e6`8b
p!-MT9d#U3fGJiBl2Dq21[Z-KQ-AiJ6EZR$bHTBdlafBaABPi#6Ehl$qkZ@Irm@p
Yh"Q3!2qRYZG9k2q2-$MraKk"SmbV1iq(Q9G[3BicVi%m["2l%BiaVkj%r!*l&Q`
HklIkM#6NMD'@&26&m3-`!T1(9f,[JipMSbHL+Ur14Xmc-iAfNR3,T$QC!fr5EdR
Krl8[TVEJCqjkKrip622&[RjPd13DYU0IApRV9erA4XqH[LpYp1c%DArp4NqI`J6
!$k6flTm!&(FA26)"m%YYp$cCpkHd$"XpllhZ8l$9ARDljm6X0T`qHJ(bL$CkpZ4
4fPcB2K8c8d-[3$h-Y-m,N!"(Z0'c,ipMdckcaDlTlYj'6a'*VF3Z'ch69ldUYGI
m`Za$3m9((X2%4Xm(m2rBd+l,r+'V6U8E(R0El(VVFDM2SSfH2AQ80RUfja&Yp(b
d(QE+iJAS9c0Pm3,N`G(YFir@eH4K0hSqQXFTSXe'6pj,QdjI"&Z"6UmX(qlPeB$
"pcRS0JdHc0l,YX#C)k0lfdicP`dF("l)ElQiJPH1(`4k,,,Ciq"eIDhrXP8fpfe
bRGJY6RBp[lF,aDG##$a`R0#F0#01`3,cH9r1k"fPZDRT(F8G8a2e#AjEbUAkMTb
9$[$!3%$qb"[PHEKlj9$@&`+4q3B*JSdiFU@Z'-4KG$pf)dkPAN-IR[*q((3VM8r
R%p9R*,rcHR'khKN[F8Ea1hm3TilI+mr9*bb#a+RRpkT"R$(mVYk)8r9%R&[lF@6
*A1SeJcMMq-d-qQ)m[e@$1"2i[Ai3Cb+r'`Ca*[(E1SJcQGr(RiX6pmm8IZmDj$1
9hcYkFI+i8SK('MSFhRrme(&mdqqclq[AdQY1S[HDKRQFkMZmcljr!Y$l%Z9rR`$
iTPjcmQMIRp)b[1E%dr8qqrJe*qR,RhM0bHH'GRhdM8qpjZ5$,rrpejbFNZQmccl
$eXqdhZ53!2SZ0[@1cel[FEdEZ*'AcrCb$dldHJr2h1YHj,Iml1YHI'im!6`3[PL
A,rID'm'$q[5e0eD`Y,6EdHaKpJ(ADEP4R+F'$0&VEqcVIr*i)11Yl8lNZ6PUL"$
K38@'"qZ6+$cZ4UYaXCBi3FZ*@JJN3)AGHbZef@*TVr'#2$0dL2MLf,2cJl@Xk9Z
6j+q0%#)m''2aS$Q-h"N@0VB9GirF1(*VhKSL4(J`,KrQC8#HQ11,3`&c)Rj3dhq
0B(NZrQX%blic6AL0S(Q#B-1%R`1`qX[IFIaaVa'XJ"PkBHE-@6TKc8MB2Em,TIp
Fa,&,#B164l62jH3KRp#i[("hiBUK1mj'#()"XX`Rp1qHFRihG3G)JX+P2(42IJG
6CE'3!*kZTr(pX#"lEI+3!%$Vd(EK(Ai5"mGIZ4!Rc0,VrCilcdUFMTFS$U6Na6Q
V'h(LE+e0mb!F'H*EN[e)2jXkqKf+LC!!c8pcH0jSrc3URMECQcGRV(`S"k%f3Am
ZjCGlbUa26V4qURf"!rE&iUpL63RRe9B6mTTd2Ar+r#fV$ReGqYlcP(Q(4BhA@rm
h@2[llImEVGqET1L9mfEchHRr@fcmYeT&e$YXARGE[hIDq2ICrhIC20jYkh'2MA1
[M4Y+AX2M2l!G%+4bUQ`2aA(M$&KNrSZ6rRe&f8p2Zr$mH+hcPI46D0Mp-qc'Yb!
2pkQG6YCck(MPPLYkEdkGj@Yq,*EYEcQqAMER*jc(F6bpE-cp'f)@K4#MM`C2r4G
E+`rcjG`4Y4Re(&a!+(&`(&aS+(%3DVhX1fU%KBD1cch)Pc`%aqFlX[+rR9-NK''
r*qli`PFfH!2U'YAAamHJ[3ALGep&QrhN95G'4*Kb4Nji13"[!2HGR&APD[(Ja#X
RG0IdhrQib$RQ&'X[QbrH8"KphlX,Sd[l$Xm9j`qXQ'Z,0Ih0hA(0+dcKd!H0HHN
RYPpcd#`A$mpYYQ9VdRBk&5G1H*j6q9SRM-e`[HNh*TC`D'bhc("eFUlM"P-cYI@
JDBCVEU+hc$GjE5mKKGU4qQTMbPhb!VI8MH)`-YZUITL8Qf'!Em[N!H)Y+!G,B4U
p22D#-6-FZ8Nh#Ya@IEhMmVLdQH02eE4mhpMZ8@UaX9&eSYLGL*D2+GDCirc0'Yp
MKJ2hq+blP*5$PVY'R*6IU2)FjIA4-CHkC2b`ZGTB#Q+c[HfX9F+@Yq5jdB,A5PD
S5f-B,(R,hFLGl#B*P4UV+MBk`6%RRSUFimkLljE#-'V&CK[4jkiR2(-j%r[1-EH
D81('bUa([f`afmU%h$5r(*LVb8!HibQ*lA+MT,ikIF`0NV5fTPjRhX6I@E[6[eN
hmMGMpflpc4T0DcSVVDRi,I9DVVPDr6H[PN4HX%cl0,R"-P8cA6QIG(Qp)4@@pc`
fKYddbaQh+TZCilG5KkA0+26p45HDD#CH'&3MRYC-"Fj,Xjk4eJ(E@EHU'V2'Ec,
$8elFmChek5#*eXf`mQYfNZE+r[+-ZET@RMYmK#VXl06GYB3(2Dm,Mj[KfFTq0b(
6bhMHFfTiRRHScR-5YqkeA62FD#bl551KYeYE3SKV8i4CcHpU@NT3*Y-PLB@*fcE
ED2J9@CpYSTARYjEG685CQdC1E9YF$0I51YDU"k3Bm[jQ5AbRRjKYmPJ3Z5i2N[E
%6Hk%1PFIQMXd8CNHQ6ibr3Fac22Pc)C4qG(rMUF2qH(3a%Hac0BRJ'qqNq1I3Hq
dqDld0AElHkDj8Xd"H+-Gi'0Q8[ZHI$FLHe6-BqFDEQC4IS!m'ZIZA,d34ej&6f(
hafMdikdAd4r0Bp(4D'Q%qj'k-P"ZALK0j32daj,DFkr"2jU(H6AqY9Z2kNp01Vi
IKN(aJ1Xr-a-fH@a)f[qrqHN2NmF0chAMSAieHI4Mja,ha-@D-1Ap"Ak!`+ZmcXc
cHA$NBIilm`(kIRXFIIZ&rbi2c[5Qlja(f80e0ARdD`i1j@%IB0hh`X8*q40-TlN
b1hNKMM`CZU(FeTZb+@ehj9YQ,b,-JhPi!aM+iXQ$ra-j@aBZeX06`A6kX913!+T
a9fRRcMqXUX[M56[c![)i8*!!(q4a326c`c`'N!$mF"lVeh)!9%L@Q6l@Vb%clDq
'j0(La%h(IlD`0Sme@e1*(q5aGUZb!hAPr9JZMhe)p)-mYQfadi'kKRPi!CLlbD2
0AAiH2r`6M,YYa9qm%+GPHZBLVfT,ZMN"HA#Qdb52e,9&f'#BHl-ES6NURDVm#HE
ZU@#QAJ$Np#XJeD&MND'P@XS[QHP)DEXVIhbQdjZ(hf6UI(3@dp-G*fBaJhNFQF8
-jR&N&R-`Mm1cQ)%mr!ZcQ1jk2$b,k5hXm9R-3"j(CM(GD6`dLaR-iqJXTLX4(m%
XjN!-UF+FZ2eFM*@PZBYmL"MKe++l4l`I-jdH)$SadqP$I&r!6-F2Z,%PpB,jZER
kTP2Pr[R$+ES3S(c"Lm@lXM2Pf@PYGY(r1[YIErr(f2rapRqDrCpSrbIBrr*qFK@
A-ecC(#BKYV6eVl,rQAkFY2BJ2,@qbRcUfXL*2(B`T-b9#L6eUl$rP6D`XFZrXFX
MGNb"j0m9CUcp(kGr&VrV[bQXr*IVAjiPC3SUrbDHL)VVqJ8TfejECb('jLF+-Y3
@`PA3G8bep4YQrfYX38`"*%(65I*[#LAqY6EZ+2Xrf[k2l"HJmRX@A%IpX19X8lJ
Z-VR+rfRpQ09AXd0LDcGUZR(a1ZE0'iZPN!$Y'eSS+8L$$@S+*2q6lImNqqm+BcT
2rPfmUEC$k[XEID52KRrNi6m#Se-I$,@%,2-lHkbi0RlcdmbppTX-6K,CMc"('Ga
J(NFBh'!H4aMF`6`1-lL"2)ibVqim(QCH[38jcV`'mMM#[,V6H)Kj$HCaP(Pe*C*
MAS-i*!"lB#*Mmc"+KCj$%U*3X+5J,iiR3$p&(TZm,CB56E6k%%hbf,Tip(`HXX2
cB"jq3$fArR[km#0Y,[Y1U'9ViZ!HJ'%j5hX!eVRIeUq&HAJ%pJPi*r6lAJ$G2FG
6STFrf&fR(![EQcdTlm[c5'kTPS4-ChJNYP4,!Ga@kTpYUIl+*ST8hI2AcQ6Zdm&
MRpea,`P0QaGZ[b#3!24-k#0C#Z(2d8HZMH048rMb'hJ)ilU0!*N$Ep*[Tcibq+p
I6'h"cpce$[elQ254IIh+J0SeE%Hr[V,AVriNAB*23%q`i6a1UjkJZqmMR0l4c!(
J9[iYAB)bppje9H2chlC9H4BQ!(kJE9Ap%`#cLG-I-!(`rfbVkTm!5"k$3i"`bp6
*[[H!E*RUhYEkd*DT[Uf[RJ$'2E#5)*YAXC(!1l&*`&qLh2G++1kcP@IfAGQ6U94
+"li"IchR3F4Vc$VaB"kERZ1+NJIEBN9VYVR$Fk!,a3dlfKq`Uq)NC`LjG$mR2jE
(!(,fpeRB(cXZVV8H2%-ZV!8IRNiIllhZ8l$9ARDljm6X0T`qHJ(b-0ZmlEVKRMc
FPZ"pmhBc0I3#e-0-ql`!HEKThlimMNhlc"EZTVZc2'j2A`D92S+pr[E4SDYHPGT
VIQ(fSD(L)ipK'S[e!I`r0V6V-RrSUP1M'hQB,Gbpp6M8CcTPDHdmfkq-@(UR)cB
2Xi@EpG!Rqpj-@E`!r@UQ,&k!2$Lk2I[4ZTSmT$hf6D%1jA&+f2)LJ90"K*F*RS,
6[!cZc[IV96HEiq4*&$pp2lZ&m@ZIR&9MVj!!hjDcIX%B2dr!Vr@XhrSe(Y1NqCA
pHXq[KMbb0VrBEmk2B0ImBVqUPbRjE4&B9leiT4,@[&IaFeVQGm84E2U)VH#er)a
1rE+IP&42AJePr&l-cdZcH%rq#@cbeL91@[NYbZ*pj[2Bj!e0R(,P-62cqrBZE*8
fhVhm$-[ml[NK&FMkCG56CfEjRD'4GmEk[A)M[qUjpf$,CRi6r`ijUYrTrd!eeMk
MPPUrqdjM'f,crM!ril0i9hi)fp$-lq-raU1LILIcQr%lUSh'q``eVmVbq%iC"hU
(ZT+Vj[F[,e&$@VqbIpIVXa9rcm)km6kKf0E[mVq%EB6YbbH6AfAQYiCH6re*'qr
6r&bBjIGje@p8jPG"2*G(kcp@$DcI12SMq%cQpm`hie"Ri`'EYNl9YbQrHZXhHk0
1fCr6MZ3aYXqqS'D`IRF,Zf4(0ZGmqM,ihLb2*6q[K+eI`q2m[#hcHrjI9'pTIXm
6a0SmA[r,f#CNIS[!Pr4`j[H42kX'9Y5@[UV-r+VImYXi6-Vm2V2$Q$drRXAlX$"
cFZChYR+pTCh%UP(dFUTG[d8Hpl@6G')GqFeqZj,FR2KkAeIN9r%apDM%!hGM[`J
[EhXTYLR@lbmfm$,lVe4V9I09#YZdcjkU2H2%P(21HJm[Ee5rNKI`pEBHRJhr$@c
6E(lIk1(PlrqLL)6k`3NYAPDhlm$f5cE[##qIqMHa2Flk4ALjl6jXdNHFTqrTiH9
GQLXp`FDMll9qBrm6YLGD2hLGiZAb"l'GNG'!BHKH(&ifrM!HbM4R[Ri$,kYI,1`
"VmMMQlhmkM9PHSUY+cE&S5q+0dbhZ!JZ+mlG)AbL[q6-Jpmi[$chAkMfeQrX2p[
!bqVbMf-lbq)C[%Vcf#(XabjR#EfVH*Ppacm4S'JmZ)l@k8CaM(1X(kp#FhK!EFl
0r"D)ReLmV*j4E'@+Pp%6$Lp[%rDFRrQGqfXp[(bDHQQQV4piCI'bZUkHRjAjVEK
p!bqVIq`9!M,VpeaiMm2,iFVTJU`[AhJRTIccV+kr*a`P*RK$rc9B[-`p9#kBI)"
H%a`eH*Rc5cdSrV("iQAN0eDii[!bmNY6$pI($ra,!Bhb%RLJmX[P@QGaSI@Edq0
2hrlVf1#!P"I1URJjii[Bk#P5J$FUEYh`0d4dPHH"[iUAIk"DUF*Nl$rUiHAMhSC
0ja0Pm!1(PihL[US!+4H[d2aZ%XqBRrQY!Bm8,l-I%Zr45@Zjm&KaSNNB)AcIe(A
j"PjQhkqkfPG+"0H#T`i[le*ZF%NjP`[2&#r(#[XAf6bSTIE(jcq(6A9QQ9IhF+K
HHqY9i60"[D8ipi5rMDdjme[eKKjHAR`2$Xqdr1Q[HRLj@ENYYRN)IVXmc[clf(6
XXTSqG2ab#$9,rANElmZp2KJR6V2%eJqqSA8Dr4CX5beH2Y$$bbh+@9pEGb9pSRL
CrGAAi8!I!@[`%XA,i+F%V0C[Q[T(qHApiTSV-VmEiEJ1,cIIK30c!$R[B%lMm2)
UB4+F49,q3rV*iH9I[9-0ShApdcjHkZb$H0HrLMaHE2%bjjID+hbka1*Pj$GK%bm
M[d#m5rYMTc$kLXa[S[T0qH@lKA2`A2*J"U"p0N2F8ZV!@DKjK1,PD'UF%Mj!@q#
Q$VIJk+YYI["jLjI9qc5(d(8&%clF`mXcK3fk8##Y'D[&bqc2hip0CfrRhY[$bdR
L#MVEZaeFG(Mjam*)IB["qHTEVGqYiJBUCjbU2"3[2b[1CQHa`8(`V2EZ,0iYRmC
$&DYY`M2&bjGUpU5cdY2kFijCF+D8RD00d,a+qfbLX&pRIY1%'BTc9iKhkPk9(Aq
eKjFAI")(RGqGUrQ4cQ1qV9jA6FDd,r6b@#SZSR1pjp',$LrAIK!(F)&ihql9D6S
cTj5GBCqQ2P(qG,q`P4S#QerE`-[X`qTKR62H5lmkIRQQF%*e*$XeNe1mV0-X6&F
)RII2HrabVIT!P4kr5qmk[(c*Ch(BPIAI"FbE&#qc(eB2hC6"`9$i[-2,Eh`&$fC
+e*9jJF0,R3Pb2X3X+MJcMiRmaURA"4F0ANCq8c8RFhLCm`[Dp0R`plD6j5IRRHq
"qkCIhZl%a)[mJKH!9HQ6eGNi-9Fm)-l2()BqJ!IVR$A1ib2L4C,I0[940!IkJ2M
UakaIa(H[%QkqcIT&Z$j0'2PNkaI9GB+`fIE6b)mURXU$cY0X`2EPb*m9KM,EN91
KZ9KjkMHU)%aRMLTRePm4"PXrJlY`-IU'HD6Qpa,03X"fm*lqe2cq5$@$@j%I[0(
Q0r+ikXUi(`V$[0,Q0h,j)@bh@R`#TfaqSfj5$m%6bIZc[Ibq)'i!VT)IH@Vp6Y-
m8R#EFi9Q-eUrLH+,YpQq!9md[`G8dpXYlX)REAkMlY(F"F`N2c"9krGh`Til-Vr
EQ(qir*CTYN+r8$rUqqTfr08jhh,0EpjVrD,q[N3ikq*&rIddFHjV,-lTM*[)&@r
Ymm+FAr"'c6iG6Z6m8YrrD"rR)Vm,a%'IBA%amTXPRQejdU@r*SbKMb6[Lrl(aPb
KDCGiJ2!AmRl14cE`ZqQ$(m@$[T!!5Sk'%bKq0iep#BpIcr*l(ca5H9A6`m*+Z$2
e!+FXAlRd+jSc-G1JI[!-beHDrZi[BB-MJ'I8aI+KTKm84K"(c[ZC4bZ[DMUNq3H
c#$RcK4H@9c9G*[j"$FQEr$@2*Xdbl,Y#JJEiT,bUk3ja"@DHFXl@h%6Vr3PaCM!
(IX`XbZ*(dffD&6+,N!#qZBFjUI,8TU1D-F&$D6PQJ4CAQMiNr*1q0VJ#Cl+iFZN
A0*H#emZj8RKTqA66Jq*fc*VNR#-FX(bkk3h#ER!Hr+!2YCqq3ZqQ0013!(1kp!2
D6irAE25eQGm(rq-'rf[kJBpMHeh@"h2JrmVrQLD%PIS@N[XdClImVqRKIiU0@C!
!R)[9RpS(MhXAYMGNHDa$!k(mVfQrCQ&[Y(e$2RB1dI3*p6'i*1ITQS2EqM8G&"k
6Lq4aM@EBGJl40+VC!I0!q"pc1Zfc-F+kYfCq9`Yh(Ej'1$G1q&%,2i0[42aTZ@D
h,Pl1,qh#h892Bh&AY5@FAH,6c$A"hFM[I-fM(8q0r-i92h"i(2RCShJFq5h6,0c
LFGd4p6"F4[VJkf"-jEl-EiGQQQr2r,j$24@2khj%'J!d,&+r,i26ipqAqShqEkS
*XhU*Gbdk$FAM1NFpq8k,Pq#6lEqkpkZAhQAVbZc"iNIG1c9A3hY#(dYqLU0e(p@
mQCQHT2DVRpV!ilU1Y!ISFH6FVlTB2+jcKA0`$HS0Mp%mVTB02LXT2!pm96bZHjY
Q+$*2jX`@RpCkIdSi"cqPIRqjJ80e[k8CfhXc[ip4Qr*bj[Gac9MIPrP9DKjNmEM
Z"Xh&hjrPIC[UDr'iVLTXT4r"1HCB&SrVlT)1!ji)EU'VXAKFYbJZbR`B2XSl2E@
ICUJfD$6S*rLapP-JMS*@52+qAAK[mEMZTc@M!CI`S`mX(YH0r"XmU)1i2&rj@6b
ZHi[Q*Fb3!((reeiI[&#B$GF32%M$&4524rphB4(p$Km&HkSY,NBiG,9`fH&LcLr
pC[K9L)ZUVF,[9H*G$KGcIUQkCX`1&b-r-mChZ"Mj*EJBqHf5EX(LBR#AY%EJMq4
p'IfJZ"MXdC`$6LTq9i)0LSY"U0NVR%9ikXA-)"8AJjXdXd1R)r(@`Pm9&i2ADMi
(*j+c4[01fmI"EH)kc%$!)A+bI4am6(`&cJK[imIL@A"5mG$D5(lVd'8T,JBh5!I
'h!`H$rqdZ*K1Z3hB4EfCDfXH&f[q`AaEmVJ"AU+i'1`8TP)Vm1RV'lJBZ1)aJX1
'rk'RXRJ3I&SD(QDHNX+Gk"B8&i-(0CXcEaL5PX[0Ki*E0!Z'JdZm&iL[@e`-lP"
IJYAd!Ac)iQ,`frmH'pSC1G18KmA&`"2Q`TIPh0kET`DIeq`6h42eCKk[rI4qB4J
c++Rh*[@caF9J@RaAG(2iE@CHSlJBI&MD'1C&iVG&20ELBT!!3ZKrYr9MpUapm'P
a#6"CiQe&Ak'i'(br-"f-TAl`lAU,La%1I95FrM-@&b2mZj&q6@p,mdMG+jj0[S)
hYG5PE#ccZdmc"HBc8SpKQP0D2%Zp@M9$hbGq8jM(Z$aq6Ah$l%*FEQG@j2*iMfC
5[$0*iNd9PQJH@k9jS!I&lca`aqAa@68#-aCaZBYqGRRFUAMJXm5EU6lA20iNENB
rLYm9B)R,ik[#V#pQHEb%QE(,ibE&BjiJmHD)afXHIkCH3I-PmCB`Gh"j$*FQaXj
)dfq(2lNmCQRQcXaFmTLV1E,Qd5)0)A-!LIFIQ'1k2&V9Jmb[a1Aem#UAa`Z%CID
GY'QhhfF9kJ2QkZ,hA,LAbf1ajYr-BF6PVI5Fbk0"@Lbd6Z3"$pFmAUIj&YS(S!Q
q-lV0pT5%`+4IThRCKpV1NaYZdQpLEK9NZSHb0bVf2f@1(a#AACEj[85F")i-R@4
1qCZChjh#'rTGmLKRrKKXcrbHVYjJRLpqGm2hA(ila#@S&I@MefeqkFqUYq!,i[F
#e9McZd9D#,4#i[G1kU[jT8q,hc#E&Em[SB0bq6e(Xi&[CAi[dLa6khHljMTJZ2L
p6$a6meXJ65Qc,2(l1qDJVRlc0GH"`iVIha2EjGHSfR`hmc0M"mh[I[%mqJ8rkQV
c5hp+qD&R%EprN!"13[-,Q-dj@I*DCVFZ[eh`$hhaDp!5pQKqVf!f(f3cfr3Tm5A
0ld[-2i*XCTYq269`rI&9CP&"0MY+[j2jZ-Z[R2PkB'G3p`Yh0,rCc'+#M&-(5q+
(fKq6dpQ-cH-$F"fAhjr!ii0-Vjcq*I@0c5rpAqMM)0-VThp8@+,pr8fdI%'Q9dk
r4cLVq@e8rDaH1Ih,c1PFITp#maPNHZAdMm*[daRrbei*T`QXA[Nqm6$,Nc*r!Fi
8@,hb4k8h8Vrh`UX#UeIqU,4Vk[GpD9qXAMPi'IPSITPAdeZ"e5Z2&CI9H,m"C`f
XA[PM`RlVPcd!*``b[A*`VH*U[(pN*K4NHZ9JA2a*mrYRH%#3!1Q9Jlh#FBhhD[!
eb26+`9lKNI-6V953!1Q9Jap8(kVI"MK-N!$TPB0Ad5FZ[lI$YB*-Vaa-D$kKmEl
&l#6)p-V"K'E5kVF'c8b3!1Q9J`PTFE5ZSkKTN!$TPG0eCJ!Z[lq&P`HCAMQBe(a
FmlJ*,K*NHZ9J8Ma9rEk(TM$)p-6"T'Cik[IA`JbV*dir!*peqAf2RJNb2A(kC$q
2lk+4#c)pFITN,irXPA$A)0-6Tdq+3kZHE#Lce5$6%kG2LXpEITrj#HB@3DBR6Tm
8Vp-m+U90Y(VLp%Ra%c[Ic4`@APSpFIS$dKICq@lQF@)EA4Yq-Zpaq(3KXlmJda1
R6dQrSI@l9reYpF6T8jVlUpr,Q6d%QCiiI8UF@q[(cTdJda1Rrl)iNpE[ZI4-N!$
TLG1Ra'-dMdmb)`Jb2A(k(fS1CHZAIBNd59C2R(j3[%6VpeSiAT!!kSRr(`#3!aJ
F!!!"!*!$9hS!!&Ck!!!#HQpX1`d*#@Cc,R"KFNP%)$dJ+Q4TFMX0#3P1B@eP3fp
`%M3Z-#"6C@aQ,89iG(*KBh4[FR)#!*!$39"36$q3"!!!39"36$q3"#!!rj!%!*!
5V2Ep&3#3"PRd#3N0#3NUGQpX)$dJCR-ZGP*PCNjeE6X0#3NUC'Pb)$dJCR-ZF'&
b583l$3N*6Q&YC80[F(NSCR-ZEQ&YC5aZB@eP+6X0#3N0#3NUGf&c4QpXC'9b3@a
TBA-J25"TFdC[E'4PFMX0#3N0#3PbCA4eFQiJFQ9cG@ad1`d*I3d*$3NUG`!!!SK
"4%05!`!$+!eG#q'@`$CY$mNlVhhP@pr8UY9@@qQeqQ59A*IS&5UY@KfIC'[9b9N
L1%$*L*aNZNNRV6M!GmlA#r`$YJQbidVkSf9Q5X31HhLX@9Q%+la1-l)V&YTbfT2
cF+)hk@)j'9-fQ8lL4QLa[HJBES2G[9PVC$GXp4)p3Nl$!MZG6Z8$B&mlN!!1jLS
ia2IA)MN&Lqd-1T12JV2m5$eDcXEMr9!p6%l!`qeB1SiA`RCr31qAEAL(lD5YI#I
FEE0T$Ym&mref[8dfie-fM@Cb0*ca"IU-c-$TrS3q+92a(TY,mlJHRV8He$d+VMC
iZCiMkh'(jr4"fB,hf8EDa2G#ArpA(jFqq,4eT@lm+1aYqe"[rKhfmefd@Jl#)Ak
VPXTir0iQdJ6q((kf865DIi)aAUNrb#4FBqfT(Im)RI`Vr9Ski%KIVDZN-kkeX65
1ed%A@dV,q$Yiarr@[q3pI0rrdelb(2j[(p#lr!pmkVAkTAb#hpJ5QXAI3MrlQ$l
M"ZMT+r8,kBMRf3[d#Pm%VrV&HU'mM)2m4Ve&"Z-0pK&pb0I$#,p+VjCKH+e0SD&
m(GaN!fNiA`2pr@BYN`(iQPqLPmVVH,Qp5@ra&A#q[8M2mlR`NPqJPmNE8IVd*rh
"Mm(EIU8q*,rJVrk`2L+r)4U6-%!8@H3DeYBQ9*C')qXiPmXP8r6f--@@XC494DP
M,dYl1NjRdUPd9AT"fQVb6GQ@ZNC[,P`FYf95CS@YE9'2PG8N3%!6`V0,*U'm,U'
i-+%T8"3S#,5&mX*`U!k(qY"@%QKY6Zkd0LAVNTD)1NNfM!-T53UC3$lmXN#fiP*
S5`8bJHD+$`8X(lEdE%)fN!#*%q*m3Ne5"J#3!bp"4%05!`!!9Je,!jhS"PrE"E9
`#`$!,IqU&`!!d&Z,@RJ"SHEr!eL&(XF[PfEk(!#3"LHr384$8J-!2r)293ef4J%
3-H2RBhqEFikab$+@e4UMAi`9SqlR0i4,$B`jKmkaHS`4NpKF'Vi3XK&`XJ-*cm[
e%T-5-B3JcH'PA*)Qa[D&b3NF5lNdemIMd9a+1G6(0C4,+BHQK'1)Y8!Ti!"ahrI
llqrljQB1[Hflprhm"aZNTbK"%#4"%Mb4!A`#Q[HMPZJe$V'B6iBr'1Yb(r0'lR+
63eqBK'k*JTVe`GLNZkY$V&"$8-"+B,,MA9!T8)4+K1*F9Gp@SHGGER'D90K*j)V
m4%l1aiIPRJT'qXZfLRX1S0!J&4Cdr$P@`T!!9JX&)MSSQ*ZU5FPbfmUAe(j0UZU
JMXGVIl"lVkK0&2"ilSEK%KSff'Yr%'6H))528Q+P-HTJD&J,dd*I1dqZ+AUr9q0
rcq8$iYLYZR9VZlMrXX[pTmpVH(+'5mR8V90,hFXHVX'53*ITXRk'5eFkYlq[Lj[
8,)&K64G2[YrYrKphmI'qINjhApDdhAf2[H6LrTGfFp0,h6cCmHIk!m&Cd,!kVH[
Zq,3AeiV@jNiH9cYbEq(RYG%T$5Cllk`1*0mjKDP$QqCIYQeDG,PAQ$lCcq0pS8d
0TffE[McYFLpp!)2U91+a4&&MVcVe*J4k['"@3M,NBJ0*0Y@UU3jeDR#5@fYc3mI
&'K+qFhd'1ahQ5&fpaaFUEjc+X)mD9S2Gk,BG@kC1M8rb1*C%hIQLD0L#$KcXSZq
-(PH'UYJqfcjElImGT3YeUTYal509jUJ)JG,@d62eaNYM%beZA$*Y4()bSN+i$cC
1@@MliV3)`Y8AShV$II54MY3@DmCKX1a-C''DNKqc)$YS`GfIBX&!d),(rZd#XBa
3dAXq##'2-S5%-P(l0Eh51V&'V2(@`P4BbNZpA`Q$2-CMhJB8,0cLr8SLGY6pD'P
+h)hS)#aUM*&HRV3hia9eMNAE)FcXX(ZqX3Y'`KJGdQ#5a#cabN5'-J@Q8RX5Vb+
R1`bN0YdP)jIMkBDl-#bA0YaeENY[(NaLHUd%j)(DVl(Y4p@*b#3AqHYf+b@AL@+
"D-dlJPN3bH3bFCm%S'c)%f8hrH6c[$3l)0i"a82H$S0+6BIl*K+R1MiCB-+f#`F
lLaJDE[,KqjCeFhI`m8I$B@E1LDC,BA+2EAYppjjM5dHce)kK8VG"L4RdXIUImdC
piNh1Gklk@GY([a(hIM4G,'2-$iq1Xd4#bPM5C#jTXVb"$2YB#M"#@X2UfXm0Uh'
8Md"BR5PFZ3V3V$3eDZ%8+R5@D6LDYEJc(!ea[lECENf(Y+V3bE8DIL&$-AB"FE4
Ufjlb)cN'pYUU3C-F(JmfV%+9LAD#l$9,J@@$5a[TkYHU'lUebEBpfXSZYpC%#ae
EFa3dCM$N5j2G1iV*dU@$IN*jRrj#KRfTm-NVh6CYTI$4QCFL3J5*F"035NEUaZT
mHQUDlF8p,M5K*Iq["3M"3(`C$'R4T)mpFShhZ+Bb&#k1%2Vc!i%VCI'eZ&)lABQ
RNi-`r)SH"U*'q13'"L,lH+fPDXTq6'R66VhaZ"LB4J+56E3cX"f'aF,Kj"K9(!C
%m,Kc+"(5aKU`SFl-$3@L5)GBIL6hBb@bS9IiF*KbP-!@YMp#fq6F&pL3!$4$0!3
9BYaUq")K"JS[V&Fl(0r,85D29k%4Bb-'bL))L1$efJ4ANAb"l1Y,Ac[1KhjBJ%`
8%JLm9Z"ilY9#hJG#``bEM+#@+h!LJkVhM523LpMl$[i!i%ViY8i`X41AAmlD
!l,Ibq,-mY)@4h8*JpURI)D+8Q#*"qMi5)Kkd&5b3!!$NLP!B#NUb%4R4-SKJaUV
G)dmK2&0%T-AE$P1iK)DIHEj`IG@`iLLY'ZkV'[Bjr+RKm`%5kae&9F-"%Q11C09
`J%38QqP!TT5f8Yk260!A&Y6jCN1H,"[QLrRiZAB3`)Z2Y1d9pb1`GF0KK0*h%Tq
&MN51XSEENiP5#+4$d6$hLf886X'R"m+BY$$8+lk$j#HE,GND@')j#Q(YKRaJ-Lb
Ha$3ar(MBNNb`qKfUN!$4,#h8#A)H%"N,GBYpV(X,%3,TpD2qG#4GLU30fFbmK03
9#emp((,,K`cIU[e+DL#bdT&a*-SMGGECIH0M+lLPpLYIpi@-5pabdf"2k``Mh4h
HT`mHPfZZ8CK[$69q0$LBj@eQD-!Y+L'")pTiBP3IqAID0+HRFl2D2pbrqimmVN2
i`VhmrMYc(e#-lCY9el#,KYI5m*rZrhV'!cM-Shrp$855T86DeG2['RcPCY3l2R4
FMGX4990l3K2bAN0BhJ2@-PbB(lc*rA+&-MU8*r,qS`2*K,8K6kj`0Mq,F,1mjq!
CET,h+mBHX!q!AHe2K18b*+2q5l0p)'2[T)N)c-'`[&qDb%-IkE#mYqUiR%#!CK9
$$I2P!hBeNXIeXPaBVqE*Kd"3GLql2l[aj,"qH,km&e2*q$Nkm,RU3ZG40KNAYkA
3[DGhCCjFFiR,bc(&SG3808pU,YCHTU5CL1BqKC!!V*3mb9F)fG#3!*,4h'-`8X-
m#$AEXTF5++H#6B9K'jXATm$P)!A!kLc[VH8)fK,DaTap%4F#6pYm4QHB,GD*#(a
C'YMbeZdZ9pCbPRJ9BBXRFG$[18`K[6c[S%Xql3E`e1"E!%*c5pYHZ3B)G!+&4eK
bRbGrBSFJU63EYS!e&eQhb2Z$c(($I2N%,5I'h)qKaTl3M4Zf!1RXKY9%%X3QD[q
U'5I8UreU-+[f0&1U*LBk`*c,!VqFRm6(2rL1Sd%TTS$Zd0RE('aSjTq1qMkdha3
q)M8,2mblS&ST-16dZ-q3!-S$C&k%j-kU,Z*q+"NDZ!9%Shl1R6$ea[ac)+l(-04
iI8MIAmEMM[LF%QAHGVUf1VDLkc3T6a31pK8jr3$emQ#bpM3&k&X2"#N((ZPBBm+
am[Ji5lcPE9*bI*UCpKHa60b!9l-i$d0a%8FURUBXb``*%21JG(LP4A'JHbYESS,
Y)K+B6TE!K2%CT`5'*5[C6Vp$9-E!,*!!Rmp)USaN2$&IE!JLf4`Uq1Hfh@I&NT!
!66`UaU!Zcd3'hNNCrI`cpMbJ5`Qfd)p#*8+Zhr0k$2FK8ijdpk4eYNZhRk!13LI
D42&33VICk29JZKX!EC40hXNZeAd3cCUB3*H4N!#%G48M3FXAX`hhXFA&K*J1NrF
T-Le$BHH@EUE+[dDJ2&Iic(RkK-2&"-4L*"88i"4E8L!*UQJ)Im*`-ZEeX192%AR
m!aA&Z3PG9Y,V58d1X,)KA0e`N!##ej`6rR'!m2Nr%C!!Q8'!c'9N-*6F'J"#!0"
jrSP#!4!#X'VBG[ljY+l`8Kk*,$%kl)3Z[L2&!(*SqL$1j*G@d&85ZUHr*A9L%T-
r0Dh`-CA""*q@*Tq93Bb(K!pTm`[6@4#!mbf*YSSM2$H8qlcE9MhQcI2+j!`JLZT
ilVCDDffLYJAUjAra6Z5Zb9eMX$14"Y12e#9EAm`6Ie(H5#MK2+qU'+iBUFYb))0
'JBJ@mAG1&Ljh@&l8Plp,"qM-Zh91B[0YPfh@5&hVmS4Z+pqJ,pq&Rc*5KmVh'Qc
P1cF8m%Mj[T'k)cjNpi+!%VA"TSdGVS!+TKiZSf%i`aLlp4[dfU6"TSd`TLaX9NJ
l"[@0J(3-kLDEDhq(E%2E85J0q@Yr"lHG@p*RY2Ch2rKEGaD@H8ckNK+lkCSP3"K
S[!ZUAmaKl0*VMBE&j6@q,+H9U@N*eJaEJ6aDHq60'Qia'4dQZ%[!NB1h#qSDRq5
FNJM$&P,U+A&)kf"CJ()DG5+aN93km3D5I,K5'-,LeiE3iFSZK''faU"ZfJjAN!$
#HEK-Uq+kN4I4a'Nh`fK`"1VQ)9)keqAkp!-C6PkU9@h(['rDY&&qRBTY&9Z@%0J
iPPD(Kd"R5UCT%&1[+r6TTfM41b0eB@aYV*@@4'jbbjB@CbZ81#GqET,kklE*%)5
H#Pqc)"Q&3INDCm2j@f-BVSq3!**I1C(a[!&A#@NVS53re,J-fHbh$RpZ'-fa(mj
&YNeZ(2-F*)A92[e%KY1+S4&TU)+'l2j[BM%PrfHRHY4"RFP#)M@aN!!B26a2)!i
c'aaVAKirdEB!L`VMMR%BPHHmU!FiH650YK*0`F+*M#"#R!MYhR0B&K3IG5SRR)$
"36"d*29L$m*("`i@m'eNPX'2NFJJ#pS1b)6fY@@qd!(C'DG$2e`*Y5h2E6Ym"$p
l"d1Ed)#Vmc$e3P`(bIa`"*Ydj$#j2Ve2`b0e,e3$FHB`N3&,JY%cBM0dDa0SEM2
Y(LE%B4Yr[91B"X)B*1$EI%e)'qk%Z*!!cp[pj*b$RfP`j[+PLp53!$c3Z&LHDRc
X,"P-&h2IY")-+KLm-,F%@k,+&QFc0Y9!@pdm"Z(R-`KM5GRRV"YNDPjc()2cIF9
)G%m[[(KVVHSrq3F%VBT!c*!!jX*4*R05aaS30[eBr1Zq!+#@YhbpcVISZZR3i51
$SF0`qQUpaJ5eZ&0Yf[(,Qi5XX8050lH-dB%*3T3MQD-3X,%j!PTD6#al!m@E(dp
$kAMD%9kmmAVYm%MGjZRT%)T2S@XkK@&`**`hqT!!BD!L,2(efT1'N!"C9Sc#aK$
UULm6`'Cj)J1,#SCa8,0`8,0+3QhL*p*KHCU#DL`M%*8cdU(Kq#0P69PH[#aGBl4
Taj',l*)aSGXHP4"RQm24L(!2E4"V2S+@a,D4NJRNq`6AV"`J-A88eqc%j`,+NKY
ZmZ[D+-Zi12bZ6RE9#%1DZb0eHb-A-L#J")QdT8b3!)*MJl(9'-f#!5BDDBGi9qK
FimXkY3e$IQGl*-Qcl+-`b55j4@)iir6ifVRP9!c$IQjadR!@#US[C+k4*S3*Gir
Z3JBPfiFVAp5EDb3cbjpMb`J!AllTcURKK)kIr,jVf)h#KkYG2epLMj'*1M'HhTT
lFK!'[C&Ae8[8i((,X&Y*PUlE$)p)I-EfkFrU$3-I,4&VYUf!%6$I02q9!P'''a8
CH,ED$6kBjI*8$)VFa+C+[%+1TIMB2(aQ#"mQEP*D$Fq`*5B`aqa4$2XaR%5K&%D
6ClJrdXG0PR4H20CR5IISeqPj&L2@(1hMrXh$pZ3k)KU0j!q+TMYAKFqYX6l6'0a
%rpXf(IFhU2Ip"`caEDqdmEL[cr6l8rA@2XY'h'&("-B`Cab!ceeh%dIhp#[jTKK
[pZ@ADQhGQ,SCbh8'qdGBVRlkCRjmJ0FlSMQ+FqM0Qh`ppq4N160IZ-RIiSNA#[T
l9Rf(YcSXk%kqFT0l@#MNLVTUq2L&6c8VbLk1[%YEV6*R`p@Z0$PjmGc&hhIpl-p
f##XmmX&LF[BFcPC'B@*INp#9I65-iAQRl8RIDEY9dHkZjZU['Q(m*lB5!i,T2$E
bT(SF'D34l$h+hYY2R$Z2pNQa2IIm644ZRIq[jfqMN!$Y1(F*%8AqLG2aUSV#Hrp
d5k9#aDQVYe#`C$lhFZ%T&!`f'c&BETelcND&l%+8U-#P2b$1)m2BBSFrmJar&5l
!eXJc52'L6Rq2ANR'qL)r[e##M+#J%BF6)SVhSJ&J@iB2(cE4EdREqk40@kpqHK6
Qq@0E%Ym+Zb2kmAUl*k)IV,I(m1U$q9%rhJI(@JJRQ$EZ!$Si5JPY3BS,'jhAQY$
483kaSrbAdY8ZSE&BN!$Y6')*9j)d!(G%,Xm@N!#"HiEGeRSlPfI0idlYlrp$MD*
c(N2QC*Dr+,S9S5#'(TiQk"%Pp)K0mLb`Aa43dHDKUd9q&X'-pJKHT6Er@Ed!S+`
%!qE0!'"pPZL#E(ZFR"DjajZKMS0Yl8m1!5(,4BB[N80aV0kYMrh3Ka#-[4Q[T0h
r)jd5bp8T%H(cE4d#4,Si`"N(@UM(bIePT"(+b@bJ,4!'MU&`,H*a3TLT$0De62h
d"DM@h-SB2,NIJk&jj%QJD`D"%d2SbHR2q9Ja[Ida%XI!N!!43mDJSD3M+dG4r)k
XYj8QM(%`aTX-46!8S5&+5LL8""&a,a$idj&'(-Bi%#0TZZ0-jMiB"K-jHBG6c"1
e$q%Jr-2C5)ULi3mPCp42QEV`&!PXYER)&K($kqUiI4KZk41*HJ3dShE222e9"'A
2YYQ6XIThPbRD@+a(RaY1C4XF3dXk#`*'6(cm`3a5aafF(%T&)icZ)!J"E"pcai5
!JG#Q-Bc`15d@M[HZZlGrkYj21dK*&&Y#*"BqIT!!h%AfK8K`U3NQ+6FF2-kYdZ)
i,6iE@&bFcX*#MrJ1&PV&KBc8DDL6ZFm5Z3pBi$+(N5Z@b,h$!)`#`2F!@$d!Hd3
L(L2LRdldMr5iJSJE'I%B)ai4L-2Se*6S@`*4U)"[Uhm4rN(F%d5mHD6a!EUdDp@
)ke2KfK,jI5#hR`(Dj#$0Mc1L-3#kL`k8$P)kd!U*q*)JiU"pAhF9m3Tb!U`2Xm"
%(!E'CKK9V*&mY(e[fGC6&[[!"G'eJMN#C`U1`$8V%'kYD2M3ER``Bj!!'32(rGj
-(,d4#R!M%fah"ES%9hHj4$2ZM'!i6*meXcAM8%DLF2lpAe"-2RN`Jm,,B$e#!3a
F#3c1+icpL"6@1##%Vq5Mk&+%"63&Q-X`P2PJKKV*IC!!`Y5$I0aIZr6JF3+LpKm
di`i6(")11$h5)R*Q$l0*j[@0+l(!--$Uk30B6T2'rqEIiK$*a9hFb&`@C`E3mD5
`lIeRADXkqRXl(ZcRc26ITp0&CUK*pc)+EPB26lT*bCiirm6,T,c@jSE(4cZZF,9
hD#,ISK6kr2CSc1SZUG!VrPLQZq6fMZAFjlp[DEII9`U9iJhGU!Uaic,hr%PJ8F+
48VjMqf`c!Qa4akE'8KU!#jkVm%jA4hAIUPf@0K4d8N'rDKH23B6FA0e0SP5T@1h
#X%rU(T%+24,EdpAh%YYQXAS!`aHNEN8Uh*,BQUY[%YXkXIS-K[1NlR05iAE9P&H
N+3X`A#*eAj3+fBcPKX4bKjQ3!!46I4D-Uq6X(D'QZHGe*0H[`c8P1Ubh`R'iTjH
k-"KVk#fFJBBq'K5DX@fm)i5,2Xi1""dSLfKL&)4c@TR5$2@Cha$8Ck8H(6ZF&$D
,4L'HmL)+C8%FAbk3!)9"')cHmfkEHCEhqi-K"*KU'QhQ1DL3!2([QT!!HGTl0[0
-Q"S`XII'bZ1&RI4KhZqpmGlaS1(NfG$'1mTHG*A4)",%c)N-eRd4dm$"`0+$`IF
"PSiG368&EZdX,,lSKa"`baC"(+Y1HVr0`T3jq'MfITXa*4Q6-4@kU`*f1J1fK3%
lQi$efF`,,NdNE1CjkDJJeQaUSB,h)J[X8!J6#[ZQDQ%3M!ZU'(r8K0(%''F*J`!
j5C0$hHE#j,l&jS@A#VTXjXr+Pq#e[,`&al3%al3dXKLK$ilZ4+)Aa2-Y@'+ZJk$
e&K2G$1eF'P`S$%,F3D'G+jQd3')''l'N1K1KmZQ0,KK,CT2V!$R-$%!-i-Z`F3`
FYXNI`i5b"$r60pM-PH8YH1d6&RLr$f)V@9%V)!XFB+,[i[*dU4iFPM#-J'!8B&8
&NTJ3F%rYLUlMjT9!iKlcChKY05r&5c%[he"J-CQAi#0NRSlATqB@[!kDCk1$Qa[
aS6I2BKdcm4Sacf%Gde5EHDA$e(Kb8SmU%mQ6KGbd3@rHY`e#b#G6'pV-PHXKV*q
!Fm!*[IZcab#bEc#86mIJI!`Z1Y('"T0*!cHLBdNMA4D(-JYAfp"@hX*3CCL%9lS
Xd'-[fdLH#Zi[kZmk[['kSJDa('R+8VZ1@)4$03#C$6JFr#``,$EAi@IKB+KmTrF
ZA[Zmek93@GfcfHciMF)K8NCp&qc8UG*Q"Sk@$B,-8FTZ*1VjEX,d3SBaJd0X3!I
l@11MBT`BZQjZQ@BqLXdl5UidC2+aNp(A'-C3PdeH!mDN3qc5QiqU@5b$%3"9)Z6
Z26,[@U@P"-S#Fj!!Jma"")Kf,'!8XJb3!2M0b%V"C%,aDl`p*'Y)$"IR#p-QXT4
YXC!!E$R9#R[k#hEV'@-22a8$faS`cAjFVm`#5d`5Rddp[G5PV"43P!4B8XKM+#J
UVU,kZ0d+NfH8M)mNA*Ue*'!+,!5#TEk[`1)E"A)S'VL6*)1F"BDMA8LmM+JLdm@
MTK*b'MJA4K@"1$2H,)(+EkA&F$T)fT1MCpA0cT8NX0B,MMK(X-@[SVV4B[1"@c(
$PN(G`dp5%ehl6ljaHi`k(AQ0(q*!$k3b2#h#&6A%[&%NCL$CFKcB'"eB3Tp'H05
VB(QF1Z(kQcq3!*&+T0M&k@Ke2JVkdZCZJb(KV33j#dL*6RNLC@kT#Zir0P,hLb@
#'B'bU86Z#`UBDU63038M4qSb$dN(cN)IQmS'N!$8bYM8AjHa6E1Q$%6Nj'Cf`K%
B*SEU62`XkqU!J3T"jbkA&0#1%M+)(3`CQLi-`c4e&-'Mj##U9XAIlbUBH1lFbpT
B9m(C99-[!+&5**lf`6a&+LVNa5@5dG+NhIa[TSV692+qY5%Y3`QCM-!cJ-`AC!G
H8r,,K[ZX)IQQqq&"UZ`3NQe5)5d9#U8#(l5N`$*G`%%8b46+mYKK0T9(jCHCd55
HMP!B2rRfK3`%m#@6#T,5D3dfqCCGC8bCP-`eGDfBH`A(H5q%QETU+kieJ#XGNXa
0ZlCr0F%dZr8Y-JA*5ETF)"X+f3mCcbTP['jfFBYdFB9GI%"q@B-3,#lf60A96dQ
&X&3i)a8XJDYEVV+V@h$eHREe6[PP!(mKq2T&hZeFhrRMVrq2"50e"`ESqTZ-$)A
V8p2piM*Gd$c+6'@FcaA3EHlFY6am3f#*hMEC4&Rf`B4NCXDbE5M+pRCI[hf5NMK
CBeF"TNDEL@`dbjjTXXR)*dREchCU@pNV8dN+JaYXXNpE$fB$N!$0*VZ!DMDj3pZ
(ei4@&d!lGJ!qZ`B%jpJlD@,Rd-&H9$a`L5Z3!#@A8GD)1-1,QF*GKir6T23UcDP
,l4`M3!&Ja"H5Kmi`0ibF0UM)1kZ#Cc)#'%QqcKlG!)'P[&,aSiQ9UMUKfLJFJ#J
lAV0%M(cmHArp#Mk1UAE5a*[h`RaqYHTcCb6-Aa4h`R#HK*%F49DpBHHc+hLB2p5
$)UYJJL3&5fE!H%SKYRm8Q(CVq81X1#-R(1NYII359B*XTi&hU5S$69(P0T)m+TN
LLp1N@1h%e%jbM)U9"&G''DG+8P@*#F5k1`++Qii3X1A[iHG)#%FZRX4V3M`KE1a
"E)Yi'UpZm6)kA1*#I$M&HAMG%KF)#$'MaF0pT6$`4pQ@Ze+"RfIeBSD[e*k*,$A
U61,9D@m'N9%iT!0aaIN+l%'%,Nir`-PJ'q3RJ9@k6X!J2m+bARFJ85&6-TR0"HH
IkQ,"S'`DaA5G6*NV)P**,MM`G+(LLEEEKbXc&'8C`a(28C!![$RKlUNeK%4C%j)
6!%XMAKF-b6"l0rkiKK8%Vf[(K1Bed,"@FmQXR3Y#Dm6VdZ'J'BCTSZl`0&m[`MG
*N!"r3ED`KK@Zc+aT9Fr!V)E'P9Z-Ch[*R#f!,rZ%E'Ga"kj8&'i2DDIS'!$%5@5
122'%9VF"6[[D-Ea1DqYpZ!`l[L5hq6N'5Zd4X#e#TN)e(+d4aj!!!5-K(AZ8&!R
+J1KDL!b+!`SFMJmCb(iV(4+e51C@)S#5$E'pq$qh`(Lp6E@*fZ'1Ac8#AHXF-I8
[C0"0r)9P[V#i!Q)SXYe$e`L-(Lb#`!4R#E'i!Fi[YU8#bDM@X&Jiq)%-6&9Y2h1
`@mM#B+J@-Qi8'8IT1G[l"J0j2BjJ,'#d,iFkFQaIi0KURP56e*5&5`+$"aB!'#&
Tih*l`*3Z(L89SLTFKj!!rNMGEeXCqMAESq4N!Q-!N!#6'`1L-b82T+kXfX1[D(5
P&FS`8b4A8p)bFpUS2[bjphci"VNBe[iHVJ4rk1QGbUKbR-hbM[XqG-i1FXim4!j
h-&D`jN-cbDmMUCP,J8%eG1c,,[fa,r#cBS0VBlE"YV(9B+[13AMT#RiiQU92m&1
r,93q`p3QlV$(B*@YpVIaTa(DhSr%HQpR5(DJX$,b'1Ih(,"&*h988%b644#b%)J
`$9%MPSDM3cTdV!&0biV,&`9QA09ULij+#dDaB#15#-XK)1)C12,4JJ8BZ((j$b0
ef[Gm&fR"T3XqJ*9A,@4*l5'@'G`d&3`FIQQ+4YmIk(![*F"mK6'MiG8ZBFbY0!f
B5bAb2b*@BG0%M3!b(M`JJ()'U0'C$P(6&ld#P"bMa,"*XeD-lELG#Q&Y`+'@6f[
U&&M+N5!jmU"-ij!!5L$!iE+bSc#TdV%aBr!p"m*F-%""@#FNI)D3!*!!`UaG[@L
F*V3a)I1(3pVkpUa[Jaa3VkUDb%MGS4VIh6a2a#Eq4BXUQF,"P-qGbX#8cD4S(eZ
1*2p(!aQNV2*PUDB('rp&`q*M+qK!ML%l(2X5K5r)dBdKCS5TPa'JbaFpLipp3DD
#*Nk!9JJMc3edY6J9IimL8"L[PmK&VaiZJK&$)@q('f!c2I!!aPbiG2d)!E4$)qP
f2J5`%J!,e@J$eIMT%(`hH5a25d8i6L1EP"X$MZ'X1E3bBf'0Va#-eCTf(U1TK!R
B3a5'ALT!PFIfPmK&X"j6PJ,jjNVC$NhB6+m'JDj$+eQM999*(NhmZrBi6H[)K0Q
B9IA)UA)RK),9M'D"a*ZNi0DD#Vf5+mU2Cf11Q2q'N9`Qm(#+U,fH("VbALdXC#l
M!%p`!Y'-"paNQ4P(B"m$1f-Lp`Xb"cUP+iPID[K!4V"V,6[)Ndj@'4rQ2&6AYdX
0T84f2KalY2LTGZLS3L@+#r&6aT`pY%$U2Qm'R#X+K!'U6)R"Y@a`EQ3qZHk)RcP
R4HBcYjrPcL9`%S[BGBap,eLrbeMEK3'*K)L1Jkb$'JE4cKjdB$J*e`B%mC4QbIb
UI3'''1iA(LKL6LP*-mQapKS(L14+[JX09KdjTD"!iA*8PC3A#HiNFJkj'T+6#KQ
('"SEd8b1#N2brPEZ5d*iLDT2GqC[pAGbfJ$(q6b92@!%)L146ff#dj9b0m(V93H
jGHbUFP1D+lJTJ8f93,UA0X&T*9FdfTD8#a$E+-lI)9FJ**FRYZF)P2XpCXUYV*V
DbBjZET8l8UAJlS1Z$Z(LjJSfR8CJT-Xc"c'%2B8Q)ZAN3iCHi@M-#pQ5L("JCLp
p-Q!kI3M6U%9rrjU"Q"6FMD4&MdMX9k4Tc`QA0Cq"1r*H[T1-j),+KkdjcCbLb1d
d&jmj+,b04VZBJM#5bpME-%-f$`29d%5r(j3C,""diN+f)3%SjCC$5q%)%h"`6X+
9*UNNHhU9f3kH3RBj6Y8%8K9BV[%#"!-E[N59!)m(U2$G+Bl(b'c4)eMEaF5+"VJ
*aYf&R+SA85BSK#YK(1EkFb'B!m56"kI%f`#p!+!VP'8eh0F,pj*mjK*hc@j-%Gd
#P8JLHJ&NTZ(RF5cH&f,"9V'#NDX"Q4B+Za)CjhUi24Q4m*PSHKcNa%MGrQV01*%
%193PqLiH&B1Z8c`&B20%"UYFX5cBC6TeeG'j6Ij2T*bI(Ib$B68D5!CbRhU$5c3
1#Hke58T5S$cI8ES&&q[+5(JF@F#&4jc!rD1GAh(0Z+X@`GPd5)-(!b(d3%DDHXC
#4N0$iiPK[B09*B!$6&E!T4Q9LeB,bG+reP&9'VD%h%&"YLTj!V,#d48JT+8+%#P
c#!1cMpc#UGS$0ZbGbHm-pEDZFaFVpCP'pf1AAElq[$@qIQHF(SM5J!T!YbB(EUb
mFA@ISQCD"3CE+aLXL8k"i5bV81(6jb@rHIdEdjqBmEpERSqf'bFr'5T@[0qBl[3
2I+kXD9mhLJ%eI[,c5McdiCX2Ih+p%Sr(Z"4,aeQ&NM1pCFcKXcQG"8G3UR3`%)j
2C+KC*crrCXP9,Mi*Nr[1l@f5DTcmeHLbUYHrMjB%ZkLc3"QZH9CrMUYr9rm1eED
D1JIa8"USTXKi*+K&ld"BPTUr,%VXpe8efd#5!fZE0Y"!0F'8X%qA9H&b*Up%Tk1
#hK9ZkZ9Cb9i%q1VmKN&GM#DB599P0#[BC+K8,ZBCE#)-%'+Pcm@8HTI$q[IPUrC
8McEHQ05RMB-k5jZ`$,,GPpa2!e$1ClT[kXRYE!J0F33G89,CL'$85JB6C3V#le"
JF9(e-"EYrU1HZ4[JKFqF-"are##Q1CS9`F5,PK0!+F*&Aj!!mB$(Je'1`NQdJ#V
3d@1J4[%"'h)Lq+J1ajSHPAZC056Zq9G[#Di-`Dab!YH2f(LpZ-ZfC'e)h'rUhb(
5SaD!U*m2k9'P&3J9kHH42'XI6&KLC9NZ,IX+bj3"'MJAfFH'r$BS*l[@@SH,h(p
rp)&CLm@GSfd+9C,KiU0``NIP064YU"UhPUY&lQ@2CMF5Ljj)l#XK!QF*N!#cD#"
EqYC&ZP&*IP40pK5$V3+9P#p'LXQTdKBRT5jjU!#*1&d@VJFZ5F"q#e@HDl"3FdZ
6m--GMGqVAd12XPJ4I"KDrdpr'%6-fEU'MQ4hUFLZ'UqkDKcAl`5,hLQ!G"8Lj,3
eZR[%j6Ca2f2H8F@m3pb9h-hEQQj,qCArlfeC,%ll2pZBSH#0k@3EdpPdBiEHZ$%
pE'1X9cJUHPpeL)hG'Rl&mQYEddXGH[ZR[j6kcierDraEBP+qYJa(GTe0Z*F"r#(
BH[S6r5Zb#jX[Za,pNmbGpR5fNX4(mR4fBRFR'lUFAAIaNVqZ1!mZGcdA"84*S3`
#I5H$8FEr'D&-j#)E-ZAcXlZGda9ZMT-B+eEJZRiU)(5bHfkfF5kkUa9HXiXYaH0
'@JmJ8AT5-+#6F8)ZJ#'MJ+Ti2TSpU9FmSafrh52Z0*c#Bk@3!2#Z@5'+2Ed60b+
p@AjECFT%,S4qb5M%+NP(K!GKE0T&$IF9RXrrqKXNY1l(Lp@1GhrMLERr-25Grp4
5YpYZA&XDk4G&TarCHK39riX+,!r0pr9IbKc%PJd@d@1jq(#i4'T-6T!!m0,62I$
j&dL%RjJAl&,[i%0JDYXM[f-e96aLDZ-l'K1Sl54pr&(r8h`Df'I*6rSd'B5L'P3
PD3GVfLCaFCMD+C!!'XQE,,$m1Jm9(6b*IKar0L8hNrUqqGck`ejZQZ'+p-Hi$@B
TAUIcQe`la%kr)l*cFIkKDHbK'[GRVcS@03P&5UE)5'L2NC'3!,DQabBAV,qV1$9
@j@UdL(0l@0JX**8lm4J)[r#jkNM8lh1KHBGV8N*DePHLi8Tl%hC6&EYTHqa9&Fl
I&aJTqkMk"#k#icm5A08BeH1BQMCTNr04k3i2q![12,mmXrh-mr$LUS`63mCTSBa
#iCNG)NX+jSlUqpEGjKkUFSbZr5`,r48,Y[PKTKL2Y2'LUj`Ih9eY@6qVEGB[Bhc
NAASi!"EI'0AhZ$aiq!L[$!bG&BCQ"BDJTT(`[Na+-*T6$`Ukri%I&JX2,T!!')Z
E*KPBG#-rD`Nbpe3h!ieeh8GGEb!59''rLTJbNMp)Lj2GU-k$jE[BmKrmY-YMJ8q
(TG([+5&&UUHhV[FUPlqi*Mekl2lXPqj'6@ci#*RdK8a8FbqUZKi3(JJJ9mYcj!S
a)ZV&!U'kZm)HrJ9df#0r5HV"B&B-!9Chb5"2'`A9a4aMQE!A52kp*fDP+UUc#Ue
p`YDMFTD4X[Ir"+*6j3NMFdNBq(`PCGVpDDVX)SQh'kFMm5N4!a@PNGdV6d""M(E
Ca)VUH9fpe3Z4)+R9+cIB0QCA,c)XVRk[E8re*e@#2i,H9&eJD3-"jB0KLma"e6N
J8bH%*f(`bKB%#QE3mGIqpklMH!53!%hFLqU0H+9MhSp'A[91M,`+!!!#3J#3!`S
!N!0b!*!%3RJ+5Th16VS!0%kk!#4#CdKj!!$rrdK[!!4)9dKi!!%L1[r@6V83!#"
Y!'a1N!#Tp#)krmTR"%ke%!"1G9Q2,caD49*23QHTS#4A@Bm[2%4"9%&#CkQJ)&F
J8#*i#3JN8Q!1-YKQ#M)DB!*#'9(*rrblb@EZUD1TSeQ2,ca%8N9-3QHTS#"AS#8
J81*!*!eJ"M)BeE83!&()rrLTSdje)&mb'$3BX&KAbIrk5N*RrNl`)2`JAc)B0"L
`Q&I*rrT+3QIq6[!JqL"I-KJd',"#EJU3!%&Y"Y"!3I!!!M!3Crj1m!!!)#m!"#p
"!!3L,`!),em!"%MR2!!N!#B"5%,%`bJ!+J&)4FM&e%4)3T!$`-(3JNcI!$`L(dj
e)#m!"#p"!!3L,`!),em!"%MR-3"1ZJ#F60m!M#)I6R8J,`!%,d%!"#)[!!J[A`!
%51Fa!%kk!(`J!8cI!)`L(dje)#m!"#p"!!3L,`!),em!"%MR-3"1ZJ!X60m!M#)
I6R8J,`!%,d%!"#)[!!J[A`!%51Fa!%kk!!`J!8cI!)`L(dje5S"U(%U"DJa%J%5
"6VS!)%5"6R9%J%kk!"C%J%5"6R9+J@S+4)&1ZJ!'4)"1G5im!!$rrl+!B`BL!(!
!6R@`Kf)-J-&)3$)!3N")3%jeXSGL'Li!3N")3)$"5%")4ci!5%H1`6!(5%Fb"dj
e*!!Q!H+)iSQbKf,iJ-(!Kc)$`X!Z!dK(cX")4p+(C3L5JQ)%4)&1G90!B141G3#
3!e`!N!1!!!!-@!#3!f!!N!-J!!!r2!!$UI""4%05!`!!@!e6!jcU"VH,K@qjj4E
ZDJZS"5c!V4Dfm#r`,AG4Dr9H!!%HrMrbNdYj*SXBa!4+*6*aL!ZS!fehk,-3!3#
3!`TB`!!-!*!$$!#3"A`!!3#3"@N!B`"p!*m%!Np,!*!(23"J!21)A&4SCA*P)'P
c)'j[G#"PEQpeCfJJFQp[E5"[EL$5AM$6)(4[)'0[ER4TER9P)&9Z8h4eCQCTEQF
Z)#""EL"KC'4TG'P[EQ&X)&ia)'*jG'9c)'&bC5"ZC@9NC@3Z!*!$8J!"!*!&E3"
Q!)%!SJ3#6dX!N!8%!%J!C`%$L$*6Eh*bH5`JBR9d)'%JC'PcDb"bC@aKG'9N)'9
bFQpb)#KH-#NJD'&c)'pMBh9bFQ9N,J#3!d`!!J#3"6%!C`"&!+d%"&&eDA3!N!8
+!&!!(!%3L"T9EP0dG@CQD@jR)(GKFb"cG@0MCA0cCR9X)3#3"3J!$J!S!#kJ!J!
"!*!$IJ!"!*!&8`"c!'F!V`3#6dX!N!8%!%N!43%ZL&e"EL"TG'9Y)(GKFb"MEfe
`FQ9cFf9N)(GTG'JJB5"YCA4SEf3JG'KKG#"dD'Pc)(CPFR0TEfiJEfBJG'KP)(0
PE'BYCAKdFQ&MG'pb)'4[CA-JEQpd)'KKEQ4XC5i!N!4D!!%!N!9G!(!!F3#X"!*
25`#3"dS!93%6L$T6Eh*bH5iJ)%PZFh4KE'aKG'P[EL"MB@iJEfjXH5"LC5"`CA*
QEh*YC@3JEfiJ5%C6)(C[E(9YCA-Z!*!$EJ!"!*!&D!"k!(`!YJ3#6dX!N!G)!&i
"*BK18fpYC5"TG'9YFb"hCA*P)(0VDA"`C@3JBQ9MBA9cC5"dD'9j)'&bC5"ZEh3
JFh9`F'pbG'9N)'*j)(4SDA-JFf9XCLePH(4bB@0dEh)Z!*!$@J!"!*!&A3"`!(%
!V!3#6dX!N!G+!&8"%iJk9'KP)'CTE'8JdPi`db"YBANJBQ8JC'&YB@GPC#iJ)&"
XC@&cC5"eFf8JDA3JGfPdD#"MBA9dD@pZ,J#3!bJ!!3#3"F`!MJ$J!0)%#%0[ER4
TER9P!*!&"!!%!--"BX!#!qJ!N!--!#J!+!#f!4`%!999!*!$$!!J!!J!SJ%F!)*
993#3!``!BJ#5!2!"Q!#&998!N!--!#J!+!"e!6`!Ke99!*!$$!"'!+B!ZJ(@!)C
993#3!``!)!!)!+)"(!#!998!N!--!#J!+!#Z!8i!Y999!*!$$`!#"#"[CL!()'P
dC@ec,J#3!c%%!)!!N!-$0#i`*M3Z-#`J!+NJ-6Nj-#dj0L`J3@aKC'4TEL"6HA0
dC@ec,#"*EQ-Z!*!$'J3!J!#3!`-d,M!28h4eCQC*G#"648%J0#i`!*!$$!Y9EP0
dG@CQ)'&c1J#3!`J()'C[E'4PFJ!!"$0"4%05!`!'G`e9$8-L%K(QAQi3C#dC4'V
b4#3,%&QVTLBRYcf,M1"fjmK*Yc06mTPrGlr[fiSm'pr-Yl9!NYA1l-RN5GLq1j-
4NZ9@j)QXb1mIN6q6RmQmfGCf%8N@%l)h,FNL+%$L"rp1@BD49%3iU!XlH1)RGL%
XdS$Y8-@K&RB5AKr2MQN-Tdqr@5Tb%b2*lEeNEa2deYr0KTa,b#P((lQrdKDbpHC
eqFBN#8XTDGMHT"F9Nj*A@5m3r1$*iF)A(Ra+`bCSd@*%bYh0[UE$mLb8Z8NZL1F
Kb4cpaH#,'S2Z2"A0G593mh5B(ilNbH!U(HDq*03V2L&LN!#Glm-GLj)350pE&Jf
fVadV0j9c-)PcYTmmT-U'cCf2[lLr"Zb,Dr,j*UQJ&eL!@HMeXIT'U5KXK+Zi)G(
%4'NH4P'P*SBS*l2%Ke)*Td69NE&*%bSLi2'$"P$iBJ#e%QfCd)!P0"&UFSY0QF0
BUD3IT`bXGDL,fZ$B!U8fSh08@--BYZrp*)$#,J2%1@+BZ'k&r-qa*h(XSZeGPi*
0bi'TkX2@JbVR0)ahG0E&J(3EJ`[@YV@,-D*-cb(Q-Y`6mPcZfjMcBMp"cGLljK3
Rb&aVTMai@-PP[RfUT+62k1U0klXYd-Kcq8@f`RZ!4-@X%K,E)89)*H!)2HGQk+!
L4L(61rDKE[-93T%lT4&h#Yj6*Gq@)$NpfZfT-bIQ[*a$ZHi9U@$-fpTGbR)EqIH
h6JN-ELhIr*F2iT-R9S%)rHb*!9X*2'JQcVG5aT+bk)"66"T!8Hh@RKiMNZDb1RC
PrpLBBZE'f'*+5Z1k(+rRjMiNk%bc`$2Y2dPbk)d[lP"05[[rh(fm5+9i5KpCGN!
BDPI(P8iGH))aB&$'@AMak[HhZkICP"IAk`20U"30ED$cl3ANPB5bhE"dKJq'UT!
!'MJ$K%Ef[#TaY#Qi5[JiZdp@*Ek(V6S2"5LGMGP9XcSTH`kX!)Q$@e`Lj!Hc!Ye
F"G@qBdCpV(kpX(EYJl32qi0AAhd*'kUV,i&`%M,25lL3!)9HJTA-Hq-JNiRVb1C
`%N0V@&,9LJXedG30VZTedYBKmQ8[pD@$C2LX$T!!US[$LD0[BBPS9ake"Bi4i"N
pQ[B5,S$!l!aZkDY"[CV-MSM(ZdcHrYqi$lHRmXQ0Uj1Q&hdZmV+6dc$Q@CReZ"0
&fVV&S"Ua`C3d8JpM+h9[1peJ#QP[H2ESABrbfDQ9EXl,)rR"Y(aV,(DK,&e(qXH
CLJYTG`ceq9R+jqIUrhj)D3VcIeGqcX4Q-IlfpqABR&9R,NpTEKEkTP6FE&CkmZ#
#0U6Epj,8cI&CH25LN[RmcjI[Q)F-e2@eAFBV*qph(["`34I,9E@$fDIYZ+ZVJh8
&%Tl"cXY,fjl%2ZKNB,XDjI@RH3*a"UE`8,`*ALRF`jGi-!Gh[Rked&R$@pIN$J!
!!5p"4%05!`!"EJe9#k-5d"m#lil$A3H$Uk"L%CKd5J@GC9U"QHr-Kk)e$hr4hab
B4fN9chaJrKEcB9B9-a36aI`eUdQqUDLB988&4IGk*8mab3!6X@8PbS$BRQd%"YB
`CdTM&pK`d8NR-Sj3)#4%SNJDpR)03Pf+FUmjed@&X98p25ThYfX2h("A&L#*VHJ
jfF@Bid1,9[aK(e3C**q%(K5Nj-LQq[LjlfBAjYr+h(!i-+p*N["VGI0fm24@NQd
q8Kkr2jH`q`qN2l+CAZb!$9KHF`cEPf(j4I243B(`!QX@j0+Br1e$Rm!Z-kFhGIP
Nk[G$S4Er#MRr,H2QMUShcq1Y`!IebYeRA'N(m[)Q9Y93qI931Ni+ZeF6`)C6LKQ
!kL'-cd$3lkJ")!54&6U'B33!!!NA384$8J-!$S81A3ZNNL#q-YqGrrM1AZDFhjr
%,&R1hMR%'D0a,&$5mVjcCSV2Qi#FE%69UXh+QJK%Tqap9)1qrhIQ-5G-b-X-*)A
5X#D8T%,36UTBhkGklp1@PC!!-M6%eP(9D+-$#8,+eQi,LrIGR4eRKDh9H`hZEM8
L!M0%)ap$49B1U82iEhi0rih5Xe'Haf#NDX-A)q0h$C!!ZHZS"mPpL-B5hh5*Emm
5hh6*'5b5&CMk&N9rBRqB45U"Rp,lNF+p3'4A!0qN%#Di1FMC'%M5$"!,#2F*fI8
`Ae2DGdDRlbQe-0((fNEZRIeZe`ejQZmZp+EElRPLpr`#V1'P3RLXrCX9-a1Dl"i
+D4e9RCfK5P-S0Zl+0D1dF%Xl3l8Q+VYhaE4r9IfY,9Bpr&aX4U$djpQM@LaJBi*
D#*CbKV3bAhD%9$%6ijY4m,c`49YTED"lJcblUk!YijHp8r$-YrP(AF*,TC!!M#*
bUa&9CC*Hpd%pYr#9FSb8h8KfSZdbEm*jj"$ZVG6FIB,!690eI@2A`DYB9VT40QV
EeYMGJH3h'"MNb`Gr-KZr[[alRh#lr[[ae*8A$iTI+P,8qi&Lf5AQKM@Er%K+1fX
EGrcGPFdPTqrDIqa'-6Ga2Arh"4lk50pfCCZYlU`+`I5AfACEIc65&kEA+AhlVLV
Y`("ZrS#TrGHTr0NS+2lJX)0XeEGq1qUkAYeBKldehB*I[Eq8JNKZ!U(HeMJ1`0M
3allN@&5)2FUBre)42De"FKZie5X59"0kaDKXXN99,PQTU#BjlK8+PD&Al!qC*#F
YjC9URe+9b&rmbYCdc91HhG`Th4l42'AklRZE6GCdK6[Q6Y,-e6GI'NLfq9KpA'M
V+aIrZ%QCkp(,q"88&YC,pUJJ6qrEF4kqf5EUUT,[6E(C*Q#cbBUR`XCe@If)64D
25XP#8f6S&@dd+IYJ8Z$dYZfSN@iTJ$3TcS0'$eEcT46("F'jUd%H$%VV)feH*6f
B!U2J))dUSDLh[9kY&PDZH5fG80Iprecl650UfqMr"K2KaMkUQ4$hSQK5RIQJr,+
V1N3hY'HP4Um@qMI(Kp8c0U8II1Cm9G8(c9G[#)(KLbDZAHQE@+fU[EpChbL%Y)(
%F+SPZ1F6lC6DYD(UU[$`,6P`*!Z#r42b[2m@b)@3!0b2,A`Bc#61F0c&6r"+pjb
%eb(FTi5!+&L2J2%-Qd&ER!iN!T1mHC8NB3cl-CV%CK5XQr%F16Piq*!!'Je-SRN
915*0*NEZjA+MJ`q4ji8!j19-f3XZF8,P9UmpFH@cXD`d'C6PP%LG6Y5$CL1AFiP
dJ1-QN95CXp++RmNbRcZrm`bkT'DF5q&J"qaC,&,J+V1b(-eT$MI4!kI1mFIh$Mb
4+rUjT5Rm[(9fElKbH%41$@qip,(U5LM,Y5VaPC%N(M3NE95d"(mJP0##d)N6chS
3(B(@(,5iVGX,&HqApA`9AVNNHUfDR%$9!kF5K&hH$A,1+2E%JG0l@J`#jjN+M4j
80ZGY'0IX*2lKY5pIqdjkhA`K[+j`F2GmU6$bd,aL+0!mmN"3"+m-G)4BC`-F6l4
"#lLpcIj(JZ+i1#`dRi06LBDdAC&&pDBS00q1#41GbN5MHiM%hF(FJ$Kr4LZ`C`V
2ZqEh&hb(6CTLPH"UYbTQG,0ZYlFL*JjX4`4E%SKK3[*E,2&M5+Xp"%YB+Xhj)E%
92B%p"*FU#B4Emq&EK+b4hd0i*BX)rp)+(d-'NN--+4h2[+,fq[ZQ9ariBVRr!$)
EKEcRH+CA(HbE[D(VmZr2cHPj1d0UM[Id'RhcTcCeVIb#32S(N!$Q5AA2FE@hVh[
0aET#9eK)d`"2@MG1'q'D1`khTZIm1JX,cdeRlP@R`p-Adi9ecrC"rP@N,5R)hr6
iip2K%jXZrLkG$Yq-TCTAKHLlS(M@45cYU)0Y+M@@MZ%%,f%683,G1D4[e0B5USr
Y9QXN(Dap-qa06eJI$Y2B2K*pada3PALrK$l`'Bm&Ci[,ra1q&H*EVH%hkSE))QZ
'F#BTMZ9M@6M*d&bekY!BPL`!l"JL0PCX(DNIZ@UAqf`r2PaidK)ZpUqU["dC`dp
M,56rRM@Nr8%q1b5llD,@8'pPLrhrV&5H`'mYM4Q!f-c@Ca`9mTm$PM(l5ll3P09
IA&Ca9[)L9%"mE,P#,JBX4+f-!B,lr8P%@130AdLVN!$2"R*Zp91Y3E1b&@bYJ*6
'q+d+NTrcY4k[(,Pk,(G*2C3ZD*D")pI684*"E)TP)!1Q#TGpU0i)VU6RZK@lKJ&
hilXmcd#bjLLr86NHPD#f%baX9$mYYemE@kC2ea%NqF66lR5D8Z8Hif`!62UPcl3
iii1,8D3%l&VL1L'X'&0"J&qB$-kpE+@d"cNc"fajFNCJUH4PP3K%YqdJhHqp-'R
MiPBDr0AL@h-9GrAfZcX!jVA"f1l4FUE$p2Q&`rpB[0$k@Tqal65ah@(ejGel!Ir
f59IZ8fXp!hJScPZFa3l4T(9d9-V1el0bD&ZRJ,ZYXZq-$,Mi`IKmKIAV%AaR840
08l@e9ajee[Yb-4GV`+[Bh)r*2MIJG@,rH+l#1QkXh6QTE8+c3m%ced`Qf9P[F`"
1"G`1Z-9+Sf,@p8#&e88R!`,Z&2#SDFq$cRUa2D3[hZdFZR5G'q`&I(&Qr)KeT[b
,&T!!(TS(Bc1lCF"$fF2eLCUf8kaaM4,`DC!!R#lqM4"pE!YkN!$FAT2Tq9S+08i
(#Ac8BIUAPfUQckFbf$),bH9GMYiq[K6'!+L3!)GV-&f$&'!9peRk,dGKHq"RjJc
Q9p9H0K-H2RC!"CK+%4@H*YfRpPR+$Xj+ZF9clF@2CZ*XV81"QC8I'B[,#SP2hiU
S8-&0,R[1FDcEHTilqC6mmjqkq258Bp62PjBqC6&Pb`eC5he%K3UZrY9Z-AGXrUM
-CE0bIZh$M&VVU1hNQ6[&cDB2UTUHYMq49#%X2Y-%H%$(+k+j#-jN,DEqBNMkm&4
5KB!r13'ih9k1CV-29Ma5b8a&m-dQNEkHc6@U8(L9qSNZpAaKT51eH2,lHpfIpkI
6fR5B,fd3V8BLEdpF1G5S3[LaN4%d9J*EB4EJ1K2+e9iG$ZRG"D'&dTLZ[SRh1eN
RPMaAi0IN83#3!aJ!0!!!!4`"D!!"!3!"!*!&!qJ!N!18!*!$#!!J)!%!!J#3"4a
KGA0d!*!$!8C548B!N!@!5801)`#3"B!!N!-(39"36!#3"3%!!!%!N!-#J!!!"%!
!!!NJ!!!6N!!!!#I)!!"""!!!J3)!!3!"!!)(`)!%$q"!#"KJ)"!Er"!N'T3)6"V
d**mb"$*-0HMj*$8S-K!hq#3)-1!)""rJ%!)!`#!"!r"!!)!!J!"!J3!!)))!!"2
N!!!*b!!!"*!!!!!#)!!!!8!!N!1!!!!"!*!$!i!!!!I!!!!2i!!!(r!!!$ri!!"
rr!!!rri!!Irr!!2rri!(rrr!$rrri"rrrr!rrrriIrrrr2q3!rjrrj!$2rrrrKr
rrr`2rrri"rrrm!2rrq!"rrr!!2rrJ!"rr`!!2ri!!"rm!!!2q!!!"r!!!!2J!!!
"`!#3!i!!N!3J(kNJ-6Nj-#dj0L""E'&NC'PZ)&0jFh4PEA-X)%PZBbi!!"9)!*!
$!AB!6R&+JfBD3Hd!)$#m!!JaI$mm!!)aI!!"!!3aI+R`!!B[!bmm!!!8TN(krp$
3r!#L,`K#Tf%!!LEHr!!3Ca*+JfF%F!&1G8kY!#*K!!2@UI41F8U$CJ+Tp(!!6R9
JFN&-384%3de3!!-!N$43FN&Y51GJm(3bRm)[5!!J)%mL9$&T!"3!'#&!!#3aI!!
"!#c5N5&"!#kJ!Yr#60m2"Nje5MJ+AQF-)#S!#'F-)%!J%'F',cVrK%je51FI"N(
krjj`$#)U!!6#Z!-DBD4Q!!%55(VrMNkk"1"B6l"kreTQ!!$XS4SZ#!JU!!B!"'F
')(J#TU!E,#S!"#SU!!JB+J!%Pp59e#!kreDK(QB!!-`X5#!krdSL"X+i!aTB3@%
!re)J1[p#`,J$'N(krciJJ%U&CJ5K)Q!%)%@J*fB!!*JU5#mkr`)[1[lk,cVqmLm
kr`)[1[lk5(Vr%Lm3)$Vr!&'!3IVqpL#!)!j3J%(krZJJJ%Kk!(TK!!SNh[`!)%T
!C`+Trb"1S"mJ4k!EFJ!5"1F*iaRN%3!"!#!#!3$J)%fJD3)!!"q!!5"0S'V9e0I
83IVqQ%U3!'F)F!'KQ(!$SCJJ659)!!K`!%cIB2K1G8cIB2KJ!2lJ)%kJ(pA8ep3
J4k!E-$J#)$(!#Q#4b'$J6PB!!%MR!$JSEJ!-4rVq@NAkrPSJ&,#5E33J%LL!5S"
[%L"6)Qi!#+)Z)"64Nj'5F!"J"$!mrpP-ha`!6Pj1G8j@rpC)ja-B,#i!%%RkrI*
#"k%D,8MrjNSZ!!YR"L"i!UDJ'bmm!!#Jr%kk!TiY32rU@%pR!!&q,blrkNkk!IK
+!&K2C`C`!@!!!A*)E[ri5'lrp%KZrqj1ZJ15)#lrp+%H,8Mrm%r[!!aR!!&))#l
rq+%H,8Mrr'F!!6S[,[ri,`K1ZJ2Q5Ui!&&"2CJ!!P&Q2,ca$6d4&F!!r!+JI*Pm
J#fGq)"0b'0#",`"1ZJ,F$%!!!eK2CQSJ$A)Sd)%Y32rD)"0d'0##,8$rhLm!6VS
#m%M!,8$riL",S#NJ,[rH8)!T3!!S@Bm[#dkk%0!J(h)JN!#"+8!!,#mZrr`[,[r
d,blrm#m',bi!$%KZrq)[,[rD5(VqV%kk#&B[#kQM6qm!*#PZrqS!$#PZrr!!%#P
Zrr3!&#PZrr`!'#mm!!#KQ%kk!BJY32r@,c`!!+LI6VS"HL)ZrpD`J9E$4!0)JdM
$+8-!(#P'!#!TEJ!-!#4)H[b3!$mmS2`[2!!!S2a1ZJ%N@)mI!%kk%&J[2!!!SCK
1ZJ%k5S"2l`!-C`41ZK"@-$J"@Z"!$%!!"QB)3IS!'L()!caq!5"ZrqDJ'a!(61i
Bb2r#6Pj1G8j@!!")j`%B3JF[2!!!S2a1ZJ$b+%!J$&K2CdJ[$%kk!&"+!&K2Cc`
Q6#mV!!`r2+$m,c`!!+$m6VS!SPL2(`"1ZJr@)'X!%+!I)'X!'+!I-$J"@Z"!$%!
!"QB'F!!K`!-mIJ%3"dcZ')$rp%jH6R919J!!51F3##KZ!!Kf!!bX38a"4!!#CK3
-V%4$69!!"QB+F!1`E!!+CJ*f!4!$61i3#2ri6Pj1G8j@!!"CMcmmU'j`!4m!6VS
26&Q22cbUER!"(`"1ZJmq)"q`RfB'-$`#!'!%-$`%!%jH6R919J!!,`-`2!J!`'i
!#R)!-J"+J9,$4!0R"(!"B!*`!#BZrra1ANje6PB!!%MR(`!q,J!+5-F["dkkrmB
D!(!!%!8-3!!"@%pQ%!*("rp1Z[pmX%GZ"(!!B#TCMcmmU*p`!4m!6VS1`LJI@Bm
r"am&6VS1YL`IZ)CA`d3$C`4`!'!#)!C-lJ$irqa1ANje6PB!!%MR%3Jq,J!1)'i
!##K3GJ"`!$!8$)!!!%&%CLj`!$!X!!)-J!!!3e*Q)!a(rrpR'#!X!!4#3%K!i%J
L2!#3!rr#J%M([S&Q!RB"%!0-lK#)rr41ANje6PB!!($r,`")EJ!)6VVrQ%S!8%p
R'L"Z!!JJ+!!%3N")31"))M`!N!2r`S!`!@!#F2p1ANje6PB!!($r,`")EJ!)6VV
rBNS!8%pR%#"Z!!JJ2!$rN!2!U!!%B!*`rdjH6R919J!!51F!'#CZ!"!SEJ!-)'i
!#$#m!`&`!#L!"T3!!!%N"T3!!!*)"T3!N!-J"T3!N!1!"T3!N!1!"T3!!!53!!D
8!!!"*!D8!!!%N!!'P!#3!h`'P!!!J!!QJ!D6!*!$*!D6!*!$)!D6!*!$5!D6!*!
$2R!!61iB!2ri6Pj1G8j@rr4)ja-B*Qi!##e,rr3'VJ#3!b6rp#KZrr3'VJ#3!b$
rp#eZrr6rq!DZ!*!$52rd,@lrp2rm"Ui!N!-qrr3J,[rdN!#Z!!L`VJ!-B`C`C@!
!!,"#4d*'B%C`!$!($%!!"&A$4!0R"(!!B!a`!$!(@B"b"%kk$5*b!$)(&i!B!(!
!-!FJE[rid)!aKJJ!F!!`"a!c#!"b!H'Th%%`"e*(F!!`"`a!!#4PX%*(I!&J4R!
!-!F-3!!"9F0%!fF%F!"J$(!!-!G6J()#6VS-c()!-JFCJ"J!F!!`"b"Zrrc3J$'
'#!"`!$!(%$3)!()"iDRF36!(8NG`!$!($%!!(f@`F!"-lKM)rq"1ANje6PErr%M
R$aJQEJ!-+'i!&%*'B!j`!$!'d)"#G!J!-!C54R!!-!Cb!$)Z!",5JE+!EZ*#4RJ
#B!!!QN*&3NG`!$!')'i!#1@!,A!)!2rmB'a`!F#ZrrcH3(!!-!9b!$)'G!!8-aJ
!8d*)`V5!EbK`!$!(d)"b!$)d#!"+J@B-F!!`"p#!1B3)!&4%F!!`"p#!2M3)!'!
BF!!`"R)!-Li!%Y+"dS"`!$!(d)!jJ3J!-!9545!ZrrcLL#e!rra`!$!&FJ!b"R3
!&$-B!,4!BS)`"P*'['i!%Q8!rf*-lKM`rq41ANje6PB!!%MR$aJq,J!1*Qi!%#K
Z!!Ji,J!@1JIQ6A!!-!Gm"ma!IJ"`!$!&%$3)!1`SFJ!5!(!"`!&b!")!hS%J"p#
!FJ!b-`J!,J&54R!!-!Cb#,+!CJC#4M!&8N9`!$!%d)#`Kf,!F!!`"0#!)JH5J"!
"61iBm2rS6Pj1G8j@!!")j`m)1#i!%MiZ!!iSEJ!)2!IQ6R!!-!Gk"mT!F!!`"Ri
!(M3)!(!!-!9b!$)%dS$QL@FU8i&R&P1"CL*`!$!'9)"b!")d#!")38*"MS&`!$!
'8S"b!")d#!$KLBk"F!!`"H#[F##3!!4brq#T`SF`!8cZ%2$rl%jH6R919[rU51F
2'#CZ!!JSEJ!3"Ui!!!%N!"3'VJ!!!NJ!&#eZ!"6rp!DZ!*!$)!!8,@i!&2ri"Ui
!N!1!!"3YEJ!8rr`3%qB)FJ!5!(!(`!&b!")!8N%p3IrU%"2L#()!%J"`!m!"FJ!
5!$J"9%4`!HQS28$rmR!!%"0b3-)!F!!3!6e!rr"`!HQS8i!p32rZF!!3%h)"`J"
R#R!!-#lrlP1!B!*`rce!rqak#%TZrr"R9LmZ!"3[,[rdF!!`,[rb,`!J#e+!,`"
1Z[miFJ!b!1H"fN%[,J!8,blrq(!!-#lrmLm!,blrp%kk#(`[,[rmF!!`,[rb,`!
[,[rd,blrq%kkr5*2l`!`3NGJ!!$f5Qlrm'FbF!!`,[rb,`![,[rmF!!`"5m!,`Y
1Z[hHI!!F!(!!-!BJE[rdFJ!5-!J!fN&2l`!3B"T`!$!%,`"`!$!&,`![#dkkrLi
m!0T%6qm!$,aZrqaQ%$!(8NGb!$)!3M3B!'!!!)kmE[rZCR4+E[r`Cc*`!$!Zrr)
[!#mZrra`!$!&,`![#dkkrA"m!"`!F!!`"L"Zrr4b!")`#!$D38r[!""J'R!!-!3
[!(!!-!8[!#m,6VVp`$`!fN42l`!-9NCJ&(!!-!G6J()!-JFCY!J!'!!`"e*(-!C
64NT!CZ4J%K!'d#lrkc)(8NGd!$3"'B!S!,jZ!!jP!2m'F!!`"9k!jSK-lKM`rp*
1ANje6PErKNMR$aJYEJ!Nrq3'VJ#3!b3!*#eZ!#6rp!DZ!*!$)!!N,@i!*2rS"Ui
!N!0)!#3YEJ!NrrJQEJ!Fe[`"*0Em!NM@r!!Je[`!J0Em!)!Y5rrBe[`%N!!Y5rr
Fe[`"*#e,rq$@r!53!#e,rr$@r!"m,8[rb0Im!!#!!#!,N!#Z!"b`VJ!JB`C`C@!
!"9*k!%*()#lrb0#m!!#!!#e!rm`SE[r),A`!!)!!rra)E[rm,blrb#"Z!!K1N!"
+V[rm8%pQ"R"RB!!&'#!-8S#`V[r-Bf3Y62qk,@lrc2qq)!a5J*!!V[qq,8$rYL!
ZrlU3!+lrb#e!rl)J,[qqN!#ZrlSY32qZC``J6#*ZrmJJ,[qZSLiSE[qZfHlrb%K
Zrl)[,[r))'i!#%k3!#!Zrl+`V[qf8%pN"R"RB!!%UKeFrmG`!"!ZrmG)`0#!8d!
p32rXF!!`,[rXd)!p32rZ)'i!%#!3d+i!$#e!rp3[,J!F,blrh%Ki!53[$%kkr(4
b!$)!5S(C`5mZ!"`[,[rB5(J"*#mZrpa1ZJ@m,blri%Ki!53[,[rF,blrf%kkqQB
[,J!F,blrh(!!-#lrl#m!,`a1Z[`ZFJ!b!%U"fF%[,J!F,blrf(!!-#lrl#m!,bl
rh%kk"A)[,[r`F!!`,[rX,`![,[rF,blrf%kkqKKk!%*(,@i!$2r36qm!B'!!!l"
#4Q!!!*K`!$!(5S"QG#!-8S#`V[r-Bf3Y62qQ,@lrc2qU)!a5J*!!V[qU,8$rSL!
ZrkD3!+lrb#e!rjiJ,[qUN!#ZrkBY32qDC``J6#*ZrmJJ,[qDSLiSE[qDfHlrb%K
Zrji[,[r))'i!#%k3!#!Zrjk`V[qL8%pN"R"RB!!$ARS!'Kaq#(!"`)AF3(!!-!B
JE[rJd)!m-!J!iSd`"e0(F!!`"Ja!!NKP!2pJ"%B#5(!!-!B-3!%!C"!J,[r38Ul
rd#"!%)CJ!!,U"%B"!(!!-!BJE[rSd)!i-!J!F!!`"L"Zrq4b!")`#!!p3Ir#F!!
`,[r#5S"M!!#LB(JJ$&+!X+lrc'0N,8crTLeZrmcrUL!-8S#3!+lrULe!rk)J,[q
QN!#ZrmJY32qH)#lrUT!!V[qQ,8$rQQF-)%`LE[r))#lrQU)Z+'lrQYRZrmK)E[q
H,blrb#"Z!!K1N!!J,[qHX+lrSP"2C!C`Cf!!!R4`!"!FlkL+J&"(F!!`"`a!!"K
M!2pqF##3!#lr`h,ri+R#KGK"F!!`,[r#i+fHE[r#3NCJ!!#BF!!`"dU!CR3J$&+
!X+lrc'0N,8crNLeZrmcrPL!-8S#3!+lrPLe!riiJ,[q5N!#ZrmJY32q+)#lrPT!
!V[q5,8$rKQF-)%`LE[r))#lrKU)Z+'lrKYRZrmK)E[q+,blrb#"Z!!K1N!!J,[q
+X+lrMP"2C!C`Cf!!!FKk!"SFIJK`!F#&h%"`!$!')'lrm0#!2$!)!1+0-!G64la
ZrqjP!2pNR'lrlR!!-!BJE[rid)!pF!J!rm4`!$!')'lrp()!%M!)!$e"rm*`!$!
Zrm*+J'-!!+4JH#!-8S#`V[r-Bf3Y62qQ,@lrc2qU)!a5J*!!V[qU,8$rSL!ZrkD
3!+lrb#e!rjiJ,[qUN!#ZrkBY32qDC``J6#*ZrmJJ,[qDSLiSE[qDfHlrb%KZrji
[,[r))'i!#%k3!#!Zrjk`V[qL8%pN"R"RB!!!rR!!%"c[U)U!8%G`!$!($%!!''-
!rhj`)*!!,[r$F[rJUF+&dflra(!!-#lr`Z#YRQlr`R!!-#lra%U!*Qlrd*I!Yqi
!$'8f)'lrd&+Zrp!3Qb"Zrp"5V[r3%*XJ,[r38Ulrd#"!%*YJ#L"Zrp"5V[r3%*X
`"&0%5N"QlQ"@9N3J,J!Bd+i!&()!-Llra#3Zrp#8VJ!-NS)Q3*I"B!iJE[r38Ul
rd"#E-!464%T%C``J,J!Bd+i!&,#,BZ)QEJ!-B!SJE[r38Ulrd"#E-!464%T!CZi
J,[r3X+lre'8!r%JJ,[r3X+lre'F%F'GJ%#!Zrp#3!+i!$#"Z!"!JJ(!!61iBm2p
Z6Pj1G8j@!!")j`mB*Qi!&$JZ!!SSEJ!3B!!"-$`%2Li!$P*'['i!$Q35F!!`"R)
!-J330!J!X$3B!'AQ8dHi4f35F!!`"h)!-J330!J!X$3B!',S[NCM5(!!-!Ck!"S
d#!"`!$!(FJ!b"KQd#!!B!(!!-!FCK3J!F!!`"Y#!1M-)!(!!-!I3J()!-JE5J6H
c#!!B!(!!-!I3J$H&#!"JJVK(CJC54'!!!+*`!$!%HJ!D0!J!F!!`"h)!-J3CY!J
!'!"`!$!('B8)!(!!-!63J$Sc#!"`!$!(d)"b!$)%dS%hX`J!'!"`!$!(d)!hK3J
!F!!`"h)!-J53!)&b!$)Z!!jd!$3(8S+5JV+!Bai[#bm-F!!`"bm!F!!`"#m!6VV
qjMJ(8N42l`!3B#![#bm-F!!`,J!1,`"`!$!(8S![!%kkrX3p4`!16qm!%(!!-#i
!$R)!-J53!)&b!E+!E3$q`%cZ'2$rk%jH6R919[rm51F2'#KZ!"3'VJ!!!53!&#C
Z!"4#4Q!JF!!`"L"Z!!Kb!$)''E!)!"J!F!!`"Y#!0iB)!$!'8NDmEJ!1CGS[#bm
-F!!`,J!1,`"`!#m!6VVq5%*'6qm!%'!%-!C54VaZ!!jN$R!!-!Cb!")d#!"+J@I
SF!!Y32rmB(C`!$!'5S"M*(!!-!Cb!")d#!"`!$!'8i"d!"3d#!#53NM")#lrr11
S,8$rr(!!-!Ci!"Jd#!!U,[rmIJ"J$L!(iiKb!F+&JS!Z!H+0-!464%T!CZT`!$!
'd)"b!$)c#!!JEJ!3jB%KKaJ!-!C54L!Zrra5V[rm['i!$Q@%61iBm2rN6Pj1G5*
I)&qJ*5k!DJ*#Pdl4)Pm5(c!I5J&R"+G'B!+M4Lk)6Y%LAa)I-"mJAdS"C`5Q4f!
#SNG1d5*IF!'KQ%l4)Lm!"#![!!K"qJ!+-R`!!Nl`N[jJ"Na"#!&1G8kk!#3J!8j
e)Lm!"#![!!K"qJ!+-R`!!Nl`N[jJ#%a"#!($3%je5S"V&%U"D`C1ZJ"'6R9%J8k
k!$j%J8je4)"+J@X+6VS!-%5!4)&1G85"6VS!*%5!6R8L,`!%)#m!#%(k!!SbI!!
#6[#5rQ!)6%%!!F0!6R8r!8K"5N&Q(#)!3N&)3@F+JYG)38K!-!&)3)$I-J"#3%K
!6R9)36k#,`-d!#B"FJ%K!CJa)3$!#FJ"J&Y*"C4,83Y'!X)0Pp*!!Jp*"#-%
!!'6Z*Kmd(dje!!!"!*!$9hS!!&Ck!!!#HJ%#pV`i-!#3!a`#DJ!44%&833#3!j*
D49*2!*!$RN4548`!N!1U3dp%43!$!,C659T&!*!$jN4*9%`!"`$b38a59!!'!9*
69&)M!!!"TRCPFR-!!3'b8e45)!!"!FT3Ff9d!!!"iP"*3e3!!3(Z4%a24`!!!JC
'C@&d!!!#%N*14%`!!!)H4P*&4J!!!LT*3diM!!!#0Q&eFh3!!!*#!!$rrbJ!N!R
rr`J!!S`!N!ErrbJ!!Vm!N!8#rrmi!!,$!3,fR!!"rrmF!#U'!3,fJ!!!rrmS!#c
-!3,ec!!$rrm!!%%Z!3,ed2q3"!!!,5`!N!3%!Irr)!!Y1J#3"BArrb3!,ES"![C
d!)Irr`!!,K!!N!@'rrmN!#jJ!3,f6!#!rrm!!#lL!*!&YIrr)!![3!#3"B,rr`!
!,l)!N!3$k2rr)!!`%!#3"!3"rrmJ!$!m!*!&J[rr)!!`6!#3"BArrb3!-&`"![C
F!)Irrb!!-'`!N!@'rrmN!$"m!3,f@!#!rrmJ!$#-!*!&JIrr)!!`R!#3"B$rr`!
!-+`!N!8"rrmJ!$#r!*!&![rr)!!`p!#3"!)!N!-J!$%5!*!%!J%!"b!!-5)!N!@
!rrm!!$%Z!*!&Irrr!!!eC3#3"!2Srrm!!$DB!*!%!qMrrb!!2l-!N!Errb!!2mm
!N!@!rrm!!$rE!*!&J2rr!!!rq`#3"B$rrb!!3!B!N!Err`!!33S!N!3'F(*[EA"
d#-3JFh9QCQPiae8:
\ No newline at end of file +(This file must be converted with BinHex 4.0) +:#d&bBfKTGQ8ZFf9K!%&38%aKGA0d)!#3!j4j!!"Cp%[#8dP8)3!$!!#8HA*-BA8 +#G`#3!aChG`!0#94VAde%48BZZ8pD"c0i4!FliN)!N!J(1q4%%'!!N"30'`#3"2q +3"%e08(*$9dP&!3#[m-k-XQqlHJ#3"QGr!*!'$*8!!%QD!*!'j0-1!&eeIK1,FUm +c*q,Cl62DCG(0*S6(SS6G9P[lcNXja42kR5AKj'KiDRMQb@kGl0@M66DjVH4j*VP +00Z'566Kj&YRNpT00EVrN0YR2##IELqb6h$j'0Z%AfH6fN@dHi@56r@5625#rh`J +RNdhfK'bfl5L`!&pHPhA&cXj"@S4GIT'YK"mCF2*E`Md!XS(a`(J0+,2,D#S9Cib +&'01@-@EYCkclXib9r*TLeQUk4Vr#`UNHZp2+C'+TM'&Q8R[XU*Z09D6B9)d0$(L +(!`-D$%H,a5rXXFFBZfF!(i9SE2V85#TT490MU%VB-MC0qkjq12YI-%)bKE(T(AZ +l)[80M6@(BQR9#ZeHYje0TY&FYld1[L*LZjR8IMZcec'DVAf@dEkdc9LZV6cfZ,C +bpmCYV8EEPMlfAU-GIjZUUpBclGj[-VENKl1VQPQ[XDf9i,b(r%E'p,q!T2`m@ZX +Z@hhRUJqZ@Ek"rkpG[S(THDk#pKT4&Kqj&IT"GM4dJXj##ii5&#CCA0[3%h06QHa +aBbVTCJpjZV`+k`@CPK1eiNBiP8M(iVCrXibM`Tb-*AXG2dlFEc3FF$1@(aEZGpa +8`YKU(pbIb[6iFAA4U1diKQQjIAl3T[jB['F)`9hVYP)@HZc0GM)I8apc,-Ha%pf +jl##`*CEF@`JC5Qli!q%9+dlP9S5G6'fi-8)Jr%bEiC-*3FcTK##`N!!3K*J0MB2 +R3q`c`h91JZL4Y12CS$Eld+QFG9LCAYXefQhAc5HYN@ia)PBkcD-mG[+SPTMM)fe +U-eV6EL`41a5!LPM4eRBMBK1d3JlUlHlqhPilB`MF2Y`1Xh$6JA9h%C@M0S&,*F( +dA2!USm9+p[CEK1pNjPCcGKP%,cYMiI*Xj*T6h&aVe293DD0EU#JKNB491D05EL0 +I4GiJ[i6m8[,Pj+H4Rdjq"[P5mQANCj+I4Ek#r&6b#b@'HG!Dj"H4RdmH)Q3"H4, +aA+[-*Rm6q8Vb0j1I3hiZH4+5l"EbYj*IV'M)2Q8))TQa"lL8$[j)ARXL+RZ#Re, +58YcamaNmb1p+M0LT1dUiB[IJSH("49TH[hN#$Sc5"mAG'&Dr"6#4'l!jHmZdE@C +666TMliiG1*p*6GCAYMQ6kNmEUkMHNLC!4%f8FA93%ipeXeTj68h'b84C5kcED%U +N8aRAJ&k+Q*fjide@2*j+*BdYGMc0)Tf'%&[mSNj5"ea9iT48$L0jP%I#j8LJlBC +8jD#D,#LL35@8ejK$DLDR08pUc!"r6P-@Y'4"3dVYk-ZM[0l++cSeTARD!YV3dbE +3HY"p-1K$hUXLHapjk$hB@[,3Ml!`HHK,@*[%!ZXL$ad+3d-BHK4fL$ad+HbMj+& +2BCmN$hd+q`aj6pPmP6cd+ZaTQ4rB$mK$Nm*q4KlD&2BlmY#SX,q5KeC&UT&ID&D +F)4kk&@I3VG#[1,Z$IU#&FABhr8"Eif`,r8!Ai`bY2'KMR0dR1B+chI3$rAc&FMS +DZ3$2N!"cF!Pj48k3!![N!,a!IT&lj!'m43l!4r!(I!8I`6e`$[`#hj!!'h$RV1l +dq*ql!hGkr&m9m,mTi,m9m"p5dq2rNB$rA`Mirkf!rcm+q2rlJ2mRI2jVi)(N[hD +lchpY[FprED[2I`fe4[*I3ciNrl92"2crG-$rV`AmIbEJ2qU)armrq[cAN9r*Iad +aN[pkMFpr(69#mPrI46qb(k*$qD%rJl0(k!Gp'TapQAl3Vm(CXr5$[Jh1INSrD"@ +VMUb-5TrSaj43JCZ+RNLY!SPdUJZ$'"SJSaN0('UebVH#i08$qJf48P$,k3-qN!" +9@e[V4Z2VDPBUf`U$9`qSIc#&GmBZ6T%S6kbFk62b3b0['DjpqqV6KPcSD0ULPEP +01k+9kap4(V$!DjRQ5iAkalUk(0I++"jQa2N8,Y2D@PXlmQ'EflDChPQT0e*&rFA +'TTB'ZP'6rhTff[Zd8BXK1j!!pbTdMMdN"qMP!*XIcP[,iKlHe26[mAVjJrG`[16 +Pp"[1d,bQjV4'!jDmJ"@''6SDGR63G&M!K()a3GVDrcBTlb'V-md@RXZ5qTE01k* +lBcdB[1TX0m1jXr%#LYLC00E(lhLRd[)+ShBS-plSK(V'5&bAHK1,a9V#0(Va!"k +cpMZ1+a"bS`'j201C+@Ie&6##EdjeZ,@qSGUSVUrVU+0IXbRF8DeDS3#A9[Q*i"* +q0Z@*e02l"JBHa%#5'Xi`d$C,MYa95!di@il8h56(mLVPk0h0XTV-NH0hFqAj,I+ +q@qA)h6`j9RHEl%A0Prm,j(d,jIqLl0LI'&5RB`*bFL"EZ@S6[3B9LLRKTL'jkDa +mYK#$`80("CX[fQl['JDQkp*T["1J!-!4LE4X+Yi6['9#Q6ec4m4XQC3!Ph"dKZ[ +9!(PYDfmE4[J'$Yl)lqjM8FICa8,22m`U&hmpHd(PXbrL0rqDLeF-RM3rarmc$r% +Cp[a!`,"P(i)ja`i2aiS9UJ!Fja2b1SlcVq,p"mFiN!#V11`$#S"RqML1[RIjLPi +9ac'4$Ir0Rj(%#Kcd6)mL!%Gd2,2&['*H`--a9SQZiTMSQH%9T%YmG9MI@*d@$mN +aAULpd+%k[52F1UPMF%If6DEKh2DNS[dhDK$dKaTJZ!miR,jiGr'Hi+@TF`A%FIX +9!6KJ0855Gr++-6+TZ%IDVqS2a8fC2A2(0F8pJN-CS,KE0cA,eeT'V2!-fQP6I#M +hFeQpTY`RF9a@lT-i,L[h#cKH8qj&(1S&j6kFMlH8qdKLhe$Z44bAPIX`M$H9Ha' +(3N#jfleXY%i$#(qCpl4bra5[dmS2aAf1q0F8pfL&93BSlXjBFXeU!drDRP(Fdrk +VQ!M(H'@iSTJQF9a@1KG`[+CdLMLZ92*K('p@mL+1LD*(1)Mh&j6jM3U6aB%R98F +Yk'b--Se`T,VhM1&SlGicLD-mFRDF3eTC*",'LhB+!,Y81HR&E6$k!SliHFe*11, +dSZ[C4eHcPD((aQZ0+S#mAUm-@8dqSHf[iLK@i!QHCIRKUJ!HfCl1aHeSMCR&ZjJ +2r$0*URG%*EpU1C@Fl@)U!A#%iil$U-43!6Q(Jc3$mXV'qZfmqkJ%b!I['LS"F(K +G`c%F9lZ'I@iLcPi`"Bl1irVpY3rV4qLmXZ+Bh[3EJaejiFGdIN5rlqjMG#@pT9R +eCcSrV&X[cG#E5rJb#Kc((V"S*"mAH5Dl0E(d+&r4V4RTXJJF@21!B3q'klcRh4S +P!&pjYdB*J!-QbKNeErkA9ik$k$(@cEU)ipj8dKkA$&SNBLS!CXhaHZ2Nr2S#pGX +%aCMp@`X0QH*fJL+G(TpD+1C986#*FGh85C-B`@BLCbiT98mSGd@&-P8#9%ke3U@ +kD-9R+"3J24f&bcX8BkBJk-@S9pqKZ0U,130%5I#HaEM*pbc'6EheRJ8C(MI%rKr +i,k2R,kPBl2c($FiSbN`*mh5Z)XC8F99!M@0cj5B!`C*EmLhIV2%0Y03caNQLPG$ +lalPYZmkDYh85fHJ5Ad2lIbNMmUbDX4$e&dYB`R%,2Fd+fPJTK,M#p%FThDFK,PR +!J3f5PP&FE$#ZR("iq%)[qA%c+8il,2$PiLU`i4,L#&mZ$ZXcXT9Bjia9a"leQDc +YS*pQ%GIp5cU6"8Rl2(QAamekmAY)N!$-"rUTkm4pDl(TNPa2)r3K*%AFpb[XP#L +hH`TKUkNjiMlp56U6Qck9!FGmFGp6f&K*E[e85ANY-m9pUel'45*Z2LdkU*@+Z-k +95)6%mA(kQ5ILlX3c`h)cU""QbkB*I-Fr4QGb5kJb@Kq5c4,hp@#L4Qi-YH!9`MG +9a08H4#lPI9qKRr8L,[3FlTCaImMLQ28+*Y2P9P',)!&q,ZlV`QCEXYDArFhRJ3A +1b'fMbT%ANDH+[Rq"!#,1f%Frc`Km,cp%Ch),U5@8BdhQqm2)Rpa)DLQfjATFa'h +(XK9b1kPbr2-ehPK&'eE'N!#E5LfP$DRd'3,IYl'"P0aDU[Sl4&%Cpm5I`#d4phl +DN!$VMND"BbFkjR+EU5Um#@-NA!Ge,P!(9G[TadbiI2STL+[q"LHr'dH0b0hh4A# +&lN2p#q*ZThUK,dbi[B8kYi2iSpqC5$YdAbjZm5rSCk2C3PX,9Mb#'L3hVDTkbUq +[ZIZU82-S(fR-%J5ibp((PMcilGp4)14pf!LX@r#J!kZIb#8lGQkJI*6a1(B81CB +,EpcI3(KALlM[SbE*6Dl+X85+U(qX"c&bUbX$ZU!X3C0+JcUJ'YYK2CL`KUE*ZQJ +P6Nh8pG"cQ-L5%r+l[N3r(5,Za%p31'3F1Z@2mVL5cFqM%)JiLeEjd'E,1!`3m+f +arJm!N!30#P4V8fKPE'ac,VPD"c0i4!FliN)!N!J(1q4%+'N!N"%@!!"Dj!#3"2q +3"%e08(*$9dP&!3#[`82,XQqlDJ#3"30Q9!#3"NeC!!$G,`#3"TC9"J"Vh1e4RZX +LB3GPj*BMQfbbAIG,Z0h#DQ9qPbGh@c,2[PYC9+B,pGLQlGjE0jjk!1Z&Cq,cB[L +[[,U5hBk64FNQ1lE`K5rQfB4X&`QrcS8r@BlRiNAiC@5ILbjf(PPiEprab'*fh-A +Vl(`A(qk-E,+2l+4!KeIUGCYGRC+&eX+9RdG@XXNQ#q&NGf5iQ2(&`fqb@[CHGCl +FmcZ[kbNI02%kYPNfmVDAjjPeG[3fFl0"AJ1MR(*2lXR25AVeEV*lIS[R,A`!jF[ +aS&l2Qm#G!l[iGCCQSlciFQ5A,pc3GYIZ[1akfjG`AeF,fG"1"m@,,-"B!'HVJr, ++3Al[YpR@h!0@(VJ3H**Eq,X!-!M3kH9lRC8pce&+RD&8iJ*eaXMEe4RE2kR8dfG +KEdjd*H"U6j0Ad41@lpZHRmVlhPjG$PZqRT56DGG#N!$%[e'TThj"UDH*2A@$iLf +PhU*@4IIl9I["[9'943pP[[[HhT0'(9I&"'5EA-Lrh%TlcC1&IS&*REhSI@ALkX6 +CACF[451Kb0mNZ#+KjZFA(2pK2X'$k6KcjIcbDj9khM`rF8NIUcjVeb1`a@-TpG) +ST1MQNbQqI*DTR"pAAk$12M2RZ9EC1jQ`V,T!26RahUk$VAYI4J1e2r'(LArTqUc +DJ$5mAkR2le*2@8aikXQlmpPd`pG9'q4M9eP`#j!!4ENC6$&TFrr8@3YJBqa(LH2 +Nh%5T1,e$@aAYEqkrl1()"[cN&f*2*JTB5mEH(DcPii"*fHc%m"FFaDh`C9HBkD- +2l!B(MGqpE#1YaIp8+B5'4h$4RAmU[5MT)A`+UK3,bDBS5E2I!AZZ60bEZ1Z--aD +aCcrJDrf(81SeS3Q9%@Jj21h(cVCmjV[BZ3XPr3le[qri*QTE%qF0U1fbVL@k&'B +V3-hX1R-L4R,#ra#&9#RapiR2R9&Ga0`#BM4%1E$R,'C*E8XA8LTR2IlPBU1b+m6 +fCL+@fMi@SB!p[ipr6QarcS5TlArM2dR#Vm2&pQT5LBfi(#ff9P`df`(MRL)fiUi +@feY`18CX(m*PUYMq!bl6a2EIFDQ4%L0(8$0X-h%KGQaRi$*GE-Y`Q5'fkh#T&pY +25BeJqb9FH"rE"h#KlB6Y-lJF+lDr**CU`9-raiX0(qP@'GYmA%i3fh*F6K6EpEL +F*,EAiR+bf0k'br2%pNPFRLqf2m6P"@,l#e`84mUqLFZ,"&$*h5PL1aZA8mAf5Pa +H,$ELISRBL(Zff(i&&m%0Bk1qjiMY2q*bQYLqMXYFBbYRE92,f-JlpBAY(&c1&0Z +PJM2B0Z0#6V#p"KIH`IBQA1D*MIUQAV"p&THALHf[F6RAf#U)1qH*METkZGM`2ep +X+aC`@QcNHi(BL(ZKf0k+Ll+VLMYa@53fm+aCE2m&Pm9LqcBZ&aTE*A(R)V&4-d[ +%KXr&BZ[!46XIPA1iY)MY$EL!HpMHLiYLG1Al")HaJD0YBRX-&qSAb!8V`5jXi!* +iJSdmNR0XPq1b8Qc8($@)lACF9SQ0h+m@fdG`Z8aXRm1&pl&*TcAe5mCQi2e+XB' +cDm3'6PdP0QUqA@c8c09L)`CU!GY@A+i4fkYa@5XfFV01E1"ZTpJHa19DXIfQF"0 +XB0)'XAd&PbkaI4-Am"`D!YqJpV'"hI6FXB&pQm3',P!Mf+JCTEe9c"Hj`VB0Pa[ +%GJFZf,'4Tfka[4-AjBa9a,$YB[YGA'i8faGaZ8PXi+M5Z8RNBq!$0QVV9@)$Pj9 +46L,Z8#rBU-1I%"[q2bQfeq-#Im(f2Pb8P8qk'jGEaIBPA(jDE1!+H#MR+1)CA!! +E(1-fXB'$e#BfX10Ra%EY83[Bb2@GB[YAZ0`P0QVhEV(p(LliBS-crDba(8fZGSr +Bi$mr*cD`qqI&4LhH+cCUi(9LSrlqYGJqM-X[L1f2FD%@X-%E`&XjNmP,Ie&XB#I +[B`-l6H01E'$9I@+MaYiS0VJ[2!AE*h$"MZe2F)'IBS2[JUYbTT!!IriEXB%hF$T +Xm!4i&MC`lHeLS`lI)6Em`40Xm,phLBeBlaIE0h"jYl&9Npqq4fa`X&m9'hMfJ0M +!*ZS4'r8$lm$f%#jJ"EBr`!8l0ZT'qJHFBeJh[bBfZ#9F'"Xmjf'aJHNI&"ZimiM +BU"2`%"XFLcV&"Xq!Gf$l&LiI0EDTj14`6fa`3Yl%"SIjGE'"Qp3J0QUH'X&'6Rp +$E*r'j9'aI3dAZ)1FDHaPr*EBi1GJ)cCikDI%"YH#Lf'$9raEXC(Aha%EQ!+fBk- +f`$GX[%AXf'5Q*r9RBU0Hk4[)U5'(qrGLJcI$0l("NqPTB)-V`Rqa`C'S6@aJ,Ad +!E'!L2!JEG8j0B50hIb5f2m8&2-3'0rUmXG@5Zhp"E23b`"CXm(Pi#MEUQrHaJF( +N%aYmicq*$Ccpcf+MYZ(,f-J&("BE[CRrDQael2[!3E$4XrLbf1$Yp$5``4[KG0M +)phm6'rcNUf)$FkPVE03rR!)E1IdVXIdp,X3ZCcVl-IqIf-!9m!dEI"@HL`d1"Lr +$"Mrj(f)$0rp'E06Yra3EmI`[Bj["hXrILJeZ3EeMJlG4GpM!Hl!1'c9%2`%E21( +[a!CQ`51`89G`0'c%maeMUbIHNeYXp"lSrf#$FfZ[Yajik9TqpH#aVJGC$l`-T2p +A$e`1T2pA$h`*T2pAMh`&d[pV32mVN!$qA`2k,)(draV3)`LNrpF!A!bNrpH!ZJb +NrpF!(!qNrpF!A$-6@ck@)j8dhP%q(fG"2Jr-Tqr*Rpl9DZ%[AS-6-(+e&@B4E)G +6qY'QAA`5,p+f02I`r'L'CR3qCQ+84C!!U3lr@IMAiRrX%k-5d630k*Ff8&G'q+Z +,qYiqJ*N%$mLTE)mlrG0T,`@K&9ffa69-VEU4'%@IRH-BHbDfk-5G3S#3!2r*VFN +D6LrJ(EmbdV%,fa+iYI0XC6qBqpL9kX*lMCcNQ,,6QV%bMK8%1NJIX+A('Cl,XrR +8cS(RXbm+eqXirSC[jVL+i6mPTd2Ifkrpk5$&3QXX2(-mG@'LjpBE%ch9EE[(8Z- +lTY4jU3*[#pHGHkP+l%,Rki4l9Tql8p95Zdhh2eqf#p(9DF,%5K1kLNhSU#a#9h% +4ZT!!Lp$K@36@hiaTJfD!3c-kEiXa0E%BACm,d8@k%'pFK2Y&k"aHK%l(%R3GPk$ +lZJ4GNS[4hESBAHL,dHQl'*fN5p$Y[36[YB$qY+"chS,ZB3[m@M&KdGSmRP-C8T! +!bBfPb%NETNhDd%&T3qHb$Gf59b)IVd4AiCAS)#a$Pf8C`(8Cr*DM5l%FhDS9Q1j +CJFQ"&HLHV8!RCb8kP#[4E9f*cY'PL2p56#4FLNle+X5e#The9HJJV3B1VdE19U- +6ZaTaABCmABC1d'AS@Pi'rm[4pEJFhIc,`CD[`'6+&HK+Ai%1d*@BRVJ5hI!VdE& +EJaTD!hDp"KhP0HM@AB8mA)8Zde@SJACdSGV4e@j(,&FMPU[4bHX!R(HJDpq"A(D +Jdh)0f2Jek%aIJfl9@R3+eb+ZYHJdVN11ek'M[!jGZ%jJGbFkLTfB81K%"lF6RCY +V-Eeb,HVl@Vbl(M@`(ThapHLdV%IAD!1QQ$DJhV[34HP#EAE"lcT-)9f([&b(MZ$ +eU+[V%G[ek#"Z42ifS[1l%E@d#Aap%bB30U%cYaPGqmhS['j'4hB,Q1X@6**X36G +X#r+r&ChlVFMh9R4+Y`)$EX!%e3fS[4[3jGb'$Xdfe03fG*!!Yk(ce)dmG+1$hid +1A!rmHS!(fe&,fp(Phii1lhE8kShSr0k)VY+0U0FEd@@l#9Kd%qVP*Y6,cCK8Z"P +GbTZ"2c[3*GU"qYJ"[eIKM9HaS`L61$!5Z1Yi)1KNL8kC3fpX%KYRTLeaL&mGDTp +i!&SHb8&P!SCVHRid$XeJNj[kBiTT#9iSIj)m6#[BM#Qj&qK2QaNQECJ`lf"LJF+ +d`D&Li@Qkk@CLb6h0b*)C9A)1c1ZB'5AMm#0fIDL%iM*`iqcUj2jbl(Le"T@I3mC +JfN94iRJ)!!$HD)CUYm!-+*l#4q62J"S$%%*2UN"E6!m8qjYPP2)Y%UJG($N%)'% +M+aR#Taq3!%qMk@,6[DCV6EHD(J06PNaA-P9*4ZM+Nc5QJ%!&ZVCdrJQ,2L$*TIY +2KjcT*,Up6"iaM81H+3)3J-id%jC-F6"4b65LQ`CPNY))GfJ4-8&!X8KKd8QQJdc +Rf(5-QD*JdS)*#bBVQ0KJUS(*#LBUQ+4JSS-Z2P-EG2$Tc$0*`33&Na0-6$!T`B3 +%d`K-4$!*`33%8`*-2$$T`!5)G2dY&0MZZ1Q+-jA%0"*65%aD-0A%9!$6-d`G-AR +#e"-6#8`f-Bh!0!56)8`C-9e%FiPT)UD)Q"jL'SE*"BUGVMp638cl-#A&*"!63%` +b-2h$e!m6"A6qQ5"JFS!*6UD*Q!bMmmmd$K1H6'SbSFPN*P-96!i`QFId*0-)6'8 +`cF68!G0G6)R4C@EkP+NV1"U63dc`-BA#0!c6Q3![Na0-6$#9bE3+8c0-GJ"X6,, +5R'+5J3N'*KHB@)!Z-2RS@),K%dSK$%&3`X&8#!b'k81Q,jN-B9+0#68QcjL+BZS +$X'0Udh%*4b'BF))j3'#BrQ4#MDP'TN1C#Q@kK2kfm(IDZd`e--eJTKLBkQ"LL1N +RTTkBTQ++KUNR*RUBFQ,DLQN5*UUB*'(DL5NRTTX!F5CHQ'*LHSQT*DD9Q&*L1SQ +T&+D4k1)cRF@d#"-F6'i`X8'EN5Nk*SaJ3%`U-L(#K#16LN`S-TR)*#56-8cJ-$h +)T"A6-8cS-CR(G""6H8cM-Fh#p!a6M"!(TKDC9Q4+%GE-K#A6R8c9-*A)Y"[6K%c +B-0'TNjbHJ32ZZ(Tbp82YJkmkp@L`!QbJ&Q*F""2*)EN%Lm&Iq!Hj*(rN(b`'mmJ +V'!KZJGG`%h!(E!#$`#*`#G`$Am!9X!Xm!PI!&2!%r+$fU#Y`$qb'am#6U$2`%K` +'Xad(!02"ER!E[J!h!Y2!+(!FlJ-2!2IK!03Rf!*A!RI!FE!E$JD(JN2!(m!LZ!5 +F#%i&6`22`(c`MIS&Pm%qkKLFC()5r!2li3TJ1pJ"C`$Mi@9`!r!EIJ*h!1r"@h! +#6JK@Jp&J,GJ(,XCi#8m!-q%'%'-i"A`%R)-,J5r`4[J$Q!1'`DRJ31!Ar"'H#3q +%6m!M`"l`'ii#"`$li5RJ(*`,RJ!(!b2"3A!0h!3[`9%`'E`%rq#Fm&(i$CJ)YX% +Ii"M`96J42"Jq#Ql#KH%%m',i"(`A6JX1Jm[`1VJa*"%1T"2Yhcf5k5N&Zpj`G+S +iRES!8MJkUIrpXbSEl$$63FHNmV%!-d(4c)mJANQh!VM4b8b1*f!B*P4cm3Y%jAd +jISGQD,k-R3D)IqCiBqE)T!4b1HhAG'TX49*Rp15()qR1CBC'YqmT6pX9bL'Z+U$ +p26,$94L+1ML!))aY3J(SLC6*,1IUEfXMrCpimXB"aQCQ4[d#4r!VjUdbD&$LV5% +[K6kAXImT@I!$-04a8)RUSAmUBkr'%Tf)p)Tr"LrXpLr(#b2qAJ6)fcRI&`ke&JA +bNZ%)2mJJ6Q&3@90pD("#1drb+!qE#Y(C#Aq!qTRJjp4&r1bHHRDM86i+SCi)r1c +Yc%K$l-N4&!m#fY(p$4DdYrUc'5*IDNrL`iN2!"kTDkYqPNBIdrTkB0KicEV-f0$ +`ZY5kSB(L!+jYf8a4j-4m+3Gi@@8(8cr%UMaQ$f,9MmE4T(0a)[l9q+Ia,mFrLhm +YrRAi0q!r(ImCq0IM2a2r@IJILrpaq"q2Iq1hCp0$pMHjVD(``ePbqlkC)$X'rkR +i6m1r$[rTq-r![alr"R)Fq62H,S3Xp92i6m'r'[mUr#G&HTE#JV+XZ-EqY)M*M95 +8hi%&@IhBK#*)kSl([aTr&#,+mDr([`(rQIM2`[pBr)r$r`5Q@Ikeq0IK2`2rkDe +jc@-@jc@E4R)2LH(ZR0Id)l60qN32Z)%UBZTiV)Gb$AMLE[qeD$AXlF&)R(3Mj*r +"(%QK5p%V4@*m5)V25B`JXfh6PMk9h'rjVZh@5T0f'+KNaYG@U!IYX'ie90,AqjU +fVbX&qi"@bESAK!@l0Q6Al&!PKh5!91`SP#d([LZQ5pYeq(`lD&U15QChjkaD[K$ +k#%c#VICecFCV1i"9@l8IcURZi[4%2HY@MqGdRHUZk%BiP3ppe6eL1mii4I+ckCS +1be-@I-khA-rYhE4425fGQE*FT3HYmR60pjTZCF*f+plqM1Gi[PUE,Nih#MSd2Uh +DE3lLpFbfM9ZfU#4mF@hGCG9ep&*lcT[4icT!TZf$TMj19dR,V6NkkilM,RQ@&TR +N39iJ1j,R*UrHN!!mCr4X`f'fZmZqjcJ$jG$fA'4mV9UG(Uj2iXfQ+9fHMMbbaE* +6bPQfUhifA5U92AF'CG&HpEekbGAl(G[935[2Cd3j1bI+"lBcYr4!S'mcZ!I[Y,* +1HkDhDkq1-YU4,L-$fBERc"@X'Dfk`lN'NRHYTlThZrDqTXi1SC*k['B$GCL2m%b +ebY(98+fD'kY@SfMR4G'+Rd4l@P3I6CBlN`F!5(+l'Q'QAN(f0pAb8elSMILD053 +jAP+hDRV)$KU1a9SR&c2`GUY9cMMDmPQ$eeJq+d0b8dh(kc@GY1+U!5%8j$V8iCD +QAdEq0%0R4IRJGLBaDl-AfY@j)4eDGU3!kA%I4R)keY%a9@%l0A)AkQ(l00eTdCE +YIbij46*aU([ZNCNemQ6-5VMcIcZVFCp@$8jbdBm`48'2QIRb8F@Af-%S[XL6G3X +k,SRLLcJb$adU[X42$bUqb*-0#l%8&&rm)'*c6dmJa5PRVYpe3+P4TmV2r,TM'-c +ZZi*LpYqa'@V5UI+lfA@1Ql2RS'IJG&M3A&"96U1"i&3jd@039AkMBq#dk0#a8&9 +qSl'LU[a'[d99qBd1LkVb'`d3TmT26P@9hf`!S+Vm!HIp9C8rS%D"U[)(e&Y39Ik +!%+@Ur!'e)9592q!X[kVb"qcRk'433*DLU[`"G4T8P6qJ2S5UmJI8@P"9rS#D(DV ++(e!V4PAj!fU5U#Tr`,bU+Rp!M409j6FE"UJUIjVje6'D01rDp8j6Nd&*6*VBUDV +mDHC29IR6c*qUmKZ@TDVmD@S5U#TrQYS$UXUITKk'$P+NU4qKU[aTDT'S+RqDZMQ +UbTqQhSfUmUHTKD+Ur'RU!DQ'3CTj99Aq-Z+&U[+AX3j9PEq-19*9rM+qUkVmCDa +,9H8[Sqk#U[+A8BG"9IR,U1@J$+U-HKQUbPp',3P&`M,b1&AP,k0HMkTDP9'h4PA +jbkMaSkVmCG4489Aq$2&19INca"G9jFq`YP@92m0D8PAq$(1R)aLC"BdDE1KqU#U +rfC!!3&Aj-`XD)GM3'e&9rJ`e+9592d20%PAPce!R3eAj-p448&Aq$(@+9*AIE&5 +JU[`CDVQS+Rq'H+1Ur"RQ@&AjcDB&UXTI6Za69IjbiS+UmTFclkV+Adl0#p9b+5I +fUbTr1I8d9*@rR$SPUXTI6Sd59H8[TdD,U[+A8iG*9IR,UEQNU[cPV%Y9j5qRVT5 +UmTF[D0T!6m!59H@[)0DV+Rm&F9C9q5Z)JkV+Ad&X8PAq#Z+)U[*AX%Ce(,1#Z9C +@9F&i9*@rBN(R"KXD*UV+Am&m+aqXS(D-U[+Ec3p8PEq#pDUUr"A8P&)DAd'Y+G@ +RUD"qP+Vb9e#M5$XL&G4R8PAq5R)c9H@[*'p49Ij+mKC9jDpN[V9l8NP-9&Aq5Q+ +%U[*AXQC8PEq5r%a9qFh@#+V+AdN0&PAPVb5289Aq5[)c9H@[T(kAU[*A8U0+9IN +VLIfUbPp*(5*9jFq5qkNUIjBm5PAjXm4l9HA2%QG9P6p,V&&9rLcV6eAjXiaI9IQ +ca(Y9jFp5'dC9qE2-QDVbCiNaUXUIT6DAU[*RfH049IiXkda9qE28Q9*9rK`a4PA +jFm3B9HA2NCZT+Rq1r%G9qA2N'kV+Rb0fUbTrMVP89IiFF8G9qA1XIeAPcl(f9*8 +rajbU+Rq1EkNUIijD1DV+Rk21NDVbQmd99*8r4idb9HA28Ap-9IPce*G59AkcaB+ +UmZGBSkV+Ad81VkVm9H6-UXTI4CkTU[a9a%j9jDmLEe&9rLVb"eAPVb+HULUrYq( +ic)B`mU@mGfaE$Ub(B@dk$@&A8KcbXT1$AFRB)HP+bY-`Vp'ZT,b3!"HQh+Y$+5r +"JXa64ST0()k6Tp1)F#c3f'&[S")%&2'(EGRK![$-MEYllkDKr"Pl+HbDfKSTiAr +dI'U9KF(TqAiPJ85KT0qYk3HkrlkBqE&GKiiQdbe1TTRUKK3a[8&(RHN91SKde95 +*f*!!JeJKQ8N@0pRL*cKS5rai+LYf-24IM02CQT!!qiqRXQ)(djB`qKADjT!!SX& +Jr)%BdcjhVp%r0hecj`"DQBBjZL!F1ZDQpYd,Y-T0Le`eSbP)-qS%)TKHZ(ZDCVK +TJVZRkB+ElVGaH*bqq34fZFVq"c2`VCaR*QIhe(#LEHCpN[i`mKkY9K"#"#)cfr! +Jr)%JaB)U()bd3p[J@%1l3b1&1EHXNP$+@0"S1+0f(F)I)R#"A-BLN!$Cc6V6p!0 +)E@6cMKGQ)@-K[Qf$1r$HBST1Q0FcJHe#XQ'E$TZqUbY&#&+)M--jrFGcQYR@e`Y +a#`Q[cI)$2H$AC[M@()TIc1Z(')H)Bl4!U@)*e#pZaMXTTj6hGD"pb%Q)9X"'Vca +GUVU"@PfhCR0HaDlDfTq`+q%8mY,NZ9@le[6eB$--N5Q%+GUTDY%4$2R@IQ[5d4R +2mbX3hT!!eaI1KC6Jk(DJSQ'%5*TbSj!!-1Pd9AF@6fiFVlQ4,!E5&PDpBmAdm)a +f)D)KZ6AjQN2jM00kSpXm#RI-lHhPE9j2P&-N0ZEe`fqjAB&m"[@hb#L*52QdD,H +'V*QUE%Di)S0L-Vc9#M2315(+ZCF`QR2k,d%HPNH+)bUYSD)MC!$"M,QpI9%HX*e +f#E-aVrpLb,GBPBjQ&k)KU56MDl@JVh*KGN5Y,@6(GZp"&VBhLRT@p&05bG%Fj$N +NdNZKcT&+MS-E,)*8c!SE!LT(P8T34@QRf%KAK3JKBM+#-'M+Y+1NN!!D%F'5,GP +3ee8h#Rk9U60%4jSVN!"9L4"&T@HbNj2HE*6(DYD!*'2Tj&i%[Yf"&!`H4R3N9Gc +F2hf$'64I-DfS5j@#mdXaFpjL6rU@Eb09bqG3YjX@(Cbk5,F+@Em#E8YF1i4b5Xp +d%D)faL"qHG[bI8h,ec"*D#p"`,-GHe)9Tf'k*$,*@dX,N@A"VN*fa,TJNlfK[h* +K*Xd(*'ajS'F+Gc%hYVb0SiR6BQKhfMIQeFIX,PYLPaRk-0N5lbD)Vk3QY-9XEej ++1BN5I8qA+'I5*fGA8&C,A'$pY9CC,bBSPC[)M!0GT+40HNKRBbDpm,b4e@Qcbp2 +DEb@[G@Ki"*RTRQSR4K"j,94aZKaE9e*#)8eT0T*%G*8Y3T3Vdq93p*&R`Y4&dPU +c'q@SR%9TE(B`j6#9HC1%%QHUG8+XqF4%X8TqmLAIH(i+&Gc)06a6$iTichr33B* +Tc0BERKrLd8Y8,MqaC&jS1BlRZ8MaaJB5d*MCN!"C[pimY#U9Y`)))aRV-Re!jBG +(PTk1)c8kV&'NBJqM8D0'JeAq#i+kfT-C'fQ&C2c##$((%6VeKINYhEE@`LMU1Sp +(l3YiK*m"ra#kc%XJJ,0USF8Za@,XKEXN[1Mj4D1M5biZj*jT-+TZca(%c82$l$X +!!,%91,6f(@VV%Z4"#K*("pUm+2EP%GMK+FA!S`C5*2k5Xe9hXrlUiKklrSD&E"" +Nb!C-M)QR5i[eG2'&@'D$l(@0)hHH[3Qc$qA0'NBHKf-)X,i[1PDY'U-Vc4K%VDY +&h(b%I6@a-e@0K3KT"@K$RL83PT!!%h&1+*T"TKL2AEjfSPK2f9NNCfZGSaCKL@+ +-bbPIdQKm`9D!%@1KJ+c,YX!(ePb2M)P-9EG1$6CYTk*'E$m)8`9GUj2AccGparN +QS%l(@B!J,ELe6V[L*--@ed0H9(4hkA64'(LaPSM6&Pme49%Sp2!*mi+V(!,V!!I +U0)*GC$ea#'%ZIX@9HH4M!K)dfHRPDMla01bMj**rDH&f5AH8eSAE6E8)-SP+@)G +V5+RPPk)1*[c0&'6M!0kejEpJZ$K-Y`Y,5p@BVlD&B`0,T52Q3Y'&&EEVTEj#+la +NV@'jNGQP!`qPGZQ!bDdBNP`Pd'-k#$"$3q5PA@)Gj1'#Ja'85HhbA+dbc5$dkUR +,p0cqU*QbS!bJl3C6l*N#a"U91S'ZRK$pT'iJQD4$P1+f4PCE6-fcS@m&DNK20QX +elDI-Qd#RBFFASY@&6IT%L*pX3RYX@q5J#F(N&YLeA"8T2)PcQjKPbeed"EZPLP) +Ma6bbXeNl+MZH'QZ!CiM8(Xcm9HfA5EJ,(PX5I&30Q)6`fVXQ`4*M$6%U&r8i,68 ++"ErYd+F,bf*Z&'`MSZhd69ILp(EDcNJ09#Sf[B4jNbmKTBjPd*KDk&AQ$0[`2"f +rh(LXcdb")+F55hTbq5E($dkS0cIP'r%!mkllTL,YY,E")&9)mJC8JmHK$YeiUpY +%@"IElYh6@"a8k8HhrXeehQ%)X+Ve$XTfiEPem4fcRG9hhf(#l+M@1l+bF*,(m"d +Q4DHdhSQfdqjpKqR5kXil6+FHdhQ(5GDARFK2C'"UpB,11dbf,Zbm`i4XdiPkM0j +KJMAEHBITe-V11fLU,@Ur-cKmU9YR0AIH34YSI5GZ0(8fG0j"XD5Vm`iL)AGhhN% +!j)lf1dNpp[&8HHFIF2B"X2Ih(@'&T9klGr8N%l0qPL0XA)92I@r(1lG(M2G!VIh +*Y4D(2Ae2bLN"9&'D))%J@LDLHV(5TH*)QcfV(5KLE'e13R'JhH%f(kRc5U9+@#V +eE5k9'TLHkE+FNZAlePbT`V9*YTG$caqCLE48V"b*d3l4C8&N0(3j"T'0P!GU,09 +QVC*&#&Xm1[cM1ChA4c@3!0-fmREf4QU,R0-(PBq1d(,l5RkTi6Gm4*Y03m*MmDi +Qe#pR$d29BQ-HDKShfpcD3qBB4GQN+pcZ@e8SFkae-,JYXkbXj-&iTSbFESEXLL` +5NTQLrSHSL-b0G%91jqfF[XeBUF4Xrk%D+M9&ViDp5D6&eXNG6GEV+,HLl),(#Qm +!DkDJ'V,13p&dPL#i3RBNS9ChT6Sr1)V+-MZA,!JL&CQe9Z-&8G5R4e&c1kG[#aB +A%4@E9,,+8@df1$&VQ8M1%#j4PCMZr6D%66U$mjLVSkV3$A&k,eCeC6(d6GJkT,X +"0Ba,X5++U0mX3[hek*EkcI+`NQ%#C9a@YM@4ZTkRCm[B88A+FI&iCY1@55Y!j8Y +Kbq6SZH@,HMGa8C9fc0I+6LhRPRrqSYiqDN@)'X8@(qDA-pGGRULC9%054@DN,l, +F#UCF9qEcDR@P@Dr2$8E#+6H*HSh+YD"A3fT6hCb5PJPJ89ECh+`ASbPkdASj(GS +bCPf@Q[3H9)(6`0(4hp3U&0VUU)S+ID$j-N6EQ,-$6Xp(RU,qXSa$Z6UKQrMHh,p +jF9Diec%r*pcVTk(faQm&,JE$91ImC'lLh)`CADQ#a'HaKhRpa-2!rQ$NQRNGKdj +mLc2@LA-bF*ei*[29L@GKZ,VAXAI5ZYHl[jcL'Ha#iJS$f6Yp"iY*4l8,"4,0C*F +F4h)@6@ZAr"MGlR-DU-jiU$[a61E'%mrLm(X"'T**q&K3Ti#"L@F["LDq-3D@(,8 +!5RiZeiAiHc'`hcPIYSQcBQ$LBc!`m8J`F#$c#PQ*Ea%$%qF%!a22"!-6caJ$5ii +*RT5mqmXTaX"#iJSBZ00hX*J8!`X&%Q&JbA%NCa%'P[c!`$kRJHU--6$a6$!`m5a +LB!%D%Jb-T*X+%"JlpL*Jl"S$B0&2NepdFfP13Zp&[jfqqAU0I4AlBKF$IE&$JRc +pq9DFLPf,Z"Il*V!A1bDS&c['S&Id5r#Mk,bcJQ,%5c*@!,`qei(k8EK,UL*#Zk, +IF,)LV#Zk!A8PRrjUM)%ZGNa`,RBX`Pb#!JR+)6"8J$IMdBYVaLF'Y,b$TMC[GrQ +cFI9L9qb8,cVMT'KPE!DQM#A"Tb46#LA'TiK)aLQ")Z14B*!!mBM"*qq3!"4bhLY +1Fi`c0J%&J)Pm#NP@5,'*M,!Nlp!AHi3HH6Z`%4U6kSL"`RJN#'%mLY"J5bl""&G +NaJYead+V)*'TkHXQbD$!9X`+p$PHQM[Ue+G&Nl#a*-`q`UjKpMP+Q)P6AjJa'LC +4PVL4"PRbNaKMRli3698PXB@!TN'&$K+0-ID&d5YG9S+kSRq#HNARBZ8Ar3XJ824 +1i,2S(#0T[fm#E2d2+-EeZqE&P)Ued#ZZ01$H+lC8SRG&Yk4NLmjap3lilNU9Ur+ +Lhlk#,c+S)IrK0-FdSpph6f&'j+2I&4ibi$G8"3Nl+6SR4+ASh-Y'Lqia-Hhh(FT +K6&H,'RFPT#dp80!9+hSAXEEd3!&X5qi*fTDmBlJGF%l+HZ!&VBN"hj'L+%$ZN!" +r(Sckr*eiBUpIJVSPlaKf"jf(%qD!Yq6BKlbP*iV3ZqZ"NA6(i$[J[,G-)rJGm!9 +r"aehP81#`#A["),c`S)P*!`p%`J-hBVB&hVfbqhKPk"Gk"E$A-%V+Cb#UeC-`FP +94*69!T39(I0&(6PDm!SG%Y3+h@+ik[AU5i-$U0#M$jP#hb)NP6ahTLd'SB,A8"& +&X&0`!Qpk28Vj6"!QG"XC5ZQ6@BbF3fR%dV48mm+F'IK6kKd9SdUF`kK+mbHPU1) +Z6c'Sf$H-UGM6,i9N@Mh&@)a6'%5qR9Tk[8KLLi%8rF1BqZP[+E`5+5M'edGNm`' +@A!FL$%'K'&V%%r)aK6i$`55`d+pNQ6c3*fZCZ%FDPiRIJ1"P!KhpN5F2p%@HZ%H +4*hi$NFF!dapil0mAGq`GK4fl$84Y%+NrA12B&kGaL`)dpS()LVM8(f6aMEjiLbp +%S4GG"l*3!Urq0*3HkFY$kBNS%5AIJ8b%N!$ARi,3Zbrfd$F+1R3DL0C,Fr*D5"% +6pUkHC+%'2m[aafNKH@'jB,c#L+IPH1LiS0df`Xr+"Fdk+RkAiihMJLc)+(p8q$2 +iPq0IJAmPrPRmFrKAiAmdrT2a2`(r+IKAicm9rfRieq"ILhmGrY2aEm"r*[kcm'r +%rd6mG6GEXjX!H`bJYFKH"ZaF`$C[k1@laG*dcc5MJmQ#$HaE`#i&EX-hpKCJ*`( +f$@#A!2B%B!F!GQa&ZapGIV6qpk`aqG3aHc%%V*&NcE'KirEYeE51aZ5I!!4[c++ +&hS*bpa!F!8i`X,1pKd*Tp36h$MKjlI)lqHhqG%R1LIdFG!(1LAdIj"e`H-(bRJc +a1fcZZDEc$VMIh0S$B#4Zcm8lHZ*Y"ahrF4X0aKc)E6`)AiSh(B42`BH)@IGhpLD +FJCdCapq8G2,'2ki2+%p6),eV$HV62eaV8"f5Y3BP1+V1j)9eHXdD[5i@pZ8eHr) +k"aEP03[bZPL+$QkcDkrED5eNKpG%'lKYKS*)mf`$LlApZ-Zq4*YRCqYCfH(CahD +J*5cDc),0,0Cm(cCl&N+GL39S*U6"GpaqkFmGFT(&*4hae(,NE(SmA(mC@0"G6F# +VB1[@'L8HZXUaEF!3i8'C`B2jf,C-eX[cYZ'#``26-dh`B*-9cmB4)MbS45mKf,U +i!F9bV$Qac[)ApXMFX69D@h,qS1h'Q3&&K!Hjlq'"Z@fTecehDcjDeU-akjDG*PE +bm),"4)3(9BrMJBbkHmR!S)!(N``H'&'$jFd'Pf5G,i[*qY3D#3i2C"@rc%0iN!" +I4Y@IKJJ4(T3Il5qb[A"(',r@BSciBThJ35['kp$blNleTMHP0mDY)8+%"pAJLj0 +@Ra,)Dc$EC6jhVXDIeDAp!('djNB(6lh6ZhMd`'R0Mh+0I4p!(+Xb3r%!H9e@'&q +1m&!F+iEh&0168kSF"&p5LDpGUC)lflYrC@q+E-Q5e`iCr[ae2G(pcIFa$"[(f"U +ib8EA3mI'FHVkZ)!ipLENqh(XA66X"h(X#H4J($,eR0T`B*ZTeiH16-erG9XAl6@ +IJ&E#MPZLKik$pN"fHi8QmIdXrPZl0Pb45Ma`Ab4VBH)BdhFDc`Ib#LD1[HA4Zlc +hD&khBL8%6d!FXM2j2qF9h38AafiN1KM(f&5la-&qj(Z1LD0E6Ch%D9f,h!#eFbh +L0$Z6lih8[T%X8Vlcb2VX4PrLQ80#c1V2AS!ic'V9BkGh2I5"dadfB`,Li*JGirr +jY1'[M(YN98[r"q1@c!kqm56M(SR$'m#iP`lZ6*ekThFlqS(Mq@$Z`ePpNVP2a(' +!Z8r%FB#jli[MFHBq(XF2Q([`kBrha!!`pk&m2-hF4a*lL,Q2ah'!Z3q&m44c(ip +MM,P2d(BA4lHZrEMZ[4q-QrhT"mk6M(Xi$SiRJ((,"N+Rpk8@P`RU2ER[-bD*B`m +b2-'B*Z)i`(6faI%idaQ2i`NN(iVM+53IMf--p#31XhR51%,-GV#9rqL*1K+M&5* +aE*RFHc)1fDTq)SjFlV%p"E+jA'E(ir!hI,k(H,*l$T@i,`jC&(-X$PPSXVZp4-j +34Dr6eCL!["lQ$(NZI9JY1H6NBmJj9QIjqZL*!pMiC&+dXp!SaNb1ZSm2Z)F64el +lF"HUri4GU#qpZ09pp!,%dH3%J3,%#)!-ab&B6ej6*r[NTQ[S"FL(kICj!H*`hEl +GF4cXpQd)kiikK-e[LH2fHq&p6q*qf1[fp55Z[DDK$L4Z[Z@U3`F60jj$-"'Pi#N +Zr'p*h(cpfX5elm"l'XGeV++4I1b[-qfbG$8HU9Hk,!D)4Z0Jep889i)pA2HQbq) +&U&I6CI%#a-'aF*Ck)UmQ$LQ2e)rUia9BJR82C3KbZA`-`+i%V)Sr6Me5Dq)R*Kq +DaPjjHQd+9f1lMq%`AS!i,YlV9p2i2j0A@+QrBQCapqRR3X86FU(RkL2N3Xr9Ucq +Jifbid'(m!)%[YaZR*h$fjp8rdERQ++Gk0UmQMV%YP2I(-E'0qmciYaQ[hHFJdr% +VcAJG2TkP'DqYM49f1TjA6m'Xf1(M!CN9'`+3!+GQaBD4fKF`+aE[L$0`+Z-RQ,Z +RJTPk!C!!dkq!92[2a#CCrSqHMXG&+@Ihm4$dB[a!5MQ(MfG*+HGJ,fB`%"p",fE +['kUiXqIiYa4haXIr8k[M+ZEr$c!iriD1`"2-DbL1TjRA5%)1-Dra1,`6qJJ(QGG +J)(i"R38E4qG+R4'%D**D8M$kMKq!%CJi["+k$lfET-b)UGXFa0F'!reiS*[&H13 +f5DQ0RGXNT5i'Ic1))qq&6A0mFjZNf%hhr(+ET)6cDa9YI2$BckreEUENVpq%m!K +kBAl02cH[P)fGQfI-aGj[3XKQqHa"cfEJh,1hHAID%(6q[3IIp-)Y1@rA8dp1S%k +['1("1HfP),4@G"mp##G3Cf&I,k%&ck`CEr,SGdJQ[5r2cj(b!3!UZJ`-##)8m#" +`@qr!"(+GGmTaV@fr!mA-ReXAhkR!YDlc$M4df[)l`H)l@9bR,qFRISHjl4R,mF4 +jK"rAGq)q'YGCbqq8,lic'GGM1[Q"RdrT[)-dF(ARRDQiRRFLMa%16-2ejCehDR! +p[r01,Dj0*r!LHUF1efcRRHQi9REHNAfI8N2YG`B*JRM9ipVFHDF"er@GZ'ILZU( +ccLaFZcV[()[VaNjqMX2e$Heh%X*qkq)ld2Bl6q"&p-i*Z0lGHHG%A1pBaS&m%Z5 +GNh$pd+PmKm#9Rj[fTEk$PNJ3FG+bGUpq2#VIfBQd)f5bbc1R(6%YGNilSZBR(Jc +Y#,GVKdp11b+0PB+B'qIc[TbDGCQaSH&eUA9$!m8"A0ZbQH+kZ"9Jm-"JJ#IQ1"5 +`DK,*K+r9Q2$4e%Z3!%LXS[E#f$JdKcPr2D0L&kJZH'%U63CTbkfderbK(-Rj1(D +jaH$J(Zi&G[J36pki-R&eiZbZbirKJ4FJbN*!AJmX%"d"B'j#N86H!I-Q&%RN(C4 +"*K3ra!ZNR9#XN!"h805B8*L3!(G3e*K3Q*!!Ge$+'&BiLGj"+H1NjAIb5JrLK9, +'X(**p!j+'40+(Z+&8XD#cMXSCCcFb3p+'41+(r)15KN6LKrb$NSC%`SGmJj+'4- ++(I,1mEK1+(6)1bKU[1#88SDmJe,',N@01*k6FGfPU&%k(PDP$*r$1bK3m8`SVF0 +1DLReFlGjlmc0clrPEDGLp*UGUD*N&Z2#A1"#crcmpA1aEVK`R25RBPbB"eai!q" +L@D`E,U4")SZiX!kim)K5,cUp[l$Al&`18!J&PbdZA!&Fq1Emr$ZrVF(V96YEd&` +)'mB@&hi5LYfL`[RUjmDkiF*G)![pZ2!m6",-LA&$"5DGd!b8(S1SrhMQ0T%52-$ +SN9-2P+Y9Lr1a3F!!(JJr#)j[qq!$1Kk*E4m1el-ABYX(AmhabfRbp*p*q,20"1L +!#)(E!!Dfab`5mi[-RS#[+0%IK6pE6CL0*H3I+C!!H!Z1(i5Gf%4k8-$%Jh0D#pR +K09Nhe,kV`p6`E-1"H0kfriaKL6E2cYDc1VB-*XC1@TfcfZKiYq8c8'2G22dG$*P +TC)UH1eIM[k$4F1)"iQM0MCkHB49KfFCXRFVNC(E`MGEmk%K-3"bV-N2a!(PG9KK +IM["3(#Z'pa66Ne1U(!4I8SQ[ADQ51pYF0AY6C&YS1BlRZDNGfQNXZ!C(AKI0G!9 +[[)pKf$M@2KT[kd3UXb'cI[fr9iH,ip6eF3&al%h)pq2)TreIiYJ6b-%iK)UP0Kc +BCZVeS506merGeN9lc5I3+GPaLaVA"p66dEr)EUr`6I(p,2jEZcCFN8SmF&r886G +aE2LrHU8*Bq,B@al%d@B&CFYj*,%fMSiJ,L#1Y5ZC(FmVfQFZMYe)G$#1-DT0ZBi +I%dHhQMU*dj+'"8&G48$YA!G`@UDY*J)H1kXcBkIj%'mXIS`4VI2+c4rRJX4Z#rc +(f-IMFA421C1RhQNE2T99LD1R'4-3"fFfLZ5C[,EKVmcpV2l,PTPl3q`(FjI-$Vl +a*(-ILF-E`0bA$Zim[DjBDhlLG$im(af!iD`qf3'BL10!"f!LMJ-GJ(ea20i"')p +M[!2!d3j!m1Q2pm3!G!#'m[&d"f!NXBFk!10a(1J!$)Aa9!GJ2)ka$S$%-G%%X"f +!cYU2kpll`EM2kTrqYcHHC0c$FA!m!BalPHeZl%[0pQpHCYbjlc-QL@-2-Mc"Q#E +L1-"dpXAa10-CMq-**"q+ibNN(ipM$23N$URlIFamYQ1[S&A8N4LY%)PMbq6HNh% +XRGal1SjFlX3iKjjX,TICm6Mm$Cr[)9k6UF4pF@amP#Y+("ZY)1#@)&Za+%3aZIQ ++AUHV-3&j2F`CmPakM*-IM'-F1FIU,&mI25YPpVdcDDFeBjh%Q-P4pr%"ph$Lb'X +IlN,eRl!,pD8AYlU2AS!iQT`J8)!B!C!!i6J%kmPVkQ5rhA30[3$j-0dq,d!FVYZ +h1ik$hEi0BGe4Kc$T64bhh`[[Ha,h`ekhVbGal680pE,%c@qli0$"a)hR%%a%fhZ ++#rpE%MHrpCl%YHr!HaV(GDbLNAcXVc2YXR3e(UPA@L`'L%EMZ$bE6kRdJC8ipZI +$G&Qm!29UZLaHJ$Ji&Xj56q69a#(PNIT4IEc#FamG)`ebZIarMDMf(45'aUP(DNh +ma14$dpJV(qP0fH0UE2Fa(-B,%-I&HreU'[pRmJSVp9I-2Ziqr9bSH%)Zp&apK&c +SZAVe"mbF'5jd'$p!i-[YaZN*R2ejp8pdVMR+UCl0UiN$6R@i2XC([$`JdpNHS"Q +[hHFJdr%VcAJG2TkP'DqYM49f1TjA(m'dZ-b+(6iHN!"CX5%!H@T@E"LTI3'cBTD +jYfUrYY`8VBbIB1kH#QEU"8"1[`*5l6rMJMXq,m@GhFG$d)[a!bRZ($kH*F@GJlf +B`8#m"-SpHiiUpq`jrLh&RI(arp6UZ)Vjr`--cVqK)r!%maU+ifRQ0C+3!%2-Dc` +1li3q`N(Q04L)Ad"R`FE4Z9*R"#%l4&T5-2U1(i!4Q$Lm%VS22Jj&6iDU[$U+RR2 +-K2Db5!A5R1b19r%k-1(rYeq1E-'E$er(ZiHT[cKDVc5DA-(feHYplAVeG5Pk$YI +pJ+*R2dllka8pI3SG!$r3Y2GB"k#NAI4-"m![THKjZ1k2D"N82GprrSI!9NIBlFi +6XpYmpp%,%%HNk$NFai"bB@pAc(30[3$j-0dq,d!FH8A2d6J1G[Z-LPh,e@e&6aN +5@`fl+(UQel``XNpjrqKGADRlMX#%SZGRi2pSeiBcRDieKb+&ae$&EL3IqqXX8[3 +FMQ0!dE-hMNM4mpPmQ#k,&k"H6CI&#a!(4pARRXfVLF-UHMiEaa'LMD+R,2YUjR" +hciaj6mq+D5J[EG4@S&1$6GYTcl,l8iiAEX0kFm,0qc0ahC[hqa6`3+jP-A5EpjI +$kS(ChYfXRejZTEhQ$eFi2ar($R8'"rH`(hli%%rHZ$*aGH,XVXZ2&E)A)-S5-[K +QMU`TcqEb&9fQ0)40&fSNF&[[b#peGZFG1MBc@Zp8F#(kJAFBA@Nk%8q8RkQi,QU +r3lS'hTQ'Dh2RR9TFVec16ci*mNiGVQXkldc(YEhe6Z@hhVPem4h4Q8ZpZ2012Dl +C6Pddi&VCH@FQVZXllmc#G82RR@0alHUmFabZ,eKq*kkIih'pZa22#EMHdAkRJ#[ +&3aMD%r"Y[q1EhXpqY&i(YMQ*pMA0ah'Nll#Ir9J(B'36jIqr!q#EfZENfESrSQA +BjX66YCpp[-e*qUa[EA2bTDi0GepeI*Z6MehdR@e1MXKdpV223[)c63(be*0@F6l +EE'b`AV[DYq2CYMAJ*"XEH18fZT!!DqES4KFq0ji!(JKIV)fAfr"$m+!Zf[$$$L` +YEcEBHjLr3eX9l3GaDX!3EIL4H3J2T,fecI*Y(D1'#"%HP"Xmk!apElrfTi08)E6 +FLZ9A-#!"+ZcBQLZ-TM*E"fdhcJ`G)VjBp6dmi#BXBRkq1HRBj96@,6[05R`BJiM +`)2Xi(SLQibE2M5@$K!J2FNIlLfXKipN4aUqe'#-mQ#jid1VjHJ5#VYfTh[5Qp-D +i085)m'"+21`fJQB&`FB"*`C!ZXAIFIaaf`J+)5`F(me'B8qIpP)3@LYcm4k%%d4 +ELrPT$SZIM5d1&bm'Crm)mUkq+`kKDU-9iY)32a#@CMl[bkPCPaNE'PkA@MFd8"c +!Y5fE+Dk,9bN!,``'H'-1Zmqp%4S6R$F*ahXc1lTbhK*Y[TG5EiSffdZTk`3ehUE +1M1kr)[Dhbh[[L$4-8ZS'PBcZlj*Z`2ebIlHmpakjrkV%p`'a2bch$mVp%ENr)2P +j81c[PAMI*rPk52,cISRRek*hj"mN%U[J)YH*1N"B5-rJARbHJ#0e3bUk6bhK*qr +Jq&1RhR((ilh-RArPRE4kdNp#,5YRQ0(MIbN3rm$ac`cmqb2'`rea8Jcq1%%1(mk +T&ElQUf$C4rB*E-ird)ml`NpJBqjZL&RdK"Kp0(MUTqK&aZI(mbXLX%Jq*`3)j4d +F*`30j4dd)&rr%c@#S+(MFei$1GM[4Zr$2@(,kNL+SGPrC,%JfH!0b'Z8Adr1Z*a +rTKkm"-2[hSSb'mR+@,lBqU6MP&bq$qD`[-(&!mmIi(r+iKjrCKf+jFmF6efBk,R +eaN42GG[ZXG6iMLPeAUV!fm*ejekU%V[Z81SCpk`qGkHUTAD2,C9P9eLh'MNV#+& +&QjPYH)&+&XY1DD!+KkCk45AcJf-0l3k0&1EFXNS@G%KKf4DlESF)S6TGR#i0kDV +YkNc6$caIGHFG,mb@24HqEB-lm0lLV&[eSYFcJHhfUD5[`kE[kNTaVU(9UQhprFG +cQYR@epZ$A&aIbPYqS!ImfJcIQY12flcqM5VTk[fMZKTQhBUHa6XTTj6(1XUGrSa +'AV+19jiZ9Ge!VDjEXcQ[BPGYl8rBPA!+H@Rbh+TGDrTkX"Q'b03-CV(*FQHXB-L +hpPZ6MXjiRPm*9$GHAcJABXhPE1"B-cSI)X00Z9%EpE*CG@Iaj-EaQU[@)J+4pTA +!EY4q@*`HRY&Z'1A@j'[1aELGeK[GjQh#E@j[,frcHU+FcSYb+Rl,lBT@DePrL`U +KElXeP%q,GQ[)QUR+CS6,GRCN@2EeDr+D8C4c,f%djr4IJM`X,rZHidaDrN!jY$d +hld2jN!!-R"9&26I+!lE6,Q%fj[9IV**$GY"`V,PK0r6R9*,aY9TKH@TlGN5Y,@6 +(GZp"&VBhLRSfa%,2klcp+MQDfkj$4(STeRY1*FHaKqSL+p4&Zkj9XP5UkE!8SVD +l+N5)Db+%DFHe(58P+*0Y)SJPSDkVEK6m+P0R'e(+c4A)C8H)XM"k1G8p1HR04RQ +XCJe)-Q6rCJPmZa1UERSXpM9NYPH3!%P-V-cJ26e0)cQ!hcX,GVhKk1,TV90m*-F +IYl'FIkBAH369XU+219iraCE8NmI(aST,6KAEahG(k-)$Q3Nl)1r+M@4(Kl'JEPV +ZeA+[PhZ$h'Ib,RSZ*iRp@,R2NR[jBR$PCk'jXXN,2GK-A,)JEkfmReem*ddGK*F +@Tp'IZXDhI"XD$#Re&$iNq5ZAHi8mE1ab0hB*U%lZ,N&6j6k0Gi6Ip4l)252qdq8 +qJhG4IDpG6%MCkX)F"$%fI5XK4dNL+ZAKV!4Z!K'rSq8q43*b&@%b,RH6+2%hP58 +*0!Q5pdd#a$je-3%92cfK,GE$jU0&BC)TEjPB*DB6&YqX@JX0L5e0[kb$e2RS0eq +IbRK3h`K,qcKjh#4)lXjZ5PMZ,M'QmZ6H+1mH,`QYHd$GHHHG#rr+Dcjikj*pi*q +F)aq-D3N4mcZp,cAE[rN%Fkrq2S1632BJc"--EL+1!`aZ)Si$$'jI()mcZ2%iRQ" +H3h%mcEa'%R+)HBh(FB"j$BAa&21DL1-*jM8B5-Lm*R")!(C[4mE'B5B9KJp"b)5 +#*3@MlhJ#jUH)Bk1p`P+LMYBSSNNF@bEhRSa$0$chaH%(R1I5ZkF22l`90HV(@N- +eUP9IcU*PIT40#Icp1(N%qk,Hl('EQ[k"5MAiS(HR*QfdPH9ZY*MPEX5JR8Ueh)d +@XpbGHRAQT%Ueq"Z0Ciq"5VAi1G&R)krY-9#TPJ"Ga96pVdUeh'[q@k9DlLI')+K +8brf%YNTeG#U[qI@&b(dkH1bc1fk6d,3kCr@T`362a&`#`jMqR,Q%Y8(3Sa*IZa+ +,-+jV2C!!hI%UA[[R%S+[I$Qb"@mqI"h[(UDjK0&kT8(Y#VD[AZpVekXrD5l"*c" +2X1%N6ZXm`9$G4cMG8ii"i&EqVEN%CHiM-K%0m@mU%Ck&$S!I5#9LV!0J&,$m!4d +!rip+a&J(31+BD!,Ne4d1eld(40eK5#AY+A@(8E8e6`$M(Pp0)"GAXCQ!Gf+M!2q +%mViA3$(I))aA3U%qPhYBCm+HE#kAfI%ir!fIlb&HNkR%IA&XI*3V5KbSY-QXfDB +'eS%Z*MGIdH[d%aU(qA`FjJaj,Mh'b3r'-BkFBh@@ViqHdh+5%fI5+6R1b9(hmIh +RI`KXGB6GlM`aZmeh(ld!F4J965[c0ab(8qIEh@mhA8-[3$j-Ymm,%)IVpZf1if# +hckKIYPaYiVMpA[UPpm"HYkqRDmd,)rZ8pirHeC@kl`K--f$p$2`IlGT`TY1ejP" +2+`kMIMQ5MreeTPf@VXBMp8U,CD3lBZ-`kTI)-KkZHp0Pm3,8UqQbH!(Li+KUjE0 +j0A&)HHcZ3Zf2idLS43RiL"KK-m(8+fk$'(#U(S6(f%N91S&((i4IEdI`C-5FSGr +QShj"(bi[K&rA8Er1@BJ6DhaPrpMfZjJLaIK*I,(I#cm(1hi5AqaAq8`QCDX2TBD +UbDF`B1ZAr6XQaITGX3Ff&3@[f0Tk,rG"ML#+#M-Reih,kmal,rj0f%3lf2MGak6 +Bpclr@GK%NjL6Z3+AFicIBaXBQ29,hiV,dFE[SHFa3CS2DR+1LHm8Y[+*PfXBApA +B63cBqXek#f*8[j2IcTaTrC(,'K2I4qCKQb4aI`+A"[2HPHq#l5MMppY2K`EbSmC +[lMmc0pD[(R%(CjNi[T1&!l9$ASPeK[(laP0KQb,a-FZYGEEUpf"6[IA-2AcEqPh +f+l!GBra14Ed'CaUr$Y4kk[r*Her%j9`6hjHC[fR'VrbLGKaGh"5ka[Lpq%Z)ii[ +'la@[KN1Y[!GXfMUSZScaeBPI90mIiXcjG12Am$ZiI-Vi28$X%Xd"JjDI4R`fheA +Mlf&K@,rTe)eqYr(lQ9pQ!"VIDrLSMH0Y(i9YT[%l'r@G6KUr6ckA"@cpIJ*eA'( +mUPlc46JFDrcqp'q8f[J+mpiRL*P5Tjc6'HXYp6"JML)PkKZrJ$Jq8JqM6RcN0rm +0T!DE3SGkjC&IqIYBSr)HZ"[l4AKjfc0J1ej`mGXY[-cp"A1Y8iTPIpYqlkA8EH" +0B)ek9EbmJI9+A2KpXSeRNi%"U@G*h0pUiq8(2m"Be3q1D['bURijE-q6I%4iqG, +IKZhjiKIKjGDEBAZ"m6Y[BaX[lfDrl)Ab(Ma!F@,'2m$f)SRlMpTiZI*ff%iaG'8 ++mZ(`XZN&"$,lhNXreF,,UTmKpT!!Iq*MJN$aSilmpL85(cE&SDq3!$I-&V`(paA +RlL!q`4hNR)BkGRKjjXHBHhd2A,0i@C9p"4p5[fAY1(U)rI!X13YHdX,,h(9r4%" +4(K29`3hN''G)rSMIi3'Fi8cMe`MF9EbX'L&28UEB00('bpZ)2@FE[lP[EZ2PZDb +PFicIM$pYi@99N68rcrKGLYT5[+akqD8%-Z[h,["1KjH68A1TjjLk[1H9518IQVa +qJ$M+Qq39h'S8[!`A2`J'[`)X%K`eH"RkT@kr$jF0JTH4h`cQcq&Pj*F'IVXkrXb +I%fM8lr0YIVQ5lB'ALppMlIFHq`hBi)$J+,a4mA,ZPf'MT[$la6DHAIGE,'$PHH# +[iZ9[-PFk162MR@fmI2lV@C!!'SI`!iHA6Em)QdkfC-JV0,kEb$1DM9m(m%Ma-[F +ZmKlY)'H)aiS6,F5)#bAZEl6`-RFEmfT9Ri,cJE-1,qpQE("*`THF1EbF3Hbr@(J +RI&,jjCFr$C[1ce@3!2FS$Y94"d3RPfB3)aARANJ1efVm&J0((9jHH!dFAL(a86q ++PjXBfe,M0j1F@q1BmrZ`DGYP1@VGmFY*`-l8,mKlp)Dd$ZT[K!fm"AGT6'ZHDPL +lbihI'A0Y[0c-Q(9lKG@)@r%bpjF[KF0+ihFQX8ha-RJM!G(kRFJqJ[,,Mj0V#Yj +bEJ$(GALjk6!$Xhi2JQmj[&a$M)'c5-LrpD)fA[lCpI!!%mMV[e[%5qepm0lkAd- +F2bpi'IUPYM)I&`PH4RicPr!bmJ[)Zl3qYK1MVa!riPGqq6lL(2@1(cd$I@mZZH8 +DmEZMMCFei!3Tj02J+pc8i4BFTGhic5+IYhKCYBdaU3c$62*4aFXjRb6`D4adDbe +HjYlc0YLdphEQY@fm2*CF3AYlY`-A(9lq$M&5Y@h1CYdU6Ya+EU"MQM0IhXE,,j! +!XeQ0P'!RZ%,0VHDp@ci-$jh%[Bbm6I(bGH`pDHpfjZIEr(,H2YLdMeC2hUYe-i[ +BVcfr@Da&aENVb$Y9,qC+i,A$bjGp%!lD[cZ4'+rpQ-GBkcTV-S[iU(%X*aI4[Pl +hP@fmA(X((-!&hU-qY3jQ-rID$DmRTLSIqMLaP4a#%qJhD6rQXkaKl61fShrQq18 +FiS6fD1HcjkGi@FYHQ,CN6b,I8(kjPR@J2HEA!$-FAYjl2aaZ0(iI3,p(m6,hlU[ +KF*1"Jk2!jaeHIZXEm+#R4(cd#aaHDNq3!22Vk%8&#rfBb+qHY5kiD2!bmM[KrBY +i'IS&,[Mpj&[UBHeS[c1i&,Ed4I9'J2FL[r6(Q0GEmU0"U-lq!h*qH!GjqQYFY-m +D[CGk0hQ4a,H9G46eJ6j+[[USq%9mG`eamphL&q(k5F6)&iYIP0HCa'CE6e2[jRX +kpR3@H`1f,UHqP4K+EdG11IYLQFK[@S+B34m9+!DVVM&q"RI"$HU'IU6'Gbpl#@! +lH%0pDRbrcCc"VBJ2hQMMQlUIH@9X3-lTa(iEhp6DAE$G+[J(6YRiTPh-AX*25pa +ID-Ih&q3'F$(L)dl0hiRX4`SHQR`,VVMmc5*I[%hU"Rc4q$l$R!V2-M`$2QRMQhB +0qbjJ*['"UCUrVa&li%&bjK'r0,i9l+hF+INM[fqU"`rfq9Dbcr5)q%AeI4&aeVd +AeIHjj0aA#mjTMjZAbe((H9iBqJ9AXIITF#,d5chVVaGa,[*l'6RS"B+,NGpTj1L +@*ehb+@)-25k*qra[Y[S+,4[)!qifIJqMAK@r@qki'al5&b+60H!%LYmYIHa9r+b +*lf1IDI'UPRZ*PA"RmN3p@jjab6I)aHPT3&(TGeLqd[+l(i%0MS!Ih-AbSCER%#1 +B%B"Z#)BTVfVCaIi([3Mb6Er0mUU@-mNrb#(j$[X3,D2XC9LGYZ"jk(FVVfUjR&b +"RLHi4Gp%mrflj-aJ$[b*AT6&MjE,f#ZN&b(em4$kT-T6@rDba`5ITH6S"9TFDAN +AmHqATHlKGKCA,[NRpUASVm)AkHpE2Yeb1hYDp*VNR%%FX(bkj8TL0cL2(hc#mVp +,(N$YTYM6`!qFdhTk!AZMEc(j[S"FcI+rPQIr#@a[0Ai,`#H8rl8-%#Y9@qj#mNA +,reVZr@2Bk!@"Lb&1Yjar!fcd*55%G[3DPIqeE'F[l1e5Ir!'fiGSZBGe$#lK%[C +e@RB5MiQ&&)%[YJr4dX2H!Ie!H#TmAZYX1V(ZIZ0h&A(Ai@Z%FrA%Y@V`-rK'a*p +@XRIVhJ[pdKTmU&`*lZTX#HG'pKhSDi+lNGrCl%FlRKVjR8Pqi2!imV0(m6Mb1jF +eBI'iGJpV'#iMpI6Upq+C#iaI$hZDlc&qh`6f+"lA[S3c!-b`52kZ3rlU2K2jeAb +G1D&A,qqY`fb+iR'YaCTmd-6G6(jMkllf0YE5H`8r`VjJlIAXUc&l3PlTY9JFVEf +Er@CkHK*D*cL"iR&YJl-(c1-3(lK[mEK@%qIJ'[!fkP,MZ)UF"MiV)EbQh4HXI6e +l+!qEpqD66fZq2dHFJjm5(h-Y&SGU[m!Hfb2'le(N*T-eITpLMr9$aUq#q'(aZ2C +#pX8r,2`-h,9iA*XRYM+E!2l4al*iA(ZBFaM`4$RRFDl'iR(Y*,NSr@(i"lc&iR& +Y(h2$M!Bi!6r@HJV)JCJ9NP5rP[cBiR(YQpLM!CI%lcEJVq*aEIU[i%%Hj&c1@#d +Helk'r4*kb(+Z)2r41VL(Xc&`$3RKGZ44mEMQAiP&m"(b$IC8#5j'1(39FGRKBZL +AIMALbq1LcPEKpdE'lA!ap%X9f@0fZ"MjQ6Dq`mA),m(&b1m+jY(LBR#B-aQ#Kq6 +e1qKa+Li''pRRJ*0+2LjYpf8$Mle21)[iI3am3R%aZ*Jp1qCda#m0,U@i'&c"rKb +FL,M"G9Yr`@@XDASJi"!af6S1hNHq!QFNVmcc@$`,$[)pCQdN[M,8ZZ*LF#(R`1K +Ab,QDleTF6%IF"Z`#cr$A1#jNri-j,iRM5[JT,JEVLIAN#RckCJXA!ddHmr[#UjL +RXRJ3I*Jc223m*B5l-,HJZ"MF6Z`hQV"5FQ&r+0M#AM!FA-jYa"f,Lm(PV%Z`QMU +!$ePF$,l)@59QCq5Fa$JX,JBf-4Hq6$f"K4BAJmpbGSij)2cJSeT2(rikE25J*%p +hXTpPF6%B*YpPlN2U!(a5A!cHcGNBH+MiY402,5i'%B6qLBR[G[*XVB-r*TFJ$r, +HeFLIiQ,`,')k'%[qi0YeJSX4$[d'1IhR"4FMr,X'lk5lScK5ej*RJqFXK54j+HX +cIKpK6i(q$2Q'%eXm5lf)h&[QdBMM0H$k,SlAXQlSABM,lHJ9Z6JHCNm+h9lLS)H +RF@cKc!-e+1rG#GaaFAb"K8#249cZ4Mfl11lLHq!cFF$,0BjhN!#Ed6q4phi1m`m +ZMUm6NljLr1j&cpM&F42INck2iHA8KmEa"l3amb@PfJ'HkZ+Bc*NBfb00[`(mbF8 +aMcehqT!!FMU)B4T('fF)Q@@6ppk+ZR&aG,%'kFq,bp[!Ue`FGa,,G1qNfmNA0Bj +beJ&p@RR[RH#a,SkPl(q$2q*b2fV1aG()@5aQRD"Tc,9S('pPIi[C"k$*c+PXJLT +-3Q$5&GE6Rp@YBmSpk9HKEa@BZBHbUrMfhaM(Mj,,VM"qpj+6`*'KNr4[IX(ih8@ +mJ6Y)("Rd(i29aZmmeSE-@q(h!(L5Lkq(A)*FL9mRDph'PlkI2AVi!MK"MM@q@cJ +,`Db3!2Jpb,P2'epkR[b'hUciI49c8#kq9a06rdj`JPkQjZpfpM$!F2&l2AQQaVH +B-kAdXX6[DqL$Z[`eXkm$Ka@r[m6E,ViQjZE[MCpT1fKm(bI2Sel`)kmf[[5('"m +cVH,h9qaMDA`"HR2DQJh+k0fkq'i%rp!0LS)+X8IMqbAddJ,6XddI)Pr5q,k+rNG +JHVETPb%(VMkq$Q`)61mSI6hkibkq$(Z6fS2k1(&(ijZ2ANaJ1(93*6r8qMJ1[$B +`R#*p"rQSa[GTm2M!c#ZR2m+kXI'PrcrU1$$cbZPI*CCSIAmEXhb"Q9G1hd5FeIL +ZCrlX[(,kSqM6ZIJqKjR2)*TArRm!$3e8DdaTBR*KFQPPFbkjH%3(1q*#!*!)"c[ +N4&Cp!*!3$4X!N!MrN!4069"b3eG*43%!Vm&$Y,*[ZfS!N!8#41m!N!Bj*3!!F)m +!N!BhP`EiMZhc,3NRh%f@Xb1,,ZHkkj4GR3[P$L+Fm-b&E1QQ@8GEU-`Mc'YK4hk +4m!92$FrTiCQqEAc5SY`ZX["E[*i[,eN)AhK(EY'ZJ8IiBYUj(1&(q(*kK#mH@FJ +Qbi$Xb2()E4H6m)8XI#%,i5k%4rC&&PjNmI)LQfbbm)8`V2#kfV&Lbj&EMPh,UGX +R`'3K#rQ&E,+3!1-,'5aNX*!!aA@h$[1BH3eXN!"jD5L`J8fLMIcXlHADq4N#l0+ +YR6fY3AlR0FZ,jr*mmA*JXmj*6Z+AAAU,%bqcmc*lXhFKbjXCZF91XJH4K5c(&l+ +mC!Z!"4"`UpH%H6E+1YVP`Yr&C#eq6jBMLr%,J"2mk55pdPD@YD-SfK4&Y@e4IFI +C8AhR*9(ddSm5mrPD[BETI*ACFR)`c[-dba[cHABiD499V#AP#`el`IFRR0q+STH +G%dAI'Ia(mLZflEaiail,,VViXNX[hVAcGDqMSCkX+PJQ#[eE[NHr!(dF(a0`fpb +&1X2a4,Eq6+-[$eIR'')he'kVEDlIq05p1"9K4fV4mH1$`%H1er6K1LHBI'qi)iT +HIebr#[&(QmpUCYfiP6ecAhR4YZMFfZr8EklXeJ[e4lI@ckppCG0N"-*&lSfL*rC +&jirZfhIZJIQCL9kHA*GZr'YAB2R,Qdam#Mbj-PrdSqA&HPD%5q9HjC,0+6(iSJ1 +hMJb9LD3Mh#5kX8bT1Lae+fiLb`IQ'+6`[YfFHqaHRcIS#jX$JTa"#j2,3)!dk0C +kTrkU6AH13+J(2j`,GGYIAAd5L4+HD&QM`4Ml"`MB"SL(qpNcJ-1P'H'R@YhLmU9 +SN@p6r35RNTCa%KMdF`MRTYV0p4BJjb*YXVpmdFY(#,&3KBP[i`"De(F"*eh)pc* +KL2KqPe0c0rAG8D+!mhfG-fDq[e'c5mR8dmpmBc$bcEF-SlrjYQ))8[MA-3V0paX +B!mch3Bb"j[XFaL$cr3A'B22p'+2)!*!!1ajL[PNB3mfh"Q1BqCSap"a$q9k-FCE +jASma`Rbh@,rJqb,'522p0FDSi!ZU0miaheL-dHCEJP&X2ZkBqmF([T-(hkXaaTR +[h4MMcIGaM!RQqa,'420p(f15S30p0GPma%maAbA'922Y`CKQ[QX`TT[[G4Jcc(F +c4SRj[SbKF%2lk'0k"bJ!)fDEMcZGBclZZ04mi-GFmc&FQfHqAmHBEllI`eKJ[YX +0Ir!pL('ZqAk)84Cm%H')QLPT(hHpf(`V-+JGh`k-THD$@S!Yq(i63r-PjD1hbXh +h+B`+mrd*"[f#lamaU!Z)SqiUmp(r+mh(rDibhhU-eHB$,k[0pe)-F!EIQc(@QZm +M'1[-p`"'MIRS-m(S2'%dGH%$DfV04mpX-"qed@[ipQ,8QHpDM(Vcr3j'JrPq(f1 +6qHl%D$3IGlrCI(q2X5AiBX*Fm!SI1,,0I26HG[04!hf(la+-RHCl"FBZmp&c6$, +`86GBK1p2-EJhI(q(X5riiX,d*[1"@I[04hmH-"peRfmqZ-*"mld'!cc(TcL2QTS +i2V#6hX6h23a`#8S#ElR3I1$[4HDM9U'prA5r&jX2A1'HmG&EPjV[9S`@mpf,)Gb +phfF`Z"rejDZR,cFIR1%+mi%P3SAceD[20ameA'@qhmB3CTm[$J5'ilXIi`AQJiZ +md(c`I("!IIh&BB59paIq[XKmB!Gm"arhqa,cJG0J&ljhBX$lm$%8IlRj(X+Jar( +"4AiYq!V%&9pT2[$b9HD$2e!A2V$eH[24@h!II0c"$HDMIRJI[TX``("mm,$I-Kq +mmdEc`6[T%AcIa3!(m0%(V`fq3[&*HKBI(!RZJ`mq!0I$"rET@C6bJ3Y[0"rhcMh +J)rj0jRX["YL1la-BEc%IZ2j@mhd(ifhQJjZq2IJ'#1IHB6ii(T`D(r`(IS322+! +(mB&0lc)II3@ZiL2AHmc((A!Rq,k'!HEM!erI&h`$aFrIEckik!I-"kk$,IM!e`q +C$``&5r'"%I"%I23$rBJ2r2Z`q6k2J4mIq!II8GmJc4SqDMjimKqD$dckQ2RJ-,H +CMlVKK[M!Y6mb(cd-,mE((A(Rq+MlNqDME[JG2RS1l&,IB0dhZ)%2IJJI`FGpImC +mB1jGjU2@cjU2RVREI-`!Q$rJJlG41cl`jTlJ+a)rKJ[JJfGq`Aa`R[[-"kC6#ck +`!cc(ahh"@I#TTaBqmA&mri6aPH!E)Pi)cZ#MGlpU2MJE2"SIA!8F`!G@JT2ik0Y +[Q)rD`(0mB"A21q`&(le"6p!,p!$c(R!CVXPFKlN3mb#`NAN1FacQ'r3imbCi%jb +02SH2`N2"-hJ%h"2q`4b'Q3qc(QBmc(DBkF#$c*3@EN,rQ'NC@-&XJcN9r8+Id"r +d"GJ+TS+PB#Ki#rD#"f!RQ!PfJ`hJ-lJ!,S'CB#@p"MD#L@!K'!MfJAPJ(4J(YS& +TB$eB!Mq&Ii$jm&$i,I`9MN42`c[K[f!N["1Z#-q%Am)ViC2`5,!-M)%[`K2"8AJ +KI"#H$"H%!i,VF#k`#!`#Hm!&jN6-KjJ,-3pL$J!RKmma"f,q!jF#Vq$2c'LBAB' +am(pi2h-U1$qi"mpK4X@X#0l,E!MmCkl"$)MC$Y`!$X6XKaND1!T1Jph-bm!rF!q +m!qHBJc"EBDE#,)9C$$-BCLR-8*LG-+X"hq(eF$`i+"M2c)&C!c-HjJc-&q#$i$9 +c&MJbR)4j#Pb-q3Nc)2!@cX$FK2N6FbGi!Tb#@4-B$%H$mm*eiEK`5,Ja("GZ#kH +&@m1GiE6J-a`@lJTRKA[!8H'QF%ki+*`,lJRRK#r!`H'Cm%YiTI$*cLm@E6ThFHh +l,l[m"bIDUBeHR[k@f@F2)!5T@PTI-0J*[RalL9,32(MYiYSe5EbFj,4%@kE@Y`H +lkk),kLf1pX*BCSJfU"18dSJ(RG!j(25q6T4#R5mF[@2T,Xr'mqfkYPr%qCL(ajM +1FcJ0$%rN5crF1"U[q'[Kh[K)20@1qrfN2h%dYHQMqffGQ@rXRI`K-C@Z0e'D,Zr +jTq5fQFqd%QGK-bRbl2SNAqXhe)(&#pql[h&4EIZpGp@fAhI9JER'rQY@SrrI@*! +!9E(e&9G'YAd3q$%I[q!9Hk19aS%`X*Fq[2Ei1)JrGkIr8B0[,-3pfQVqX@mVU8H +6"PaqKP'4#fX2AA0rlEf[$Bq(EP+F(KB%a6,qTdUI4TV*FBXC+c0fN!"aX4jc-D* +Ka-*BK9%)B`c'CBc1')8a%Q0FaLL+841M%8BDM#`BKc(LBh6&5)`4&5-P4QU-daL +0-"CM0-#BM2%5)c('GSa-'#Y#VaPr-9jNe-9SKE%+Sc5SQ4Qc-4TM[-,)K(%BiaM +','C-`pL&d3`M-M2fCdc'U)9a'L0'aQ@-GaJ0-JCNE-3iMT&QGS6'H)H4&5-EZ!( +M0XDIM0mBd6(+C*6$H)ma$f-m4Mk-%KNc-[jM,-JBND%#(3hITFXC1c+10'-e4Qf +-d"M*Q9&GGS5A(0eeMH(-q)ea(U-ZaPZ-Z4M"Q4'A'C-a8Q1FaJL0d4LM0XC[M1% +Bc6(UBVM#@"C1bJL@%5jM@lJTieh'[Sa$'IdQ4m+-14P[-QKKK*SF#bG([!aDc*L +A%5#MAXDNM(NC#c)+C!`)3qXDkjPa(Z0"4QQ-m-b)fBbAc8M6M$-C4c,f0'0%4SL +-GaRc-ZjPK-YmL,%IifE'ei`hc9McL5pD2C!!rpp2MdRX$V-5md$82[-T0Y(hf*X +4DIRm2$MQKj0`JVqEl8Q,eH$cMiDc!I"6[q@h`8`YLlC1cHfHhYVBZRYbF4+cGQC +UdGlLfP-qp36G2$PZri*NN!!RdZeIL!bpqF0Nk)R2$I"VjqhjEZTVaDScSpUqQck +fZX*GFC*C6T&B2H&Nm,8iQcMhFalJ2*rc)'Fcjr-if8*%2[+'14RiUTVd'q%BCjb +c(bI[5rYc&R!@FJlN(-3jQ,1)F`MR8-jKR+-iLcR(F)lP(-FjRR-#jd615Cb61DG +`6Z@FaMQGF`CR#HG-cPQFXcRRF*CbcZ1FclQ!Fb(RZCaPR)Xi&h-Zi9c+ZBac1@F +jC`9R*HF+cLV1PCbV1&Gc9R1Zi9c,ZBkcK[-mc[@FYC`E1$GbeR(@FcC`EZ*Xj0c +-ZB9c+qFfcZfF1cKhFZlLh-fjTm+4NepV$V163A#JBbH$3-$*#Qd#+cqX-5Xce($ +T4%-ppL9TpqCrh'Vbhr8NR1d[R65eY`YmM0ZHA)M6p9NJ"NIKm'C0mE[Z0f[fJ6G +TTlrdJ13-X@aqPN*,58G,PU#I2K+DIrRDqaEACY1P2-j[L1EcT*9eHQNl6CBEJ6f +h4-fie9KFL`ieTV*1*qY'9bIG*%r,')pPPr4DUe'a4V++Y1M%[BQ@H5mVLU`lm&C +Ql5b[R*IPrC(h80TEbZ*mH4#`)ShEf8VP[65qIZ"EQA@,J@rel254T&[d"rlUEPV +&VNeZH+ULQU5lIX+hpkQl)5*4KYVNja@r-9P*KiRU@RPlUEUhZU4E&9Lh[R4pfPh +1VUrUD#cG05Y9ZXE1`,0jS9KI8U)V@qS+l@N+YhcP5NY@FbGH5H5iV%MECGV%c6G +ddieGS@jFGDfiV8a(eLbS2&mj%Ka(XP"a"6FKMN4rHXeC'AH261BUfr(Y#9H)Uf+ +3!!jRG5Gd"EjeD6F8ME-fDpm`G,VCkj10F'8i'`BALC2HF*bTeUrX,&[f"&K8CYh +V8U[lF,HIf9el!&,9,I*3IP@H$f)!"QQEIGED+p0f`RN%`0,Z5q01U'A99$$hCae +H46QPV%T#qP9j['51jR"(eGDCH-k[qN2j9XhX'EKUjjZ9kf"@C!0RSJI@TIeL+GX +`2'LZm%AeKBY85BH,J4R`fYr[$qjMIDmB3&9Yh&S,MN0a+d6ACQPhF2FEf95jrNJ +FlX)&%)9ZKp[YT6JNU8[DT0'Z4#2MU&M-Nj!!$qq+Y"mk!+IE'pTldA)5VKK[6Cb +(+m&C(iH@aTI!J[VF'Mh4*T[5rVVGNS1QbR9aVc@L,BkhEK@rEhUMPq9&3lhP+b1 ++@bcS,(j9)drkfAVH5[S4a+@qe@l!'FQZ3P[@HdVU#r8dNk)aLGHSi5)CHrX'lP4 +6NQcdSU,9aLr9TpP-bd4Zk*laQfcLVYNp[3HI4er9P5bFf$l4Afd[460UdJ-d,6G +D[QpKTM%eS6biDq+L['Kp(4[AZd8+JZR!4[2Le0KCQlE@NPcZXY(EERULZP0fL3V +a0HF2RR"Aa1efPR9KIiGkP&3mGFR8Dei6%M8fjZ-q1+'p'j1MdIcdRK1T+G,FTPH +N#R%,%DF8JPHGjIe1G'KUENp9MBjcLm1YLNZd4mh#E-2ZQRTAc-k@)DdGSB,FaM& +iSIUlj-'bMhA5kVN$KkSFkZSZ"+Tp8hZDh'J#9&DQHEpS,#3V(4L&liS`2T*'G&) +9ElXd[IEbjBZUZT1AiD4)K#BEe3Q9jTFmqSj94++CR,Y24UX@FX'UIJeUhT3-fAZ +#['ZFFa0aT3Tl#&,hS%Y,Aq,+q-3eQYYhbZFbR*[*ANBk2!f1qJT5fIHe4ffSSG[ +!H0Q*1fF`N3T8!6T3JrfqpZ"UdYATTXd%*kp+3VaNFXH*T1kJ!(6H&A#k*@p9cYX +'([V#LpH*UcT,LAK-HDqAa(RF$3LZ!YF[##)eT9"Yk35S@c-"PHYpH(Sa!iXVXRb +j(dff)#SY`1549ITl6lk5#(k1&'PhT3mD(8SDcEMA+ld9kfPlZ6'p8H4a2pUG,+f +[V#4j)q6NLM8fU*Q0pLQLaP$S`U8f4AXAJXXX,hD!@Jel3"*e0GUY0KaI9*BVJ,9 +bFClEZ5KT4c2l'q+F&kC(5DCBJCZCqcA&idX9ledq,SAfMLfAi,!#+A&fBcEZVUa +$+pdQQ&1@9P`1SrD)m[Tf$5pTEQ0bH6P9P#)C$L1@&9a@QSq&0QU482`*flhS,!* +km-,hR2AC9pr-Qdce,N@pXXbY)cJcDMamq1!#41kR1DdfM`2pc,i69#Eh`E5kJqd +'RcIl"XjeeaF-ec[rG-qVmX5D#9bQH1krAf`NAQY3I'Mhl0@(@Q[TFR8chJTL08" +RL"lJ9-pfI#rL$(0'1+1FHCc0R$(11'FrcRc1rT`&R)@F!cPCCcDBXiKc#1G3cQ' +FScQ,1FG`MZ8FacQHF`,R4-j*R*-jTh"1jCc'1Cec"QF*jdc1@Cbc1HG`cZ@FacQ +IF`(R3Xjc1FXi&h%ZjPc#ZC4c'HGbcR,1#Xj+cK@F9C`V19GaVZDXjPc$ZCCc(@F +0jhQFkcPV16G`EZ5XikcRE1$Fa0R)ZCPc#qG@cQfFfcPhF1lNh-A*rTZpR2XiQcM +hFalJ2*rcS"l-(AdUjeLT6H#RhcZV(2&pFrXQQp-6diGX8@IfHq,KP0eX1ip&lZQ +bSKm"cL"RL*0eaP(1SCc$1IYaaMJ(F"Cb&R#1i"a9l[Gb(RM#&p[(**P20PEc(AX +8eP0(XNDEdbSRc@MKThS9MLc4F4LVYb,(Lm[qfGKXlUjFfITbGpTe"mQcVllFhIA +HEHrpjAUJp`kkiVYbG0hI8leikSjkqU'eSYjqXJYJ`+RlIU*h-kb$96Z'R,$'aLJ +!B(@3!*Q(X#,)+!"J$C!!83$!5KfM!)!91@D'biSLS`#!G8jQibVVQ%3"J&ka*!S +!p2SL83#Jed3CV3LXH4)&!(UYNZ&6E'39"3!qEE`@"3!qE5ih#J#i)e%!i&H-+!$ +3bJ0%!B"IUj!!4!'!AkZ04!'!AkZ,4!'!AqYr4!'!AfZN4!'!AfZQC,f&AkZX4!' +!AkZN4!'!AhFX#J$m@YNNkhlm@Z8N#J$m@SFP#J$m@KXN#J$m@QmP#J$m@L-P#J$ +m'YU,!J$rBaK#hIhU!hP,l2m#KLJ!m$pT[8bEdkZL!##JRK!&!!(GPbJ!##KH&!! +%Y!T+&!!%Y0j*&!!%Y$j*&!!%e2HL!%#V+"!&!!(eKbJ!#'K9PLJ!#'JGPbJ!#'M +ePbJ!#!J$4!&!3'[#4!&!31Zk4!&!3+[!4!&!3'Ze4!&!i&%-83!3q,4K&,iIB-K +m1[$h'+)!)+Jq%!8!3@'0+!!)UVGPK8K3I5J+!),U%aNX"R@2SJ!JU0T%!8"3kke +%!8"3Uk4%!8"3Dk*%!8"3+kTNafK3Dm4%!8"3+mC%!8"3Ul*%!8"3+m&%!B"@K#! ++!)*D+b8+!)*DYbB+!,3k"&%!%&42L!+!i1-BSJ"!UdB3"3""EC)@"3!KiD8S!!J +*Cd8"3%MB)!S!3X)883!38Xq,!S#3!2T+&!#%G)qL!##NA+)!)#4X%!8!)@'$+!! +)D4@D[&`)kHj&!8")kmp%!8")UlK%!8"SX'S0(b[M4!&!51[Q4!&!5+[@4!&!k-q +-Mq#$(iJ#J*!!&"k)!S#`Z)FS!!J29SRK!fG&!8"BI5qcPl#`3"3!K09MSJ!JV2Z +5jdIK`8CQI+bb%`8!BDf-%`8!BI%$83!3eKShH534eTSh83#JP6')!S#`9XE*[$S +X$L3+!-,Df#d+!-*Ia"!&!$aR-!S!)Z*,XPXLSTi@"3!4iEdS!)J)Fd8"3%4i+JS +!)X)T83!3%8D)!S#)HNm8!%4dek)!)+*k4!&!4,BS!)J)ld8"3%3V!88"3%5VdN3 +"3%3VrN3"3%5p+`S!)MaD-JS!)X*b83!3&6m8"3"4pDiS!)LUGd8"J&EU)!S!SZ) +2SJ!J+N`8"3"4pEBS!)MU6N8"3(5`G4NI[%d8!%5&2D)!)+TeKk)!)#UH+JS!SZ* +RSJ!J+Y`9"3#D*SX#!+hX36Bfj`h@qH'$4iN#J$ca%&%!N!!RV"F&!&VaJbJ!b"- +HL3+!22@j+!$)8iq*!S!mhD8S!-K62D)!)%pi)`S!mV4189BkjSP2L!+!2#Pe%!8 +!H9*P)3S!mX3[43&!6"FV#J"L`KY4!"!60aB&!&T&K#J!L+N[43'!9K3K#J"LiNZ +L!%#VLa!&!$&a!&%!%"1'LJ)!V64#&!$%e-qL!##QrK%&!$(GKDa,d`SN4!&!6(F +X#J"LkPG4!"!6hSJ#J*MZ@"3!a-8G43&!A"aD&!$%aH&&!8"Fh&J8!-6&D88"3(b +N!#!ZALF+!1,L8D)!)#i1)`S!iZ)!SJ!J,L`@"3"apE3S!)J,Xd3"3&`p,3S!iZS +I83!39mfL!##ZqB%S!,!fI+U$MVk6YDjqk@8m9TC2[F15SClYlE2-VDUcQ6fr08X +)eDB#fGbQ9VkT25*U+jHcDHI84DTl0"2eAhbkG+IqqL6[T0fiq%EjDQTVRNCjAlM +3DJDl#lki!Ym5qfdGh%iVeNTm[,hPEC8'Hb1T*I'kM1QdRNUE!-E50j0bq)ZY%+1 +U4@G3JEaPd*&D6SX+'&9QXN)TRqKiSQJUlhP5DA+i6aelFTKi0iIVkhNZQk`[H42 +T4jEk1hS(b@V6PCpkJTQlTkjllFPKCrK9DlrY,4qT[IG'2I*aGbEVTjFa2AcE$2E +UKi12m0N3EL0RTar'RRTHfrFm@5QIX-eY[@F'`(0Ql,clXJrcY,$"RKblRb'[PVI +2E*BI10UG,$[e-PmVVqM61+Q0!#-8AUIqqb3P'D!R+5Tj5!-6C62HG5FT+Z!U"GS +4&R2C%#TXAGCLSa!EbKY5raR*$'qLiYjpi@pj9P,$@mp)DV!N02Vaqqrk8R)CP"N +a9DkZq!*6KVcF9P'mIBj@H6`CVjNmQXJpRJH8MANHd$AZHAK[hmrc--M-pcbm[Hh +[HGM,8H"j`,9#cm-qM`'HKedI!cf29RlfH"lf0Jcf2,`2,r)m[&FHkRNBH!hc2!` +&KRXHGT5FjARBAc,#ml$Ej'c2`e[jNCk(YpYMUcb1AY*F(RDE6+Mb*+ALT[1`pf5 +Ljq%pp562`jk1bCk(Yr962!pl9UCk([B,62-mc-HQHajif3c2``k1%Xr$1rZCRNF +VHAXm$cY3CRXHpXM-m6b-LNXp$rYRjRSH(Z(-mcbmcCr[HGK[XX$cX+GKSHGKIdL +Cjf%hcL,2`pkFaCk(r30,2!ql2jCk(TlY,[-ml0PBlRRBqe$ZHGK(8Z&jf2e6kAP +ih,M#ml$ETXVcX%pSTHGK"m3Ucm-HSY@HKpdJeCk(R69V2!qlMGCk([BHVI-m2!f +Tm6aDVGrMHGJ0XYlc-'@Yp6cXYYRJHGKVY0(cX,ZTc[2`A+VHml$cUF(cX!pUNqG +KIdbMjf'2e'E2`rkM,Ck(A6YE23qlUECj([E#E2Fml#[DiARBGlA6ml!,DjIRBII +9EXr$lTFpRSIp@RXp$lZhpRNHpR)eH4jfGZhh21cc1Z"jf1melZRjE5+IXrYV[1G +K*p!Scm21X(-m$cZY4RXHp[38HalfN!#0m6cX+,YYI%!HLiDNV-5ekRQp8Gr*60Q +Sq'6qED5L-C-fkN#6%Y(X$&rfcVVZbdKEbpiCmqDXP,@Fh$6QZ8D5@PE*U&%`QT@ +8CP4b-KYPlQNrN!!'Cp4[RT)&Cj4jCK9l*T9kpXTc-r,EXMe)rp'([qT"qLcEKr5 +&N3DA8j4U&qK$HSpHT!rr8jkGrD!(`D5Ghe58C#p!C!["EZicLSi+rM0IlbhC&T3 +2*(DbH@SpV+YI@QQ3!*APXmIYC)0ja[I2cGRfD1H,AEhrJ+fIpY@qlCrPJkR!P61 +cdh$-jP'b`&NQ+db06L5mcZakXa[0EM"lNpQEcGjLpM9QEc9lQpREcGjKpNkcGjQ +pfqbpCZmcZmRXr@BI-2YmX`q1VM&i6L@,6-f@*-(&CPpLpU9QYjKpa1c,c,lFl0T +4BD&c4c,,e0K'8X60lQGf[YRpc5i`Zp$X!@B20(Z3!0Q$c5ibHiMCTKH(Q6hFl,2 +-(Q(ff@D20(Z8fHHB2GVXBV2(Q$h@l(&QMcGlJYN6cCjNpQ5cTjJpeHaTCNmhHiE +C*@E20(Z@fE20RQ0fUGPccCjRpRbc&jLpd1acc5icHj(CLmeHB[C5XjHC[GaXdlm +9CPHD[F,X+V0AQVh+l09Q9jZpCJ34NCHGeVHPjMD5,Qafa'`6GjAC9jYYN!$VLP& +jdAU*2"Um%F2KKHCpqbRpA!S2TC!!N!$CKbhlm&(ff1DK)LQhp%1@5513!,)eJLR +E)*LTl!+c,l,iIU2+iZHIe1fPH)DN-F$)$[6PClrMX*6HUdh,pae(TH-MCprq8%r +fmG-1)V98Z*FkYDT`1"Np!IQ#H%'f)&U3!#q)&L3,BJ@TJP""TL"5N!!S#"6N#H) +%DB)`3CBJ5T!!*2J-K!@b!P'"T%"3)#F3%dJ*K!3b!K'"K%"!)"m3$dJ(K!1b!G' +!C%!`)"F3#dJ&K!)b!C'!4%!J)!m3"dJ$K!'b!&'!*%!3)!F3!dJ"K!!b!"'!"%! +!!(q!(p!(m!&lJ"k3!!IJ!AH!(9!(d!&cJ"`3"m!"Ei!Ed!D`3@%3'23&D5'XF%6 +i)G`3AJJRK!r#"3&2%"Sd"[D!21!4b%[Y"bicU96&cE6IqZVUi$*dXQf8pLS4BT8 +1[[,bbdDDX,+4#8&Bf8!T0a-T3Xik5jASK#kVG(39%Ud1rd0+&1jP3[6@ZFlbT3G +%rPBk1#ZU+afGNYL9$Ne*kNU(TJ9eC5-cmVUbiHfpPC6HPEQrY"#[A("RCmP#S8b +[H(+m@L12ACdhr'm04,KA@e4(YbC&ID9$8m,"dU&Cq@-C[%L*)8Y0Dp-)Q3l0)'3 +k1)Q3!+f4dJUYJHE5dj'#FZNJMA+CbmSJDAYdSYr6d5Q%l1J"3E0dF"BKdp%TK%b +(TK!b(CT%b0E)&-bdKVIh9K)K-rHA4XKFF'I(#%*QHX9$b0E)BeIR)@4V)!MC&YA +4V8Q%6)HQ%$)GQNA)$0Dd)D5H(1A`d3PX4dFRY"8EhEK8#lKKkDZ@dY[4,K@Ek9` +R0S@Q6SL(T8j!'aUQlcZ&@djS"a)kX@dik!5fSD!6f)U"EP`EM,M"E4h8LRjbBcR +X5iDfpdm+pk3VMU+H'pGp@8F4c`ecmFk,bA9M+pBjJ@e)j`4fi*bJ3!VP6+IV++d +&-XdD8k,efUB0DYACaEb5ES[Fe$`Cj6b3!(-fT19`1e9U'ff68YXL9DRTU+j5R3j +S+p6$`e5CAPbL5#HQYF5d&-DM3*N*6f&P*MEE[TR`G!GRJP03QiP0SQeED!V$fZ) +&aYSL$@TP@b!MN!!`&jh45jM&hda8UR8cXFRZcB9fAT*TlNcBLIl1%V11m+lV6A+ +*YY$H9NbUB@b0K&6N`MSZ2d8Y-V%TGT'*cI$H6(55qVD&GPaHNJ"hB@JlH(DKCJG +FYZ0N$L#lNE%0%R0Bf!Q#RHLAJEef[-X"A6[#CD'Y"p1k`+`,aA,`eBeEEB#94DS +F4,9M8cXSGD*4$SEDm#F(2,d%VTZpp9+h(Yl@6GUk'0YaZYE*eEU)fM'@GSbLYI' +cER,@aFbkD9Q1Nce+b(VC@#m9kq*KadPB*`2,dDmZlY90[,TC9hU!dUTC0"RY#Je +YIC*5YG&+JVM2pXP,YV"dY&YBkb5rXc$R+M[+%Lc-&19#mG'5NYh4fJ)H[(S0N!# +QP@dP*6XNTjSdRD&93fNkhP08QJjXeeHDEU0FpHN-VG@RilhUdi((URHDSkGf*lk +VFLIkD0e1@([9bCEXk$Fh2YGYER5Uep``bik593[+Kl$lF,R$L(H%3m[G$'8ViD' +iY@e*!qq4N9DKc1"iZ&dG(KkJC8$aJlfPh[1@FA$m3'N'"JmZ3bqmcBdPH(J3#AK +`*BXm,(&i%!ei8)D#Fk9HbGSf9c*i`&k@0"jF')pRQc&kH&$%jL#r29LU#bZIbQc +,Qdd0'!`HU!@bSB!(VT5UZL,Z,XIjXTC[13r@kfBE8eHm)Hf1-m-(Mar%rKd2Y+@ +A*TE0VbqefA&Bh@feejH6m@!d`X1$k(rJJ@+99M)`510"hPIR5Db+h91-AaXTHAJ +`a2#J*XX6,4&SDHbBZ(4LelJe42$`S(#FV0i!rIMIeY)!9MQp!4B#h4jm4TQqeHf +V@CLChM,6,C+mbe+VUSeHQ`R8dj1'kL5N,8Nf6)1mIHd,4#qji,PTeBJJTHLC$ed +ljEfHbG*rTSkDjUcNhacr%*93hG(c2Qkf)dI0r+aNipJ!kQLFNJ`G#m#pEPcBIlV +#-hA86apDR&KDM9VprZHMfPIH'TfhGbM9)1q$TDmLEVHcV)[#M819MPcrXAH9HRr +p[rL)bR$U3068XDrQB#0XSZ[Z$P2(0%N"XJ,8mHL&r&XGMmVRr8NGa`XjABHLBVj +,MPi9q[9$aeD2IrQUZ[a&Mb)miIQr&V&mc[Fp$"(bVTCm,"qaAqDmZ(l*6BhDjai +TeHrS1K"[pArh`3a#er&SHe#(l1lVZ9LR$V8fd4*3alic0pYhVfM!-RAd)Y(T1Kk +MfUS11[EiTqYSL9DI`@PR'D'["'S6QXATc90ccr-BFUamPXNdCDhejqVSqlL3!%[ +lqE1XiBNk@PEEcmq2e9,(%rbXT9JI%e!(A`P0mXYl4HD(-'j[&fMQXhm`lMBKX-l +h012ZUF-D`,MA[f'[a'`GrfVQ$cjr(jB2jYjpUdmcpa0e2-RF6p6a*(-r@FF6c,f +[MMlQcLI-hIri(fmI!m$F1qrMjmbpjf,2-2Hq1TjNlTePr)bjpp9K%@$ZqeHqfII +@$mDY&ZTfj(LDFAIA`@F*B0aU$ARTcXCS`hMQLhf$-DNkML2$8icT4"e2-Tf6G6c +"G2VUH!V*1q[i'C,heI%Bk+Nkp2Vj2S3SBAPFEl`hN6M@)DU1`dZ5X0MpV9mkr(` +GXHDcMiEcQXdTLGbc!(crLRKU!cZGH,+13erRLUU13baXGpHRGhCd8b)aNcD!Hhf +@-b5ip'1Fr(3GIFMj@*mPqZ2)1)$&fIh+$Il(-+DJR$kqVrZcY@0hr-X8+[Hj8kK +[rdJeIE3#e&(Cl[FM)%B"5(FG#ZZj9pmcFh)p0E3#h)HHpPN"kM$6[Yik6Nrl$KD +GGR3,HZkTiq82%he$l6(m3pqd[IE1fh[4GpAZ[QRE,6IAlRU*`%4*I#cX%RpGlHl +m0f[[r"$jT)lRUBYklZ08RmQ8TERhYAjPa++"k&JG@fIQ'p(%d60eR,S22@@a![5 +VRV*B!HVJFq$-pcrhUZY3lH(lhrii,qYqrIQR[pQF(`1`a!+eMRh8`lGPr-6,KmU +jYheY0Z9mTXGk2meKV!"eV$QFAcI"qFYlKCAD+piXpRij,T6pA#ld6(qiA1LCIMd +eF6iaEPDIjN,2iJF)[$AY2Im#jp5pfLFQehc#UIlrAR8GF+TRqk2[LCI[jH2IhRM +eIUHCMPhTMGHcRfATMGI&[62XY1pHRhSVGSUj*pk+2IYC30k+G3,)cpk+G51e,H# +YQ#GQU#0*G2`%FlG8-&-V!(,D&C!!kY4hBUfMr@1QBh(CP02l@3KQ-ADJ66R2ITD +P66QRCc%GKGJ)CM'2jT!!M6[(2r[@aTfqjrqq#mC9[2prNX(C0rB)2-@m1Z[i1I2 +UZC!!-mbVV`lVa(k%dmbVSa#l`*i&T`kYPVRlS`Le30mK"FIbf!%BJDl$+V(hJ4A +"bSc8`jTJY8!k[5rB,h(H6Kje+'(6*r-SaG#qFc`2QfKLRLH-fFrc4$$MRSFPa[Q +H"kPSr6e2$,2!mm3a#ce22m`"RLFIFk$RkBmjb2-8B!lf2)@B4CjR)1C3cc-)FjM +R'B`jh2-8BClPHBCJM[!m3c(2pMc$-%GkRY'B%c`2V`FRHTiaQ*-mceM-bCjR(1B +8cc-HFkVRQB!jcI0-a*cZH5CKc[!mNc&,2-m8c*QHCbVQ,-m$JjlYHDCMc[%m-c" +,28m*jPc2-a0cRZGK9m0mcc-EFi(RQB1jd22-a5cc22-`&hNHQ1pLcl-!FiRR@BL +jc21FLcR@mk$BB,RR@B5je2-XaLch2%X`+cc28Xa+cl--FiARB4e!PHFTaecTHAK +TY-Vc-#GDlAPi+96YHDS`ehJH*[EV2-mUc2-m$eZiDMa20HCkcl-'XpEcm2jaJqI +K*GT'ce1$@HGjcX1XpccV-4Xm$f1i6CjR!fDMjpQ)ZGRce'&Zm6ceQ&Xp6`2Q0Xq +c#A1ljfR%h1&j0Q2Zp$aE-(GjRUfBZch20X`pRQFljPl2X`0cRqICLGRNHACKl[F +m2(Jji(QB%Bpl1Srj9"jQdZ-p$r[E4hNHRKqIihRB"66Dmr!#[GMcm)CKM1GTaVc +0mc!E(r*F(MeG2LQ4`i,bf3S8JrKIcbHqKYTYYFhe'dI4D+cme4IJZ3'$G8Y!"hJ +D8@0Ml$5LfZ3d2cUD3#eZ5(!8$d3cV(e1)kT&6N2ZFrm(MDMrVJR8MUB40@rXR%E +8f"KmMDM2T9CNppe5ZrXYKdl)lKY`Dj!!hAIPYiJkX[ZddTa!U63R20c8DTe6QQ0 +VJi%F(SLb')ZFFT!!3@2RP)--(RZ[(#6fJR)3baNHf1H8JiLbQ06m`%'#j[&KhIj +[H+$Q"ikb1CZFNK585Ce8$Q,afSGJi9)1FUaIH4K['VDeAlmpfL$l6,rDJj5$r'5 +2J39!1BLZ3h(k%`8rpMdR9&!JmYJ%S'IAqLmQ!(BT"5,2p[ec$`J&)ZYZ'bS3#Ca +G2i4I+4!*E(RM`p&ppBNh(TVpD,hab$&5+J8LK4mRrY2eLIe2eVIF8YEch%j(J8K +3qN0m8DqZ0CmXqe65GC1I[e[P8BI[6DIcq%Gjd,KlUHF*BlCiRLMQCF-mA%0lRKM +Q&DIc*1qa(qEc[Ci#c'Y1j`Q2mK4L[[VTHV`qJclFi(Q'BYlSHG4EHYq4dhPH0-T +c&ZClKRPSphBF')&jkp2pk18CKIQ4B4lD[EhZFc!rkRAc5ZlfdrHB+XjTd)3DMZ1 +IP6m2A)-d,ZG!EiX[H[0pfB2SZKjjjA-e@Xfqmf'[@9ai'EM`%#1#IaRVKJX(Q9C +%6Z,#pH$#Mk)S'`2`8XcUpGd#@FMbKC[ZbhlVP9&dc6hMfd""!3,$cGGAXml!UGQ +ZB-FEUMbK8l0GPB3CH[IXhXX$4r&QpkR`C0h-fVhCIAFH&)YjXr[Z2((-#Ck(QIa +%cj121FRcp-HFl(QBm8ra2-ciThSHC[c62-p!c1QHCa$Q$-mc',2%ma4Kc[3m3c" +RH4lH+Xcf2--`jhJHhM58HKlH0-ce2,aTQ1GjcXDFlhP'BLl`2,b4@1KjH#04jRP +'Bblb2,bP@1aj&!rerB$R'BZje21-`ecQHFCM,[Fm%c$,2Fp%c!V2-`Qcd[0-aPc +KHDCJ9RQHUCJV23q[lPCjRZQBUch2$-aUce1#ZFEcc-4FkhRBllM1mmc'V2%mFc$ +2mcbPQ1Xpcec-@Xmc$h1$jq&9h8E2X`#cc[-Xa+ch21GL0RJHa0TXmMb,-"Xp$fm +J0RZH*CKE2-p5c+fHCaRQ0Xr$UX(YRUFFFiIRBB[*6Xr$V(HAjf%,b@l28i@jar1 +`$@#[jeQ&ZFrcX1'lbI08Bqlh2'X`$hJHRXD1p6aeQ&(28iqCjhND-'1HCa0Qh2- +dB[Ec2*Xamch2&XcqRQFVCS(RfBCCk(QfB`l`2$X`"hUHRCL$2-mZc-'HKk844Ck +(GpC$23r[ZSGjRLE-iCk(&9jRH4lfkBl`2'aa1p[cX!GJT1GTaSa8H6*2TEdml#" +qRFqVf4VP[VhZbF1VkEGlRX1BlT[Pi+Qh`bS2QaM'qIcl%XcaRSF0(D-m$rX%c[% +mV"-BlARBPe$XH5l((10jVX"dhh+(6VhP9RPBAH1qj3kGHXZYSUl'G0pbpr6M0CL +hqIfm%00pmadmpHElU6b*Ll9I[M&'l@Zih&14ak$+QUrfpE*ZZM(1$48m2)J%2,L +5l9'@1$`3GBCldk)6pmDU#AcY`S2SH$Peb'UqD*P6Kkc`)+F1fHkQlV4Jl*aDk2" +i1EA3#JmL,kL&YT%*42E`303Kfq,83LXmb"X[T`jCi8'4i8&0PLGl%0[AdYJaFHR +%VR&VL1$K39cE"%rSdE+HIJVjhVQiYV$+L-6@dJ"@Z$IYqJY%CheVD+2h8'fI$ef +`Z-E#PXSp6@EF*ImeY+a[Y@I("m`kqCEa*C`0YGYUQq[5Qh$dke#6m&pIk+6Q#99 +EFI6L3ReK%bM5[['T[PDMjqTZ@U4a1cfDl-RMP8l5I3BLdpqZIK'I3G46pGFRH5I +YaX8,jHXf4TQ8RHB,3%G3"**9"@*PqBUf6XhYRYlDf,TlFR%5XhCQDP%#N5`URa8 +'!b`aRbd1"H`iha#6-[2Ffi-jf5P!mdZPbPTIp,#p9Ia+UH,@&hfb9',[D#T%Kb- +D'p(2b"iUY[h8F*l(ZCk6Tm8E1$GbSSN4[BYS@85R)KS8dCH)GN4d)D,j%$f(D"G +Ne43lAGN5aKYbG%(bMTGhcQM%j@Di&65USGd@AECSVN92,9TTd8(,XhMdbk*0&Yf +aD)T&,baDB0(jLSCAp,QL[49GV@KQ43mV@PI4XFU@425RSLd9hDKS3NA[+9T1HBD +("P2dPD+GP0ITD"j&cbKD4G%KbJYGp)1L$46GRfMk4+mR,jl4fBQ'6[4aXRBDACY +SeN52*PScH@I-HP,dAl+aL,INE!T#Eb@E0ZK!AJDM,BqZ4)mLfK8&6I6b#KCbSTq +3!,IBl1aPJa*l2%34[JAJSfmqBHq62fNBm5R$M%mE4YaKQ('R!GaR6)AdAHErV1@ +lZqaNAr5aXSYpd4qBDVjlc,lAmRh"l2ZX[UqDrd'c[fEfemhqSYh2rHCr&0--#$Y +iR&)&U*`f'PjVlqNAqd`r@(A``d,4&(Ce6,2)I$HmAH2$#r[&bFeTHAr&12)kiM, +E5JFcG`XU,M0lmfXf1*NijR6H9r)CM61GqS*r-BaErGI$qT*aSjP0Q[U5FH%l-H+ +p2,NZ1[H((aafF[L2--D(Z%fDN!#*80E`PkYmXBmpJ8qf$d@8pmD3!'q5jT5LD69 +#(rMfKR`2[%-&1(&4c@mAKVKrH&5**0qIBI32FHrp5b@51'UG&HUES,QYE-H*DLl +Ve"II@fSJGZ*'8&2)iNCVpXN-Q,4rM&%8k[[`"r%a&qBDQCq1#2ND090fTSbqAqA +q4K`,F60q5AFMGEqC9SQ'1Klq%J(-P+Q$QII`%2I$hmI(R*NipST*Rfh82*Xl*1j +DjAELkM8VCKkY[U(JK2mXkdYQbmbSe6IXLaL,3hhIe2daYkD19`rVD0*FR&Nf9k( +QZ[j(3ebeCXA-YmRh`DS2iRY8(c0[iZiFp[I0QM%c"eIIf&r"Z#[%[@X`'eII1'E +[rR$ImDEQb-c,J3j@SEdRa,eB2F`X'*2jG%QSide[aNIrUQm#Xr,!H5(ZBm)RCZh +UUd-rEb6%a@pr&`(-hp9h(l2hdTqfI06-6&jpNc4$[kj6p)@[(LZji'jDFA+R+,F +%Hh'6dARV*pmKkNc'KGkY(PAj`&d[,UJqN!!q[[B4!D[%h9rKCH`6Rm!R#JU#Ic2 +-0rA(mI&HJ,JI$I&5EmRP$B(kT[l%%-pL[k`'NrZiTF+rf$h5NXYE!q+q2Fah81m +*H(m!c2,@`-(Aq+[epS)h#H5lSF,Aq*VH!-LkS"A['q,Pbh8A[&fJ$[T#F',`,q! +$SiKlb4![Dr9QJ$F1UP-'2$$%bkA#40R+0rAK#LrM,a8(i(kSi`-9AXDhU!EH4a$ +('`r"S@m*GhNc34bB+MMh%VdVi4d&CAjML*HcEP@[#"lF@Z&PI,I`M2F@m!$k@1S +i,)i'ce,IF[L$i'AXhG)Sc,X-mY&rdJFAr$BqF)DiZdGiF!FqhQp`[I!B"brM9rd +Y2YPLY`J--(KjRGkpm-k$Dhrl%#rR2kEHPI[lf`S[ir[%AAJ2SVlbabZmM0rb"3* +%QXb,i'-',f-rVi+G[Tb'cq$P"h6hF$6D(0`X0Vcda"!r!VFSM!`[[EJPm!rr6BD +AAYa`[HdaH1R&qB8MKLqq5J9)(1pjK&r@UZpjdd)Ff#Ej(KCAN!"pHRleY1$PM,[ +8U%jF3,a#F'Zrm!#13pb2Krcbim*%fHSG9"m+rSe4rmN1aS!`@2MP8R%cfESGH-q +`[NZ&ZGb*qRCpUX,,f!2LGV,G0L$1DRJ92YiPd@IFVi1AX9pA$Eb,8YHk#cj3G'r +)pl+r)i)l90m@pJBD["`XM!6$+3'-%Aljc6[`b@lrbASR*6Jd8'qRC+[kC,f*%T` +ETrG8[,e5hpBI'q*PKHk#peM!1la%m2+JH!p[Y-"[m%MUQ#EZ,LXKYp'AKPp'K*A +d&2RS"qQ$)VdliRdAFI5ph&1KlS)hAqVESAX5['`@2q!GQ2Tf`PX%,f1I%VE#mEN +LaEm&,f02UJEZ(+LNIi4IIP4BbCfVV`QF-hKj8,e0[kM[$[CV'VaXr,!DcqR,PMm +%,am)GAa$GmC*DHL40RMTEPld[jmj5[3F`dXhcMI&2-ChTH'P&cGFZ'c`dU[MJr$ +8[191XA*bIR-!M!aFh1RebCH-H`AcKA!d2pX[i$(-5(JM"ae3mb%c0dVQZ`Dqj(m +VGDYl6r,D&ra'i-%kcX2[Ul@rmPD,mqj[K2c50lYealc,Scmq0Z3VpiJV-Jq"*kP +qmVdSa0dN6L"[dCD)%qme['51`Ub'qTL,5(hhDcBKNP9'D*iNp9dLMLLL8X,#!kR +[AZ'pl24X&Vq4qZl@E%hfS#i50jAkVPIGe%)FH#(eADjF)QNKS$H'8Yr$QPQ)RTa +Qc6QN[Rr@A6UU*I`2d*G&!rlNkVX1I"mB'9!FrH2'q3lr*)DC@hKa`pA2"LHmZ1[ +KIrjl$9HmZ'@D@cLm+[qe`M+&mjS(`(%Gh-erTIJPr*hlJjXk[#Vr,[(XPeSGRkT +i6hjM!aphba@pYUT[ED'C%ra)I4H)[cVeVAe!m`$mc!2S4DHqY6Yd0qq`1TJe1[@ +YrB$Q3-`KDArH)6ChqLGadEIkS9'FGpmPQQ2&`6RiQjG[QIV#i9ZP9iV$`(R9IAb +"[Kcjq4$hA@'*QRX3paedT`S2+,eImiphKEJI-"mmqpB3peIh%r(Z%&F!2aCq9[T +l2b-Z)[F(ch2i5ZQGQMfmeh$Z1e9rP2k8CRBU[lkR9eDmU[4DF5D&rq"%M,X4IME +h1m6[hfpp!-paq&RTPck*$fj)hF4*(H@I`dGIU$VLF%6KCh-[e"cZ3b(I#R&(ZHp +DpIBI'2iaEh,`Vl5[hVdja(f1q8TS*X5ppHF)B"l#961rF("al[r6I%Ma#)d(e1V +JBZPac6$S"IS!cZI`mVN0B3Pp6FRNGRKjk@FefkAAZ1mE+ajCqJ(0`p4m5FI4Rp* +2$kZ2i4hJ)[0@KdI1r@l0GX%CU*r#@q'4T@rr#"'hKhaADFlYm-M5ijS[`J("*c" +HqZ!1cB,*UHVS6km,MbcpFh'i6i5i3ZBVJA2+10mHh3%c)K8bN!!l#qi-F@r66"0 +FK3I$0aammYhcZrJq(I)9`C0-(GmA&iI[Uj!!SFaq6"hIqe-LQ025ar!NUH-"p3# +eU(`MZ(Y6aa$GkedKEL6BBqTi5,M)2)eqGHGj[[GVeX*F5q8EcDc#e('(jTUI#h& +Mk'06alhUqFpE(H#ce((e3rMZXEj8q1%lVi-b#"HMU@15CJB2)[Xh%cFCr2#(H8c +`0['9HqfqQ5I@KlLjiL[8U,jV9FGV3Ya9ZVrl3KfcQFrk,`KaefUfq-830`AF-[@ +p8Ah'r*BkZ&qTlhE0Q,KcP@qmqNcUZeJm8XdcLCX+hc2eqF8*iENUEKTc!P0IXrJ +Z@+e##S@R8YpIUQE`"fS2Vj!!q[,%fG4mLEJCB)bTllALdPm,F5A-I8ap9H+Sc+* +T6qj*k[[c6q1Mle5qQH,a8YqG`Z#(3Y`XX-V80dlc+QD-[[m$!*!$@`d!!!%!N!0 +AHJ!!9RS!!!*kEf`l$3N*CR-ZF'&b583J25!UC'Pb1`d*#8jKE@9$Eh!50#i`)&0 +PE'BY4AKdFQ&MG'pbFJ)!N!0"8&"-2j!%!!""8&"-2j!%)!$rN!3!N"+Xp[d9!*! +'@I3*#3d*#5TfEf`J25"QFbjf8Q9Q6R9Y1`d*#5TNDA)J25"QFbj`BA**4$X0#3P +1B@eP3fp`H5KQFbjZB@eP,'jKE@8T1`d*#3d*#5ThBA0'EfaNCA*"E'PKFb!p)'P +c4QpXC'9b1`d*#3d*#A*PG(9bEL"bCA0eE(3l$3Pp$3N0#5Th!!!#L%&%3e)$!!- +S$9d,iCE!0Qd2b6Z[IH9Ehp5Ue9CEkEAkC*9FPqJ9+UeD(CpNDpA*@5)i3-Q)R'5 +k55HY1-"hcYF,r!1f#E,M5[UMC@C+a!jlH+aC@B3V[%icXLX@fR,DNr0`SMITBMN +C8cDC6Z*'D,'pk"KZJpfp@@YN0fce%Me#6X-#1je1j30JAcZ3!!lQ+MM%ppFL13@ +,l3`kNiq#Xra)29V1aZ2p8$e-6X$$l9JkMKI#GRp!ljGYH)IYT+em*paYXfN1h`A +crADp66EM8cD0CR)dR2%&qSc-`1RqK$iT8r%HQd[cZ"kHY4l823UZ0RLjRL2VFBI +Rp%(CJ[IC4YV%pd*IreFIPcliY(@PE[`Sl'hl8'rq(IEcAE4D$X)KIUZ@bRMmhLE +5"2iFIVC40*TrJM&HU6r)*&aMlDNGr`LGr#[p@MVJ5&qYUk3cVV@a0)lA34GE5X[ +i1hM(rpDrj$emhrr6A[)FrQmId,[m$hcUYIUPI),If"+DaGp#2rZB2Z-'k1NVp3[ +TL1IC#r3+A`5[qX9kSEb-Jra'[88'i`hf%Ah)em-)[dU[PQ&iV8fKSA`Gh'3$D6K +I!rhpCLf6!ILDAk+AbZYiZEe*Er%9F,kp5-rcZI#5Ak#Ab4Y4q[3RrF'2`GYqT6i +N[q#[rV!q)VmK'T-`3"4Cj"V@eLC8PNBMkcLAbb96p2B`aCDaP&9&U@-[5hXk6QI +5UA49HN(DD[*0fCDk4QmZA"bhC9*QKDeY8Bq9e54!3"2#XdXQSE`ZSEJ`S5P3&#J +)Y)Ab`R#S$SIkd&B5D'e1lV3f*HZ5PSJk56D-!bP*#TP!2[bb3,EL8QK,"6+"jSS +2"5`IY[4X3MD3!)N6iRa#69)'!*!$,d&%3e)$!!"@$8X$RHJ'ApX&YA!,!-!YrkS +A!!$3@iYDH!'Kj[m$@)8HabqAC[SF!*!'*lp"4%05!`!rmJp9$AC'!4!aiqGMIjY +cMV()-TE9'U0IM"@MlZFhK%X0M$Q(cV&kM"'6f&`D[K#b%A#b!`R2br85Na)aK#$ +0iD9FNLE'pSA*#4a,Z66Aaq24A%Sje-FeP%XTKkD%BiLe3#RJ!((Ipr[[lr[QCJk +plE[hrI`('k5R+%%3*%%52*%"I!+Dpk1@k$81XCK2KMmBkh)ImdEZFT0$AjL%ESQ +#Q[A"f+5lUd1X8%03`%TJXZ0G8#P3K%U%iPa9heDKjeeZFCT8f%RNL[a%6Xl(Kq@ +H#NEkblD+H`kJd#!9&R6m19E#N!"@#`8L1LLBQkT*bA,EbTI8INfUkU#1afYrX(Z +[U%d8m(MZKZ%5'MEBDhm3C0iJK)p5BU8akQ"S@![63Pml6kiTHVpAihr2j32Lf+f +kG@ZlZ2qbbrfRcfYiFSC,bG5Y8d[GbakZ`C*!PqQbISC,9cUh[kq,Qp3XJ@&0&dq +qhqhq(hIamEjq6RGIeV6GIBqpj1,qPhCcdd[G20RajrS$`9R3X$UYkqliY"IALYE +Q6KjA1h*[iHHed5N0*R[[V!iNhcQ&U81EjPqfE9TdZ9HB2YR2ihfK63fRECZq21e +b,hd!JqT8iV&%8@1[1[8Q"(UmB&C#-Z4L!dNfeDUT$R9UF**EDh0$am8D%VjcI3B +l(HC)AEh(&bT[R-U`MaT@JphSYKeETNk06r)iPN6GqD*Sf))1(1bLli`H9iDUf$l +E2P[YrafP#h@UQh(Y)eAQU!L"dYE4-rA'5f-6,@jF-Qe%FM+L3VJ20NjCD2[LY!M +#e4HMHX0pp*'1e"CVaQ'`l%aNBCU5(l-J1fM"hCpL`8$3JXIql3+aM&$4Hci))Bm +bK)3b8IXe[G)kX8DXmGE#9&M+5leI#B-maQ2H"K3Xh1,p5L*fe2eSD8VFMHJJ,'U +-N9kHY$IM&A@14GXKc1b`Hlka#dE#'"h5B*,%,2(+4)Bb"DC5Ha+[)UFl$+3fh58 +MPq2TKVX`,*Ffh(9Z5fmH6'*kV36NJGU[XHe(eBR)*"IjkhBV*CH*BS&Sc6Z#@4$ +*j$*aR`5JE-J6C6Ipj21m0$XJhJ(&3pi1JdT0KrXQ%UFk2KPJ`VB,"cZ,'"TZmZ( +lPR9cGr$a4m0KCXk*TNYKFSpYHhhhRQ0,4l28MU&5Yd'*'I5aqTrc4RhL6FjhV[T +CfdHr%IGq0&dXBm`2Mikc4%,+@0*N,QQb[)%-qeJ+-%*D`qVDc`fVFC523&LG+9b +j#Y#X0$9Ui43UG*CT1*UeZ$-F$A'rYYPZ6BHdUY$*Y4Tq)8-aGJ&aY'VER[)M13E +ffUT"Na`H$cDX3T@*GS,X08Z"CB0,'qRUekSEZVA*YMhDbLkheN3,(9Yc&$4Q-14 +,NpdlLXR5TB0q3RQIrN+'IDR`b5[G0QfPm0'CPb*#")P`%e"+4ZV'kRakDTVYa6d +Z0+%Prkm&#-&!I"N-DG'NMcebMIHiTM)8,Si3q[-$J5YPmE@i8MYGLDH6Jc$mLKi +'SNEij!B')[YiVD9UbRj-DG01[I'i'*K'!T*0Y$1`(BE&`Z(N'&8F"N6`Z(-S%G, +''V#KcX`0"D*)KeKq*2GM*E+K9rK`Q(+8`"Df2d,Ej0`Af*!!0%-d""9Lh'Vi%L% +'#LqX9cXFhmY4*SpAS4&M)`E+)JL)i2AD"&H4I)(XkdYI1mk(IPL!6"35#,a@i(M +Ze8,H"d,$!8*94Z-S*BVF#+$U[H0)p#,f2X1rJ$J5[Le6M#a%jGIcYS$XYr,iXcb +dKC(G3Q$fUGmKST5B)N(k2K)L(V39,*!!!15+8"J+5V)4'G%bL'$'UYdM6b%m8d5 +NaGX18lL%KTpj[R"peE$L++dDlUXDpMRmUH(c!4,V(899``%5BijNeA#!4"5Ek8# +QP,C5hSp-d"F@e2PQ3jiX'qD,qILjGK$!Liqdl4Ah)l"e`f'%dRF5Ri@14)kbKYZ +6L9))T%24-2H,C441`DF(`TLd-03V[S2N*jXYf4TBBMN+BHf'I'!b,*l%0$(mH0L +56,$k(DU3!0%X,G3*FKi3'3YeLhfXH`X4!ZReSrjd*&f+T!hCc,b%e"8,AcdFFXZ +($0qUr8TU),,5NA%NbL0eeYPpif-VZ+Af+erhKBa,h(,6B%rV$#2G(GkR$akADkj +4Q'm00Aid1*MPE@CS`#dU)B%MfRKL9"rjGpSdTkGcXpSrh,rlMcbZ3rM#[Icq1h- +I8)cYQeAAX)Z'ep,`RqlrHXB$1-bMIrd04*+P40V9dqmDI19Qe$XqG&b0fa&98hY +#%r*H3eMH!pBbA*JI[-RpFS8b1T3Rm[kM!mQ%Y5&2VR!f2iY`XlcRi"PZN[FVaKk +`$i"Gl8q%j6)NSrj,XhdJBqqNL3M-`E#mAjV)3arTX,bhkVLF3)"Q&8-0mq8$GM@ +5ar@bA&L[jXQ(3&"f,lXrZr(NX(ji[V`A8mRi16V`ZHT#je%f'4HhTG#pThGPRPa +cLF[,-F@Ke"3e6fSZePkQT*Q)jMk&N!#XP$c*9`MCd*!!NY(FBc"5`c`)0GZbPa) +STi*0K@%EQaHR`18J"F$U,1qYj3MD%YV'R(d4&`*2fha'CjJYeSN)I&NDf2,@l5j +AeR+@H"9KLbGad1mj6#'p21qJ5clY"[$8i&X!3R0,fekj"JKd!S9(@(+I*hpLKb# +T0"ZfJ$8A@EI)qi2-FF0mq33Y*mEFMk('RY#0'lB!kHb'e835a#CUrkSC*p5Vr@S +`UrBd8kSQ*MV!R-X#[jbIa-Frq)kM35QQJ1l3fGXFE'MQRilk2V6I&$iL03Xrc,Z +J@LN`j25icj!!bJ0NAS6NcUSZiRiS'4Ui"85MIXkG-2A'r(-JVXF`e(Kp50pIaZ1 +1q*`5CGjfZVBkYU,V0#P2&!lf&6Rp!2AbB,,f0!AS@`m%+3FHk9KM`V(bq$K,[19 +Y8R*mQTRf&l&-h)"AXcJ23h%44bUHTLc,$!N3mk"dH+9&FD"l+eZLJZdL%TK1PX# +%m4QR")BP+pP1[d08aX!XN!#IcdLUM'3m-9pX##,C(#VijlEGCm@5N!"02#V'S#l +24!EH54Rpr$2f2+",#EE3Md)P3UlImhS-pb&6MR6hT(@f5lHIS!j#*pT%m9"#YpR +Sp@#k'`"YP%hHb5l9I4$0QTK!Pj'3!)4e&50"baHc$IHaaF@%Q!k6pbNb,80KjjC +ZTXUr4U!m9rM-HIU%`m8%a')N&46J&&Y5)!QUD!Kr`R!bj[@`j8m4HI`$&F@j#9e +@dZY*63k`XL&FhA#3!),AR"2qFB$`q6m4N!#C3B$-C@3`P0`D!%)!d(RqL8)"%!+ +`DYKfr[QdV["5(SNX-6VXK#kq)m8!FQMk)-lNPeE394+kTlmPG@)5NcmeVI!aPF% +%RjBQRj9"M)H%$fRc#p0C%)$c,BQfLL-m0j6l[0Y@2HE0mmVN$##+kRMZYPTVED+ +f"HVPIr&1j+l*A@1`-j%'dir8*9YIc"0r8Gj)+1%mVkSBVKLTbh)JJdD"L"EaGdi +@,RGBAY5A[dX(k-blG8jLmffAEGC)AH[bK'iVhk![hi@I-P+(b[FDE18l0a6`52Q +qNESM2Q6hJS!5YF'QM4fZJ!UQ(LkMB6M$',[e'r6DT-'QM6#Q,'a@5$X'pBf!G!c +U*TYVIiGX3pY4+!hjDhm(YjeEdQHdpRFrq&Yh&TCj62U5%V[TQL9!''Lm#kTIc'( +XdQZ0KXAP0EiXTj@TD3R@$&Z"2&Tlj-dDEM%C(5Di5m#4JlF,kKUIj*b5#--@8ZS +TF8MVB&Q!FKTe)V'49$Va"T*mZ&)B`Z,AKY$KbLk%BEE'S'lD$PH3!-*jZ%bViVU +4&p(%D6I$D(!%kZBK8MVAjIVd!aP1AUT9EFHmEpUd8AkGLQd9@jB3f$L@9SH(3'G ++TQN38kmVp1QRD0%l)h9KE'fXPCC%ER,,PKCR+j3i*hjZN[VVYXN3K*i+Al-J'B9 +"q4TR`rPEBaLZMj!!NPmjNI'm!9F*D5ZK*$r8Z!cCl,F1IfiBcE%IcN@f6@iFma` +NKG8qr85'diUK%@QSJSEXrQpL-5ArCkGke%'Gb8)L0E'3!"Jp2%mJ$M-E('YH(Mr +4YJ#,#Z11F4L9jlbS"cKj0)ff%Nh"`SQ-)%+F#1hHFeJ@&"pe+LHFJ-&"-(3Np@) +2`NF($KE`E@5@`Bq4b#!,fJl)K2DeCEl3!GNCTd-rA!Qe,FpY1h`%2hX(3j[3J+[ +c-29#A!I*r(!%Qh6N-,Nq[8r$)h8[9!0ajM#4!8Z#d60L-h4V%fKZ-qdH*X4K'hq +p8jJ'`KJNi0Ym68JElS5iN!$2frhNR)1IDA$QmU@,e*!!20#i@*jUI1`X'8`AFpq +d%J`U',``Y`4ESXS@Cc-fe8"Eh6`'iHFc#'0*fHHX'f4UAR-FJr0pa8Kd6bqmH'Z +YkMrj"`5YLN$-N!$Q`P%QFe,('K!fr9Mmkli!S*DhI,h1YqLkkG$K)i1K`h$kDVh +'",@i8fhDmFZEK+ba3e)hYic4J3P#P#1CSa#`X6N#@PT-,(X$aCXI6d2TH0S4AVc +aHZh`50hQkHN3LNqKDcU&BA!NR$IkN!"KS#)XmIADNiD3!&P@M-,'%1UU,a2!CRN +L!iX+KR&3Xh"3XdT#EH)RdQ&jQS*U,#-3P625SH(i)f90@9km,&eMY'R(NB[XNM' +Kfak9%'HE`p')F!pY%'XqJTE%YT'5#H6l"0HX(#!aG46Al-6R!XU5'flbkpSSblJ +ir+j1GY8)3jUl)h9l)aFb)+!%LE5P6*!!JQ1$XG8BcB)"*KTTKhKAk&cMbcUe$80 +qChXNbE2XSc$**,P&BMMMp2MDZH98$-0qER(5F"B+ULpNVT%QK!PhMqj#"LAEKbY +Ie*YV*$2,Rf2,#!"I[ZR1UH'%MTrm[Q[BMF+(UedrAf+2NBNk-ClHQRYb%!DpN9I +95p6JFFZ`@dQ@VYX-MdKma[ETcqS0!amY%@ZfVB!4-0mdrj8#8BBE&4PiYYS02TM +PmP3-LYc%TNUm3SkPq0JmI'B)(bCZ8PS0cl!P*M$(l&%-qc'F4+%84T0RZ$r5adf +@G&imeQG*pqMAkAN@)pBFlH2qcF2fj$SL'ShN$iUQ1eH&ckfa2Y-Bh%6rfcBGpcH +Sprd($2&YVl6aZ+r2p2Y6pGBqbdEFB8F%aM"R()$2AAF64rId+rQQ''rfjCGUEGf +BZKR,G3El4eLZI[TQIRb!ecZL1BTck-fEI$hhj'3j-eqibGrLL4F+qRY@IBHh1Lc +S6VjbNhYB+15+ZQViq)9205[+,Skm5eZY-QI$eDid1ARah-AIGrhXchB)+ccb`@* +bpKc19NCKBPq6d*9p0)cKHDIY5GpTZeA4lUlQkUmDBI`RYK)$JZNm0[+NHK`CT"( +X2FVHfdqF1irf5E%ppra0&'kGrkrREk13!1diG`N44Ik*dr'ULX*lrh4,T8,&UDZ +h8,"N2[Gbi5N8$$BE-9KZRA[14SAX3T5S`+8r)-iM`pKLKcrb$(m9,X$@b$0)mD* +1IipH5FEk)Mqr8)+-S+!4Ka-LL[HL!@"EKJmI0Y&[5G[lT%eEVhjk&1EjBeX5h`U +l)rVaHVXRSKqXYmI`kS2j86rH"mGD##HB0Zi!1MK+#@e"LJXERGHDd0&4$V'Mr*I +5e5kKX9L3!1e-BJPANM3!Gd3ZcaD3!)&lKYh@HMZACmhM6Zh[rd10SR-H3qCNPVm +SZK@K))BHRLES%5AdL%hb,,"I&&$4jU'V4Ai@`Bcf#&kP0[pC[3#JV!3$jXd!B(f +@k)*XHjbF&VR(Qk'1JfhY6`i")FY&KLq43h'XhUf2rG#(%)bp'DqNhImMR4,,e5N +4iI0Y(3*%ZMM!'3GDU-I*r@@N%FV*E+!Y%!D1SA!YiR&#Q+N-eV9-rI3&U0EFbKJ +mZ4q$SARN5D"V"S%63qM*kFrj@$'pr6%5am#3!"&$aU#KT#-V4e(mMUbhP5D-F6$ +'Q`a&-"5K)8T++*3%%A%[%2M6N8BFaMJ3)fQkidcQ2KJ'%cPjKe2-%l82i5$m`pP +)LU,K$b9Re%qCZ[!8#@beZFJ@%F2VkVKp''lT%iPk"$5MGXmmr98%CFqffC1aqRH +A+GTBV%HI'djP'aa$5cS,!NC-I2c"$&,((C`F5N8MM1iJ#!&X(h2(K)#"d+BaM2! +j,4D1pkklYhrUhNml5%N8@d)N&MjqN!$F4ID&5(#T#5BT0a`mcUh5iMJY2KYBA*c +1`N+2q!i@@X@&M04TU*1jca+j$eMJ-SH4+jE)[F-!M!,!p`"B23"l4#)H)q+I6[5 +2p,L#L"XCm4JM(K')`qM8P1KE!P'SJ'qVIa(q3G`64,ajT2%"ZV4VeBMV8q(D%[P +p),HI!GVN)-f2-k)a!,U,$T318MV3#SRiNL$LS(eIGaAa#R)#V!qc`%3F"XCQ'&@ +XNAbdI@rCeP-@qm!&dE@#13*R#Sl!05X3EUeSq0"ZI$"MN!!C!mIphN`F[4%+F#- +6E(F&ZJ4AGlP%-qk-B$K-Rc@c0H034U*`r[eI8%`qH6#$`XYJ28)"$&`*$-iVM2f +)&0Bi))5[j+2S8S3&0!@Bbc#8q@#''XPpN!$#e)0mh&qlp1"a!U,f(c6M$K-F%Ji +i2G)LFQB2XdRQpBdVXF!``1VT!eK1NmErjYrL%-R&AGc)A"CR"Y$aT,$Yr@GGUcV +kHcXHl1I-p0qRdd9QU%Rh-JTZ9Jp2ZNR*RMMra-ZN[0EQKXG(1kj`YAGS)YqL&2V +mpQM-kLkTd#[q@+Dlj2D1jGcR[fpTYppA#TAL$GfS#V(M-[Im5@"4`T&5[Q2lE$- +#E&((TXC5'S!,RU[`6PG(GGqUACBf&(453EpU&ip"K0aFh8fL9+PBlF+`6qSHN3S +p%Y[6eIF5ffDaHJ$$&k4Z45VFNYLDUfm5fcUaqJb'mk6ZFe,KGY@89k3T#c"F)R9 +IP!VCM1@'a(+(QC!!"&0p&SbVj1`GSDDjjh8Nekr$058kV,I#FELRPlS`''[S,Cb +"KMiD&*UaEE`MK)XqcJi%(5L,D')8K(0DQG)-pCRI%04RT4iG1j`80SY')Clb)JT +P34aI,T!!K8%BM0lcETYjP[IlJb%%Q'SDEHBjU*!!mHqDN!"jfRXfmdbB'M#apmE ++ii@Gp'(Hllhah['JiH6Cd-BlbPjdPG%J%X6-L3c@I4(6`-(!dS2"p`'@MKe"039 +Zl5`X[ZL(%($,&N%FUdjk[mh#P$RiD2CqQc%P'C-a&EUV!RBk!lD&!6ZEJ2ACc!X +Z654XjRRTU#$@E'UKJ[FL#qa3#"-+qkCUB4#-#kSBIp5%dF3BC`Q$!$P*Nd2GjX, +N[XAQKCF+ZQcQcmUAi,@m[!A(Y!6(Y$5b'+%2MZj%SKI%mbeBBUk$S28@%pd-l9` +DA#J-3Ya"SCdVQE4!BJBEXD3k%k(bkBdZ'%YQNqX!1F`-3!cJbl"a$"bfb4r$K,) +%2p-hf-b9j5eil4-@H,m2BLYC85XJ#aaJSZrLmR5T(Kb@-)b!B"4J93@5Q""`6qf ++VZ2QP8$L([0RH'de,m9,-5rI8'!aQCIJ)f5HMYHRjKDm$TTRSi1E'r'K0mpL(62 +a'M(2B4h69*YjTF28H(*5MbS6bC1&h,4"Epkh$8,)*e-EfXb9kb'XRi"c`!Qpql2 +(),*[-*42aq"m$#ikdFB'NdN$0k*M550G&SFb#eIEd&EH`P"PQ)4AZLc3BbrE5*i ++lLrUlcUqmEUL"V%FDFT5ZijBK%-e!*N01"cm,$!X0YIKCq&JU(bRpbjHqlcAT9" +ChE2Cl2L0`L&54RdAl05TdQB'MTB0JXa4bQiNk[PZ`[4#KM'$3fa!"rYBik0LR"L +kEQkCCMk+c6Y+VM4NmV'6dGFBaP#A69i$aU4$l0+EMkTC,)-4!&8Lj1ip-ZpDTD8 +%bJ*cN!#$c%%%L(BXB"5b$*!!q-h)5X&N3[&V[$dNDdJ-&qF,dbDbP'faN!"X1G8 ++HrS,GZXCB`mr&32E'M$0IPb[c!*,6"+I66fpe+@X&"&K5b'-S+#UZS[Uih3U +6Cj5-Mb4FQV8NB!SX")+P[Ur!iKX&FLJDZ*-NJj`&KU0G5,b-U#,6aD1Q%R)D1"G +'&B%i-piXJFT[TF9`1NMDNk0ReFh1P55`eJZ11%H`aDqLZY&Lmi&E-F1@3Gh$6e) +6AIY2[R&lM$SGHBdIiN!2T$)m,F)90F5m854Q)0Pb(0JB(9K#RdCie+YJHC`kiIU +E2j!!N8UNf-ATD(8q#[V5jQk$)H'Y"$N,5)P1H5*PEUN+lMmf8[H,*B)CJE+T41i +,#TKUT0!e"50(kM)253I13KqEbJD3!06+f04IPl&0XkB-416NCRE#%4JQKZT-r#c +VkS#"#N(R,TF8d)i5-SJG$"QD,Jc$0(88`D2N)+T@aGr[+TKilYc,fPKA`GP98bm +!S9)NR[E"2%8U+Z6&*C,4dU6Gr'qQLY08mVke)5e$#CQ-`$1!c"GN"ej6mXZ'qk` +KqDEli8'Ul"#5E9)K,48+T3)IY+6!-Ph!346*&-Vbf'%fP8IPPjR4**k18"JrqID +&$!6`*C-+NY*T$6EjPPeP6*Q8c$9eVCKl"FGj,i5CZQSVVM@!+af5c%flYRme`65 +lp5db"FP*ZP`J'`VC$aR2+Q@mERCaLh4aK9em3(jCJa!X,[C-eG925B@`9$JM&5b +"UeZZXUYEF29kG[91q@8!Ib(iqNAHl9cIqH1[rim&)h8("ZMkQi`-KHY6drhL-Ph +32-T-CCc2&G"YlYbe2(a$B)RH0YP%@IE"K'4QaV*Y+-VfGPqrIC+51&PM9`'Q4TZ +*E$6,RQQbbFJR5G[2GQTEf5Y653U$'fbb6eX2CJ13!-dQZi"U0VP$fiIAK&BA3$Y +f!$kl"J6Rf$YTBZI3`9j82(#*+j!!*CG4eSJi`iZC`Pf(Mp1Np#V0U8[Y(#0!!@$ +%&j+(cM!hM*`fU-JlUi*R-J)B5El1(Yd!JD@m8['MLC@U1U(D+"b!+$YHXd5-I2a +jIrd+2SkTGY,%QrI#I(kekR0R*-aI&(I#F*k%N4a&9VeKjl-VH*Jre)-LUf##*!9 +,CX"i5L'fIa5BGQ[j3k`i)bFFk5epp"*9JQbRJAHT+J008H8fNM`UQ5+,dk4BlF6 +86R+-LT8%9dBCTdT59BN*a,Sl!SUEMK#`jHrKjdJ)4bkHa'Y#2#&Xl%&XLhJDVfl +a-MTFiN*m1-9jH0d5&`J)-D2&`hfP-2"(fCDl8S'ICr9LKUr8RSNX0HT-iY9TE`D +486LN!h(&q3VX3B3Z6Mr!b@!Ej#H"9ET1`#!r`V*HGb"4)9-bQFd&jjrUBX'JE"V +&G*e-Q5XL8NNZ12"dSH+*YYZ(+c-8C4R$%Fp4N!#m1H(ZU6@%4&N6NK-!5b0H&`c +*-(XhrVL'&35[DmH%jMA3X&CcbDbG#d*Va1[5iD!CKQQLl[!dAbr#0dQ3!(p"YV# +'&Dl-V'P9cm#XKXD9@iaRHmQF,B![qi4XCh%(VP38EJpTTqJB!-4*C)immB4@Y`& +1qpSa[%jVkhfi$$Zq*,Ij13C+l4'`,8+Q3M8FV4((N!!")b%GHj38#FU!k&U)$)S +$#Kb1$aR)ILXG%V9)jPBLJ*)0XEhi2lI!H,e0YBRDiBjI03*Gka`ap5pNd%hmK@@ +qX,J#BLLbh82A#)`H,),!"'F*XEJ"cLqfT3,*U0D`@$MiJ3a-9@drFl"Eb-*JU"B +bEK3C4qNjfrX'!hNpMQ!XB,3[KcTbE&rJf'UH9*28P)9,!S-(&J!B)@RMFR[!P#i +H*4@L+Pb(N!$q50e[@aRk0GZMj'3#B`#3!*-E!k)c*3qNVUcD`kpSG+89bM"6*&G +6dM*cfUJqr,RhI2J'Z4M@rKkZ"(rSkCh+U(+FcI+1qcjdcJjbcMa%$RF`9V$Q3c2 +*Vb1TQ8Z"369dl-XZrE%[m,0LJfYMYX'fXG9JUmj"H1N+IMLDT8r`8lmY9$l$e#E +ZX-GJPDhfYr'R%GVHMm4kEfG)GU#`-[)BjrFFX%8RG9436*0&%,)3L$!0851@KU0 +$1R5X!8h,LXXA"@CFe@U,MNS,4V&J)j))bb%JiKNimY'#"4LiFIN2)hADph`ADF' +P#ck!P9FYC%RY)CBCh$39$"aqDBT'harSF#mP`(b&-D2Ke5jKc+dd$CK,*I)r)PC +Kdd50!$)H2##!FJDSdCN18G-A[3+8(+2%X%Qc9ScYZ*d+B@h!SCC2DqS8@-U4)$R +bS%cMN!"+)-$KXV+M-+R5X6&Mm$d(`P``3%&B*b4mKT!!N!$#V&fpD*`QY$%KmiG +$f[VfV'q$(&#[UTV)50fK'YrG2%r%*[j&LbUC`X'8cjh+`*60T'JI@iiNrdF$'D5 +XmQ@TTJFErdA$iQ-Vk%#1)6XFqa+&,mM4M5&QK+QA%D$,&cf,Mhe"TS)Q6S"@##2 +0$A5e1"9rMb*3'+qAb%@[(Lk#%8-KEiFEB$-pm!$'A,Kdr3J"Y%-MkABq",!5!![ +9D!29q1N3I$Gj,%p,46K1)jZ8'`11iD`jY$*MBBf[%)c9QRBHSkQ%#GK$&)CH+N# +9arDAb%@`(P1@![RQ5YN16GK-V`D"VN-V@D0998NH6IblpMK0kmL%fCK9pFLTFLH +%JY@-CS(%Qk6JeTS+[C)VbSpRBikBriD4A#E`F)US[CiF'[*H,5aN,Z-!6h!#dB` +(h'5C'8GJ(`-lBb,h#c)(1U8VL9pUq%"'X'XY1mL66PBC(qBm90Hh5`fP4(Bq((Z +dq+Pfk+K#*BS,m92'R$fd31SqE`DF+`U%!DT-LF'eE("ZC$kjlSLI1@G&jM1hRqA +1*A!5LpKeM(d[@,r,@0Z&!BQ%L)k$V)-D"Y(1(R4J1!RA"J6aP'E*r+Tp!BBBlKF +H+'*1+8NcbE(f'JH)j%Uq#`e@(6QPS%$KFP59P"F*lL4b$VNDNT-+'BFB'K[46)i ++3r,q9Zj,3RL*UNphjQreGh,D!-Ij2*8pB!3L)j&2EB,6PA)h`HY9"lPel+Tb8jS +VZ#Q"6C9!ZTFf`@NP9c6DPT3,%0XScYmK9b!NPbHfj`L8qceQbUfXQYV*MQjZP6Y +5TH$ZJki1iH,Q#MDG4Q#Nbc-(-B3pK5BLjH4$KPlKD-`,fC+)F'"Q,hdbB$Tp#01 +S4ArrQS'B&0b0T%@251aAT'R2#CFeRi%lmPkqNicNJXU(V6R0R+,)l63ARcNS[)e +'ZjL#-*,,f0X`3cB2!pA34,mIP"NX%(6L3VBK!5MPPN0,i3J6F("1`T8QU54lHTA +C$Tj#GMP1e345&9LZm3)%!aZq4*8!M`HSm0dTMXI)E0%M@0[&a)S'Z!R'hB@FUKG +4*LL%+f%Fj[Tc)CJ$a*-(Tm6E!,d!S#Z8C6AFe`[hNRcQ%RI0EN`4h3+95#*k!@5 +QiHGa,0iABX&@XB+4U`'C&JUl%KRRHVJp'C(`Q@Kk(16%50hqDXdiN33j9#Ak,Ki +9Jkj62!9Jmd3'Ueba,0KP1RA9dEP0rNqNR*mGr)0K04T)"R+IHS0,0!i*lV9*5P+ +J20p4ZJ8AkmT)H"aC`)9(R-$pSjeIFFfiUaE"fA4)J`F$)I4!4TTkaN*'3d2ML@' +pJe8PJ!0-9X#P'C@,9J[*dVr@898DYS6F38'f+RN#XX,4&5#NT3S3+A-)!l12h-+ +TfJ-fl*h*l`ceYUjc&b[eQ8EhBjGG[[km0EjqCj`HL0+!#N#h*JGZV,aaGCqLCPS +&"PXV'+b*6S(K,+Y3iG2R*Epjr4[6RjMa[eZHMlBE*cmC+PDmhjMZp!pmVUaTAcH ++!69qm[0+226KQ`prFVd5MmHi&%[(@B@5-lePc1'c1Cd&4e#UG$!3MNpNU&NR2rp +Qb98Z2JQ6qmlYEC*UR2c9k,+Uelq2PJ5lU,0!'Djj9Rq1UhpAr`l9YTSk"r&3'UL +Qb(JNU%A[3&L@QVmX5Zch96AE3*)$DjXfd%!e`C5`6jG9iA)QVd5RSi,H&@lUj9R +*AJ6ik[b'39f-*TK*9@8d+pKNU&3ZjKPX)J`3BUA2aC4kPm2kpq@VpP520YkBe+H +0JcT,Ql!-XYfAh%m$8-jRZQrUbHeX#!ea""e48YQ)B04+"K0P#X,[8'"a8I8`&Zh +qSjkj'q#&cj``((r8)+BjQKA"a)Z@%d!T`N9IN!$aJ-H$8Bl#5E5!+Y$4Bk"'m3% +EFL,iU!l(QKk9HjNe*1lj9fm*VJc"V()#eirBH,fiblCNE8MFEqVI)G+M&S#SR`r +T8D89#"ATjj%mDap-@'*P@5iYq`V,P!%D1"ICaiEm0LJRZpCDKi[FIhrdJ9Q,aCf +ME3T9NZ(LSh$#4q8e0'fS'VH@UdAZCBpQ0a+,RNMX+b%#C`Q3!,0S)&[keN@k88P +q9%hf&)1Y!T@8,dD+bDR5&LHP,RQS!)NiA4DZ"bj*`(i,9CjVX&"c5j2``af0hkY +I3iqb@"&m'&Vr6hmB4-cCZSD1C(HTb+iDVlTU(0I[")[H+B"d&5,NY$@kHm6P0R% +rBpj4aEa$h*AFcGZDEN[jPIr[E9NX6[XrfjLKi)hTC"[6fA4MKYki-6eXBkaA1#T +kAh@)MGdDIXAbDe[65aekqkHrP2V2MApVr&YL8Vkf$%GfR8fiP`(m)GKkqK2p+l) +,Qbql%[f6c*hfG,D5a%IbG(CLGbFEZTaGGr'5[kii$bjh24F&4%QK$!*p*i04a[m +CS8cN)KXbjI1cZjh6&@k1NaJV9Z#kILSJG,*lEVCa,VUV&9kcLbh&idCD$b"4HP) +`S*0a3Lk!)D1!URJqQMfT9cbM(ErG)qidR-*MTC!!m+jC)BSp[4-h)VeCIPYPbN3 +ZK(l*+-3U58H%"f&XfN80pa@Hcrrk'b5dlXH,eBjhIq1*ZIm`p*hre&+hffjF@aV +T&d@R(pPk&"ArL`SX$mhhp9r+(-5@$4E4BlRiF,K%DNa1N!$`dY-pm2NA5)5IQ"I +X8ZrJ3f"Ufb1rBc992'*UicXD%kMY*(hm8Ip6I"VBCmP2qM3CK+)D9#9T"f[D*R& +aQ0STN!!DbCXXX2`k$a8G2)Pq((mf*6H6qVljh2V$AQkDiBVdalJ0CLPHTr1EA$[ +%6VmMXR0arU&Tl+%DpfH[1KBe#89+TXK)D)q4NC!!YUE(*KHX[kXi09EPDV5)FhY +Bf#`NP6[a'!Lrm,RU506[Fk&jKfY53PV@9k,K5RX6GP-9ZfPll&89cYmA'#RlU2S +%,S,M2a*Fe4M9ijLD0QQ6me(T$Jri#mim[cbcrFccm1+UM"0$aQQKM%,KQ4dL5`V +QMZVleYhQ(UTbM+lp,![p&3Zfq@'Q')qdmD+VR"rGA@eC2kYYeLpMI14GHMJ!&Ym +BeIHi2(Mi#+m-$*d9KQB&KU#QNI#q6%S`QP-2#VVrJ4m@#`mZN!!BLjXQ'9Kd)cp +V#6,h9$F$MAAG4ee[)"*8BEq+Q$+52dL,NpfScS2PZpMb(rbdbf1"6iHPdHmT)8@ +UTlHZpbUA[lJQ2AVXrZbAlNC0E2J)QI5&6&4c,kUk(K!H##"Abh2N#M%LkX8#SEU +l`Klq"A6B)hp*kX&J9J`"9RI*)%mE"GA&('1CX"G)rVdRCU8UUV-+VAh#eU0bPT' +bprm%SP2P#50c54MiI#9Pf[eTUZ`LLEFETb2a+4%$&D@4h5Y23%'-GYR%LZTjAEh +9#j%JUG8V0pJfCPF[-LbZIUpY6r8R9B)rJYj8A@"T!`(PJf',c%(915"6*i3RBI$ ++&J3+CY$aerlhVZ0i"*!!6Gb,kSeiT@2HMdCHp8k-[!S!!!*#!*!$#J#3!h)!N!4 +#H!T+RFj1ZJ!d6VS!*%*R5(N!!2rr5'm!"%KA5(J!!5)krpC1Y4!!)'d!E%k3!+R +d)MVrbQF%6V83!%je@Bm[2&T&8Np#CkQJ*&GCMbmm4%&838*RUD!J9b"3)RJ*##4 +5B!ibf'B+-KTJ!N)C8FRrr,[*CZkTSkQM@Bm[2%4548a#CkQJ)&HJ*5"3iN!N$@! +'-KM9Y4!!8FMrq+QM6R8JAc)B0"L`@&I*rrT+3QIq6[!Jr#"I-KJd',#B9mRrqNT +#Crj1m#$k)&mb'$3BX%*Z#T!!3@d'd%""m!!#-""RrNl`!!!J,`!%,d%!"#)[!!J +[A`!%51Fm!#3!*J&)3X6$+!!U!8K&b-A84%K#N!2!`G##60m!2#)I6R8J,`!%,d% +!"#)[!!J[A`!%51Fa!%kk!*a-h`#-)Kp1G5![!!3[33!%)Lm!##pI!!4)jc%!6VS +!I#!"60m!M#)I6R8J,`!%,d%!"#)[!!J[A`!%51Fa!%kk!#a-h`#-)Kp1G5![!!3 +[33!%)Lm!##pI!!4)jc%!6VS!$#!"60m!M#)I6R9+J'SF5S&U$%5!4)&1ZJ!J4)& +1G85!6VS!&N5!4)&1G8U"DJT%J8kk!!C%J%je,M`!!2rrXS"M"L)!F!"1GE#(BJb +!`8K!-J"#3%K!6R@bKf)D,J"#3%K!J-&)3%K(2J")4il"-!G)4c)(6R8N!#B"iSM +LLE+(B[L!`F#(-J2#`#i$5%I1`%K(dSGP#*+#BJ4%J8je8d"Jj%je!*!$A!#3!i! +!!!aB!*!$B!#3!b!!!$mm!!1Tm%&%3e)$!!"B$9-$R1S'YiZ&ElRP&ZjU#kJ&,-# +Y&VE`,r!YGe&Vp9i!!4lq2r+65hNQLaM%"%SP-R')#kJ$EAISXa!"!*!$#PM!!!` +!N!--!*!&I!!"!*!&D3"M!(d!R`3#6dX!N!Fp!'!!miKF9'KPFQ8JDA-JEQpd)'9 +ZEh9RD#"bEfpY)'pZ)0*H-0-JG'mJBfpZG'PZG@8J9@j6G(9QCQPZCbiJ)%&Z)'& +NC'PdD@pZB@`JAM%JBRPdCA-JBA*P)'jPC@4PC#i!N!05!!%!N!9Y!'B!J3#L"!* +25`#3"33!5!"R!31)-P0[FR*j,#"LGA3JB5"NDA0V)(*PE'&dC@3JCA*bEh)J+&i +`+5"SBA-JEf0MGA*bC@3Z!*!$6!!#!*!&-3"R!%8!V33%8A9TG!#3"3S!8!!F!4# +)'P9Z8h4eCQCTEQFJGf&c)(0eBf0PFh0QG@`K!*!&#!!1!#J!,U!#!!%!N!0q!!% +!N!96!(-!C`#["!*25`#3"33!53"&!5k)A8&Z)'PdC@dJGf&c)'0[EA"bCA0cC@3 +JGfPdD#"K)'ePG'K[C#"dD'&d)(4SDA-JGQ9bFfP[EL"[CL"dD'8JFf9XCLePH(4 +bB@0dEh)JC'pPFb"ZEh3JD'&ZC'aP,J#3"&S!!3#3"9d!F!"a!+`%!Np,!*!(5J" +9!41)1P0[FR*j,L!J5@jcG'&XE'&dD@pZ)'0KEL"[EQaj)'*P)("PFQC[FQePC#" +[EL")4P-JGQpXG@ePFbi!N!0Z!!%!N!9S!(S!I!#f"!*25`#3"dJ!AJ%PL%j6Efe +P)'PdC@ec)(GPFQ8JFfYTF("PC#"LC@0KGA0P)(4SCANJBA*P)'j[G#"cGA"`Eh* +dC@3JBRNJG'KTFb"cC@aQ,@9iG(*KBh4[FLi!N!0D!!%!N!9G!(!!F3#X"!*25`# +3"dS!93%6L$T8D'8JCQPXC5$5AM$6)'eKH5"LC5"NB@eKCf9N,L!J8'aPBA0P)(9 +cC5"TG#"hDA4S)'0KGA4TEfiZ!*!$+!!"!*!&c!#1!1!!dJ3)3fpZG'PZG@8!N!8 +%!!3!``&L`!)$k!#3!``!+!!S!,B"(!3"998!N!--!#!!#!#L!4`!JP99!*!$$!" +L!*)!m!'B!)9993#3!``!+!!S!(8"2!#(998!N!--!%B!TJ#k!GB!KP99!*!$$!! +J!!J!SJ%F!)"993#3!``!+!!S!+i"6J#e998!N!-2!!)%)'pQ)!FJDA4PEA-Z!*! +$-33!J!#3!`-d,M!Q0#i`,#!!U5!a16N`,6Nf,#""E'&NC'PZ)&0jFh4PEA-X)%P +ZBbi!N!-D"!#!!*!$!c3Z-!p6G(9QCNPd)&0&35!d,M!!N!--#e9Z8h4eCQBJBA- +k!*!$#!FJCQpXC'9b!!!%-d&%3e)$!!Ch$9803b)5%HCHEK"N,4P%D[*%*!X3@DZ +Q*LHh2BZ-i(ERb%Qh-e2bQAph[qrELM`EhmbhY8#5eFlXbH4*f,ilNa'5j9ENLDc +)laq42j1IbEcCeRB454B6XMFYb5)S31)(rdjCKT&84$LS#cYiiLGf)5c5J1e3aD% +@GK*H(mq1D3bR6lpC+R)6)mRY[@4[%r6@hmf'R%[)+8FIZEr5&V,ejRAjaL3*5bP +Tf0kN&a@6NPGC,a$mi-RK`KFHI%V$*QM4BN6+hFfqTX2b,*5j55k)jb(*(2h&i)X +DJqim&Fee*9$cG*JIMZ6*i#SGjViNe#Xq)@+3!*h[`af,NK")heX@$ED[(5XhPA- +`LA1fRcbNbSE0RBqrZ,m'l)YVm[NQUD!A@)"Ck2@aqNDT+'b%UlJKdF4%D4j'8D8 +QKLJRXm5(8JQR40@4X8N6+L,JmB-'82KL!,85ECR3J#8d%@TbLdfC`eLTT"qR$+a +eU)[Di0J#T6DMFe4B`aLflrdNJ-)Z!m3jBTLiESAmcl%RFHbLl9fAJNh,JDRU`pD +$+ZFdM(GdeX@!G"Z$#pDfYBXaSNc2)HBbh"2bA1lEQ20L2d(0f,[Q&#I)A'ZQ2(K +Bb@@qIDUNT-rSkShVZbh3b(2j4EE#Hi"%aD`5%YXK48JPi!JpjfESS#*')G-lpU& +Zma9#N6ZP%AF+hP-PhjBJ16hDlDNc*qDmR%1jlK@TB-cEfPh+FK[jplG1#3aZ,Gr +mP`rLNbG@J3Mpl)N"@`NmD#E1Ye,'NV,SJ&0-'N"4lGDH(L15jV)kGQArf*KLjXE +BBNT+ilSFVqIQ2L6S6,2!-qdr5A,SM5rZ8%e+qrrFIEa)TAK+(ePf3"KU9mH96Ke +iJM&J8-CCH2(UplHlTpQ8&pIV!mfS&!eYS22Y"H59K,,GX(5'$iDUN!!D1!1%4[D +m+R'd+EK+q$Ll6eBP[SHY1Jm&+*f0f9@c1LPl$U`!LB0EA#,N"l-#h9`&eEjM4Rf +XIVf`GZf$Y!rlJeGII3NEUUX[JA!5-Xp,Z*!!K9k#PFalib#6LH[)jR!53fYB8Y@ ++#cA4e!fZkRA5eL(bC5reTB0Nq+`1N!#ULm1*SfpKL@KA(V8&MK(J'6fDpK)ZJ-$ +X$'lTUd'pQXb1L-Hl60lqhlJ2YkIbbBfVNkBAI5lbXT26-1CCQI@i%dADZX@J'V( +"P$45$f-VG@mlh@!+D@pipZKGMr,CUC9ZcXXMqF'dI'XXGU%XA8IkajQ+#fPh$2A +j@FVRjqVrINKT#[0r9hl1a'Bar[EhjGLF9@FZ6fPZ&[UQ90aX9RVbi))fT0[hNY6 +0m9Pip++5qIc2PqqBK`c8pE9GaLXRlhFHm(""&mY9YB2CTqfiUkZ$G385RX(1bd[ +ERX3qk'4JZaVPpDGj!R%'T["3[!PH+Gc$PhJ`"hHqIVA3@F0Eeq31!!!",d&%3e) +$!!&Z$98,Sa,3(`,[MX0G"i1VS')4Q(4+"CeP@S'Clmb(SM82Ip(I(*K(D4A2I'$ +q&[0K9K8c&"2&r$@V5EkTU*K9439&phSP6c(*!"1aC5A+J0LHE33'eM"R5Q-Af($ +455FbMP!J*%5L5"VfFJe#ABTbVcRA4B@a96dp+RHhD`rFF&F@))QYk$RCaCMM3iY +@r'%I9"NNRi3H&+6Nb+Ekq,R[CKIQhmVFF$J`VdQ5m'YemhE`p&D5E6j5(VmrPl$ +l$k3rXTPHl)!0@&jc$0ZABIP&mp&"JI!#DaENdTMml81I`#icTcGeq@6Upd1K&[m ++1ImYiqD1UMI2ikh!"rA+h@GFD3IbmLC@e9$jp9!k6JUl9a2!KP1+'B$U)Bc230$ +[U!%J"*%91SCK"!!!#4G"4%05!`!1K3jG#k55),ibhjhrq-jHjTcIRm3X@FlH1F3 +CSh%X80,b[R0QLXqEJ*aX40@UcFUD#%5Rl(e8JllrGqBa*dc)b``NKG+`*T5N3Y" +1UPMIThV[djD9N!!b0-6@8G9SS`-*3XV@EJZ,ppfG(@H&VG9l$HjZ05)#-d3M(d0 +&9JkT3rK[IJhrMG+c8Cl(B+4U`aFMihF0N!#jkkJ(bAf)aK,IG)P[ca,IG-NC,*) +9Q2S@4ApLIjK&+S'Id[Z4`Ve!C&F!hk33*VJjb0NB50)-%!X)p`RCp6"I8pTh4UI +[+E8`dFID4ZkGr@lA$AQDlbldTY[ZH@,hr!+XiD9#H+cpQa8c%jVX(JTT(9@GRD& ++8bJflXSeSl4`5cY$Y5BUZhI&Y(p9rDdY9MhmA'a'S26RfD0D,'"MJPS)PR+'Y$* +IGS48-42MQe(`[2"&@fPYS(Z$2,ZVS#hMPle6m-bhq8GG`NZPN!#-)R+V%99PNPl +h36fhm*9bM*6G5(DLl6*[`RRN%1kYe0apJX"08h9pBpI"UeK@ZP%fDY[@f0f"j$F +B'16,"hmb'lqqr(ZIF,[qqr(8P4F2LPmU8Y6lJ@,C*HD'0C[m5%SlDaYhr0f9c5@ +RlpTrl%Ba0h%pIrF&([T)hhCPQkhZV!V"p*ICGPYr00)ATYFTIIZZ+Zh!F'lqJ+R +pekRmf5JSrZ#`Jfc9YhilkVTHh9L([6AGJPqp[j5#5'i#SGl@1!l!f0$([Z4B9)J +pbTMr8K%pV8&b'lM9+a*8%hV&U'bb498Z@DQS*MRZ&3U9S9IX$jNN*bhPP@UI8TA +)Arc+eR608jlGh#RG(Y%mCIVZHjY0eR5&1qC1dXc90emD5,Ej@(eFD1XV&rqi5CR +VdF[i&43@eN[fU#"2lpYa(VlC*ZUUNZp0XGNQB,2*LUI#aR9CrBK0&Sp+b8*6C1J +9E63Tqf"5i25flDL4ELQ!0#R1JdB29[1P&-F&`EQV34i-5ZXME9iP2CJ#Sq!JM5U +KU,HpAUd@9Ujj,Ce3erhrA2Y0)fVEk2m'%q('2UUC%2HLD&+GqD$mXUXk4$HdCk9 +'VaEk0mH(e6-fT4pmjRa9e3I09fm)JH',*UjGkCYBVDUp[eRI+)5dJF4`UL@ija2 +YP0UeSHUUm2!Y1A!N#i,p%r+mraE)KC!!h)mYI"M-*-j`h-92m%VhR)6A)GbRK)! +S@)q!m3bE39ZF$L3#NlajP54K$2XaQX4Q&+bEm4`j1AMiN!!D$8bLH48j)NdQ4Zl +PFU1$$j(RK3$Nj8cC#bja3Z9@VceajE1aV$3CP1@85*e1e)0Q)jGcLA5!ibD49*Q +cdSUIb6+I1lrc$,UNCTa,i@!(l&NX8Z!UXl)Fc@N10p%$TmlaarF12*%VqVQP+Ib +mGAC[Z(*i4%i0ElMdXHT++-Ze+['9N53H0#4Y9,3%Ib#8d),3L422HK!GJGBFY,L +Yf`X9ljIeI"9HZ54kVCUF308$Ta+%AGi0FXiSpX5"dhYD$!,RQ3U0(P3fjfdBeq` +NrZ'e,erl6RVGI#'mVR"`phbT-2,3[')Sd$cb3&!%V`adK&KR!aa2Y%%,Z,h0rNH +#iVJi,$5IJe1*KV4GN8AeTLJdhii*%jh+4+0lL-6G`Gb!1(p'+l"R#Xqlj[FAI)G +0QQ+9i'Uh+QCdXfkhYb)Q$Qa("&X5L'&#mPXXm@0)Ucd%5eJUcINKX48pJ6d%PbS +*K&[ci9Z%V*(I3hJPL`MrdJSI3`D53``T(FqmS[EkqkCA(rKLZIm!-KZ&[1GiTPF +Gl*ZpSH[blmr0kANl3fU1pr3DII1R0R@Yr)*!qJH3!1C*GFpaYEH[Hmh&ZN*A@%M +6!%pD0diEiCSl$VHQjr`k#`[26@IZ9DI$daI6KAA2pN(q9D3Y+FMIp2MMdq%6Qbl +q,Td1hibPQPH&k,ZJH0C&,1fSJfdU0CD1i33[B404!YdjT'r8eK+UMqe@Db3GV(d +cl%e2@"m1dpJq%Rh(6	H,q%2[!CM`9RLm[r%li9iPZYi6IUKXJLDiC`*LQ1j@0 +C1-R3A,AUd"L@,!$X'#)f9Q`GU4qjDTIlE$mqA(M5%LlfVkUm(4R$6f-Y*2qH0D6 +p36il*,[YSYC3Ef@,rIqX9*l!Ebf0'B$Bc0CR("AbR`1@-IY,[Y#8e9pF9R&@mL* +83(aXZ8)Z"La%VB`"J[[p584Bj!eI5+Z3!-m'FQle8ke"Xl)9E+f!P-EiV3U5Rr1 +e(UmFZASXGdNpP#jSPS%Mep04%N&XLQ8J!kB+PhfShJLZT1Hk&EZ'!AIMZcc23,, +Q+,p414k9S,B6,'a82bfhAaYETNrA%56ja02ZG*T5j4lME!"-qUA2Y$MMJiY4T!6 +X@Z)k)D`B8d'!AjJ-cVeXTE3(16-(E(Pb4Q#Tj'@9#%5hl5$Glld`DH2L9KVmeH* +EFa9hpIDl1`$QYF(BlY&bTX2dqBA$reLmd2TDRl(Y0,(GBIAPhAX"rrC*9qj6Dcd +$H#M1@jc&$Y'NGA48bXlAXh*S@kH!Zkfbli`-Z2M"q(b&pHX4I'G4%de6YE9A(RA +@qh)a&f[!UpMFMmNq0q"eB[piVX)kEUcG1DPY3V0$`62A6#EC@@pc!%i&h!kia8U +MBYEe3)A945F$!Zi8m+KTci21HV%pT#rHl4bkG*dEl!9mF@EmL(@Qr)X@N!!HQJG +M-lYP`%2C`r@*QVC6V('0%["TN!#F,[k0%(eX#hU3!0aHNqRj@JSe6JF*I04KqTH +ADUE2Tc,B-J[*j9f1hMkq&-B!U*!!KfX`AB-8B"Ah@IS[4f&li'IQ$1CAe9if%ai +qGN!&Q%S4&CiQhDIf@FS1cNUjaA2YaBpQiQbY3i'CP4mCLmX+L8rILUK3`8dZHmj +aV0YkRM[jP2ccRlVip*4Me-qAPMjP-@A,$9P,I85&#Ulqe@iaGfcqU-aPXh*qlF1 +-@ZZSlH5C1mA0TJqUQTkf2j&8)5`qd`4i3-FVSVN)cQ3YT[jL52V`9&+&J$mj!EM +GASjQX`p@2&,*6%A`c5D4[Tl00DT3H*AkL5leI''P)l9im[YlhCrhTp2DG*J[E4# +Y4L*[6e`je+K#q,'4%64@!PYK&Z!k%mV9AKd1kGd&SBA5Q+kqLIFl@5H@2&IJeq4 +4!*!$'!!d!!!"(!&S!!%"!!%!N!8$k!#3!j3!N!-)!#!J!3!#!*!&('&eFh3!N!- +"4P*&4J#3"B"*3diM!*!&J!#3!`G"8&"-!*!&!3!!!3#3!`+!!!!%3!!!#5!!!"1 +3!!!!*mJ!!%%%!!#"!J!"!!%!!JI!J!32i%!)''!J%"[m%#3DP!K-'[3NRc)%-N` +ek2NN05Jb%$Ii*!J`i!J%(q!3!J$!)!%$m%!!J!#!!%#"!!!JJJ!!%q3!!!R)!!! +%N!!!!!)J!!!"3!#3!i!!!!%!N!-$J!!!"m!!!!rJ!!!Im!!!2rJ!!(rm!!$rrJ! +"rrm!!rrrJ!Irrm!2rrrJ(rrrm$rrrrKrrrrmrj!$rRrrN!-rrrrq(rrrr!rrrrJ +(rrr`!rrri!(rrm!!rrq!!(rr!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!$J!# +3"#!IU5!a16N`,6Nf)%&XB@4ND@iJ8hPcG'9YFb`J5@jM,J!!&8J!N!-"GJ"1F8U +$CKT"l3!J-,`!#$&m2c`!!M&m!!%!"$&mUI!!"Lm$,c`!!"5Q3IVrd0$m!+)[#%+ +RB3!#*Ylm!""R%NU$C`4`!8je6Ud!)Q%!!pDTp%ja5S0Q!URdF!"1G@"b38a"4%4 +$69!!!`#30&"b3@e)jf$`G$+I`Lp)!#!J6b*8-@N!&!!B)8!!*$&m!!%!,0+4)8% +!,U!#hm*-h`m'6R9+1!THC``J+J!)C``J3#!3C`B[1[q%6R9)jam'3IVrRR!-)LS +!"-+i!aTKT'B!!4*)H[q16VS%i&K2X(Vr@QB!!1bK'Li)##S!"J!%C`BJH!+QS"X +X+J!%+LS!#"JU!!5Ae*A8)$Vr9U%HCJ!!c#a))$Vr5L)'`VJ$'PK"B3$r8L!krd, +!Z!-D3IVr2L#!5S9Q"+%LB!3J4D!RCJ!!Q#T),cVr!Lmkr[S[1[lb,cVr!Lmkr[T +)H[m5,a!J1[m!8B""q[lf))!J$P#!3IVqk##!5(S!HQ%!#L6Hr!!J5N"R!URr)%k +J(b"(S"Yb!")%j`RM'H34!!%!)!)"!1!J6D"T!J!!(i!")%fJDYA8ep4"q[kB5T! +!C`K`!D'BF!1KQ#"0*8J!#(!!60pJq%je60pJq'!!rZ!J6U!IeG6Ae#"(S"X`1!) +J-F!+B*()B1"19J!!51F!1#KZ!!a(q[jD4IVq@L!8X**Y"#!5+)"+J'm5)&-LEJ! +)SLiJ&0'6NC*`!'!%-$crf8cI(!"1ANje6PEreNMR%aJX,J!35IVpmN)(S4SY52r +Q5Li!#fF')(J#TU!E,c`!!+$m6VS#RLe!rqTB6fF!!Ai[,[rU6VS"q%S!@%pR"R! +"B!!"FNKZrrK)E[rd5'lrlNkk!j)J,[rdS4iY52r`6qm!$'F!!8JJ,[riS4iY52r +mC`!"1LmZrrJ[#%kk!qC+VJ!88%pQ!!#8@Bm[2%024%9`!$m!U"mQAb!,ChiJ%h) +Bd)%[!%kk!Y`-3!!$@%pQDL!0FLM3J5e!rpSJ%h3Bd))Y32rH,`"1ZJ,`5-!Y32r +L)%ZJ+5!Zrpj3J#P!!#KCMbm,6VS3d#!IFL#3!)%T3!!X,blrr#mZrr3[,[r`,`B +[,J!-5'lriLmZrpT)H[kX6VS)9Lm,UD02l`!N+@lrkJ!-+@lrm!!3+@lrp!!8+@l +rr!!B,c`!!+'B6VS"L#e!rpB[2!!!U*p1ZJ&k)LlreV#"9X0%!dL$5--T3`!F+8B +!)#PZ!!`!*%Kkr*!!2cbJr#mm!!#Jr%kk!54BMam!6VS3@#mm!!#KQ%kk!6T+J%r +[!!aR"%kk%&B`1!&Di%!-3!!'CJK"qJ!D)FJ$2(i")'lrjU!E%!G-lKM)rm*1ANj +e6PB!!%MR!4K#"bmm!!#Jr%kk!2)S3#!-@%pR5#m-6VS!8%S!@%pR2#C-,bX!$$m +mS2`[2!!!S2a1ZJ#L@)mI!%kk$pBJD`!3S"mJD`!BS"m`1!&Di%!-3!!'CJC`!#( +!!caq!4!(61iBJ2rd6Pj1G8j@!!")ja!)+'i!#(B!$+a"6%&%!!*Q&!bX4%008!! +'CJT`!l"X!!TQ!RB"%!0-lK!)rrK1ANje6PB!!&Q22cbSER!"(`"1ZJp-@Bmr2+T +ZF!%I!%kk$ciJ(l#ICJB`2!)!B!3`2!3!6Pj1G8j@!!![!c!m#!$!EJ!+FJ!b!%U +"8X0%!fF%F!&J!R!!*Llrr%jH6R919J!!51FI!$iZ!!T)abm(6VVraKS!F!!3"3a +!!!&B6fB3!NF(rdkkrhb`4fi%F!"J+PQ22cbSRh!"(`"1ZJl#+"pCMcm((`91ZJk +f,"qiKPI$4!0R"(!!B!)J"NcZ!2Mrl%jH6R919J!!51F4#$iZ!!iJEJ!)+&"f!(! +!-"3-J!!!384Q,R!!-#`!!Jb!!!"$8QBJ$%IrrfFB)#`!"%*!5%$J5#)m!*!$rm+ +!5-HqJ@B#GJ%3!dcZ%)Mrp%jH6R919J!!F2m[!%KZ!!K1Z[qB5J"36fFD)'i!##! +S!!4#3%K!i%JL2!#3!rr#J$!"B!*`rdjH6R919J!!F2m[!%KZ!!K1Z[pL5J"36fF +3)'i!##!m!2q3!m#S!!4J!R$r6Pj1G8j@!!")j`!B*Qi!%#KZ!!`JEJ!)-,`$!A! +!+)!'P!!!!53'P!!!!NJ'P!#3!b!'P!#3!i!'P!#3!i!'P!!!"*!!"T3!!!%N"T3 +!!!53!!D8!*!$I!D8!!#!!#D!"T-!N!-N"T-!N!-J"T-!N!0)"T-!N!-qF!"-lKJ +!rrK1ANje6PErp%MR%aJQEJ!),8[rp!DZ!*!$*2rd+'lrp!DZ!*!$)2rd,@lrp2r +i"Ui!N!0)rr3YE[rdrr`'VJ#3!clrp#!Zrr53!+i!#,#Z!!aM"R"PB!!!X%*(3NC +J4R!!-!F-3!!%9F0%!fF%F!"J$(!!-!GCJ()%6VS0)R)!-JFAJ"J!F!!`"b"ZrrM +3J$''#!"`!$!(%$-)!()"iDRF36!(8NG`!$!($%!!*'@`3NGm!@"'F!!`"`a!!!& +9`d3$C`4`!'!-F!!`"e1!FJ*1ZJc-FJ!b"aQ!'!"`!$!()'lrr0#!-BB)!(!!-!F +30!J!FJ(KUGa"-!G54h!!-!F-3!!ICE"`!%cZ'-Mri%jH6R919[rm51F2'#CZ!!` +SEJ!83NCJ$R!!-!E3J%*d#!!`"P*'F!!`"R)!-Li!%Y+"XS"ZiN*'H!*J!!#D3N9 +#4h!!-!BJEJ!)jB!YF!J!rraJE(!"`+lrr0j!F!!`"A)!-JCd!"3c'!"63NM#Y)" +[+(!!-!I3J()!-M3)!%U"CJa`!$!(d)!jK!J!9%4`!$!(d)!q0!J!B"K`!$!'FJ! +b,J!5dS(5J(!!-!I3J$Q"#!!`"9*&)#lrr1+),8$rr(!!-!9b!$)'G!!8-aJ!Y%" +LJM!'8NDmEJ!5C3$rBNcZ'2$rj%jH6R919J!!51F2'$iZ!!iQEJ!3+'i!#$JZ!"B +k"qC0F!!`"h`(c%"q!(!!-!830!J!l#Kb!")!F!(!!A)!%J$HJ5!(d)"b!$)c#!! +Z!9*'F!!`"R))XS"Q"N*'-!954A!!-!63J,#(BX"`!$!%d)!L"j+!%!&-lKM`rqK +1ANje6PB!!%MR$`Ji,J!52Li!$LKZ!!Jm"qC1F!!`"hS(bN"`!$!'IJ!H0!J!F!! +`"A)!-J65J1D*CbT6J@F@8i&Q)R!!-!C8J()!%M3)!%K"3N'1JA!!-!C5J()!%M3 +)!1'*MS&`!$!&i+p`)*!!"(,ri+R#Kc!"61i3m2rX6Pj1G8j@rqT)j`mB*Qi!##K +Z!"!'VJ!!!53!&!DZ!!!#5!!8,@i!&2rd"Ui!N!-J!"3YEJ!8rrJ'VJ#3!i!!&#e +Z!"6rr"!6jJKb!")!F!I!!A)!%J"536e"rqS3%q))FJ!5!(!$`!&b!")!1!&84(! +"kDJp32rbF!!3%h*!`J"`!"!"28$rm(!"kDK6J$e!rqj`!"!6FJ(#!'F+F!!`,[r +Z8i"J!R$r28$rl(S)5Qlrm'G@,bi!&#mZrr4`!$!Zrr)[!#!,8S![!%kkrcKb!$) +!ji(D35mZ!"3[,[riF!!`,[rb,`![,[rd6VS)I#mZrra`!$!Zrr)[!#mZrr3[,[r +i6VVp)Nr[!$"#4f!!!2C+E[r`Cc*`!$!Zrr)[!#mZrra`!$!&,`![#dkkrGjm!"` +!F!!`"L"Zrr4b!")`#!$D38r[!""J'R!!-!3[!(!!-!8[!#m,6VVq,M`!fN42l`! +-['lrl'B3-!G54h)!-J"#0"J!B!!!MVaZrqjQG%TZrr"R-R!!-#lrmLm!,blrr(! +!-!8[!#m,6VVpF(`!(!"`!$!')'lrp()!%M!)!0T"6qm!%'!DF!!`"#m!F!!`"5m +!,`Y1Z[h!2!$D4%r[!!a@4Q!8F!!`"e1!FJ!b"aQd#!!B!$!(8NF`"P0'5N"Qj'! +5%!E3,[rV-JG54h3!0!%CJ#J![Qi!$Q8!r`C`!$!&AS$QL%cZ'2$rdNjH6R919[q +'51F2'#eZ!#6rj!DZ!*!$*!!N,@i!*2rd"Ui!N!-J!#3YEJ!NrqJ'VJ#3!dJ!*#e +Z!#6rq#CZ!"c@r!%Ne[`#50Em!#$@r!#!e[`!J#e,rpM@r!53!#e,rpc@r!%N,8[ +ri0Em"*!!,8[rm0Em!(`Y5rr)er`!!)!!)!Z3!+i!(,#Z!#"M"R"PB!!&8RS!3NF +J,[r)d,`!!)!!,8$rc#KZrmJYI!!!J!$rr%KZrr`[,[r))'i!#%k3!%UZrra36fB +'F'GJ!!8B)!a5J,#ZrmaMC#e-rlSYE[r-rliJ$&+!N!#ZrliY32qf)#lrZT!!V[r +),8$rXL!Zrlk3!+lrZLe!rkjR$#"-)Qlrb#!ZrkkL,LKZrklCl[r)5'lrXLmZrmJ +JEJ!)6T!!)#lrXV#ZrlC36f3'F'GJ!!5U(9crah!!%#lradM!d)"63$e!rqa`!$! +Zrqc3J$e!rqiJEJ!3)"$3VJ!-,8$re#mZ!"`[,[rF5(J"*#m-6VVmG()!-J"+JGR +",bi!(#mZrpK)H!%N,blrh%kk"E`[,[rJ5(J"*#mZrp`[,[rB6VVkCLmZ!"`[,[r +FF!!`,[rX,`![$%kkr#jb!$)!5S(C`5mZ!"`[,[rBF!!`,[rX,`![,[rF6VS&FLm +Zrr"`!$!Zrq`[!#mZrp`[,[rB6VVk'(S!3NFYEJ!-rp"2l`"JB!!$X%*'B!!!Q(! +!-!G+J'Cd)!a5J,#ZrmaMC#e-rkBYE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r +),8$rRL!ZrkU3!+lrTLe!rjTR$#"-)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJ +JEJ!)6T!!)#lrRV#Zrk*36f3'F'GJ!!0HHJ!D((i)F!(!KGa!F!!`"L"Zrq$3J$` +`#!$LM6!(8dG`!$!'$%!#5'8!rf!%4J*)F!!`"Ja!!3"N%#!Zrp"5V[r3)%!3KQ! +!!ZS%4J%!F!!`"L"ZrqM3J$J`#!"`!$!')'lrj()!%M!)!$e"rm*`!$!Zrm*+J'- +!!+*JH#!-8S#`V[r-Bf3Y62qQ,@lrc2qU)!a5J*!!V[qU,8$rSL!ZrkD3!+lrb#e +!rjiJ,[qUN!#ZrkBY32qDC``J6#*ZrmJJ,[qDSLiSE[qDfHlrb%KZrji[,[r))'i +!#%k3!#!Zrjk`V[qL8%pN"R"RB!!#G(!!%"c[U)U!8%G`!$!($%!!''-!rhj`)*! +!,[r$F[rJUF+&f%&`!$!Zrm,JVCjZrm*#4Q!!!*K`!$!(5S"QG#!-8S#`V[r-Bf3 +Y62q5,@lrc2q@)!a5J*!!V[q@,8$rML!Zrj+3!+lrb#e!riSJ,[q@N!#Zrj)Y32q +'C``J6#*ZrmJJ,[q'SLiSE[q'fHlrb%KZriS[,[r))'i!#%k3!#!ZriU`V[q18%p +N"R"RB!!"b(S!'Kaq#(!"`)AF3(!!-!BJE[r`d)!m-!J!iSd`"e0(['lrlQ8!rf5 +FE[rZF!!`"L"ZrrM3J$e`#!$ra(!!-!BJE[rdFJ!5-!J!28(r`R!!-#lr`NU!B`! +!T'"i)!a5J,#ZrmaMC#e-rkBYE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r),8$ +rRL!ZrkU3!+lrTLe!rjTR$#"-)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJJEJ! +)6T!!)#lrRV#Zrk*36f3'F'GJ!!$qF!!3(1qSLS"34h!!-!F-3!!BB`$rIR!JN!! +Zrm0brq#T`SA6E[r%F!!`,[r#i+fHE[r#F!!`,[r%5S!QE[r3Pm#hlJ!-C6BJE[r +38Ulrd"#E)'lrd&+Zrp!3Qb!Zrp"5V[r3)%!3Qf!+)'lrd&+Zrp!3Qc!%8d4+3'E +ZB&C@4#!Z!"M3VJ!8FJ!b,[r%*#lrd*5Z!!b5JLC!Pm&J$L"Zrp"5V[r3%*X`"&0 +%5N4R$#!Z!"M3VJ!8X)YLiLCZ!!aJ#L"Zrp"5V[r3%*X`"&0%5N"QlL!Zrp#`V[r +8C3$m5#!Zrp#`V[r8C`4`Cf!3)#lrd*!!VJ!-)'i!%##!F!"-lKM`rfj1ANje6PB +!!%MR$aJQEJ!81#i!#LKZ!""J!!%`2!3q,J!18NDmEJ!1C"*`!$!'FJ!b""!d#!# +`0"J!CHC64lK(C"*`!$!(FJ!b""!d#!#`0"J!BZLq4Q0)F!!`"RS!'M3)!(!!-!G +b!$)''E3)!"J!F!!`"aQ&#!"`!$!'d)!k-`J!F!!`"p#!FJ!b"Y+"0l-)!"J!F!! +`"p#!0i8)!'##Z%GQ"P*%B!!!SR!!-!4k!"Sd#!"`!$!(FJ!b""Qd#!!B!(!!-!F +CK3J!F!!`"0#!1M-)!(!!-!I3J()!-J65J6Hc#!!B!(!!-!I3J$H&#!"`!$!(FJ! +b"*!!JA)!-Li!$R3!0!G5JT+#XS"M(Lm,,`a`!$!(,`"`!$!%,`"1Z[lQ1!G54%r +[!""J)#m,,`a`!$!Z!!i[!(!!-!G5J#m!6VVqa$e(!!j2l`!3F!!`,J!1FJ!b"*! +!JA)"XS"Y!2l!61iBm2rS6Pj1G8j@rra)j`mB+'i!&!DZ!!!"*!!8*Qi!&%*'B#" +`!$!')'i!#()!-JBCX!J!'!"`!$!'d)!hKJJ!-!C54VaZ!!jPfLm,,`a`!$!Z!!i +[!(!!,`"1Z[j)3NC2l`!3B!3`"P*'['i!$Q31F!!`"R)!%M3)!%U"CqK`!#e!rra +JGR!!-!C+J'-NF!!`"R)!%M3)!(!!-!C6J(3!&$3)!**#5-%J,[rmikJY32rmF!! +`"RJ!'$3)!#SZrraq!'!1)!IML()"`S@#J#i"iSd`"&0%5N"QkR!!-!E3J()!-M- +)!#"Z!"$PJ5'('!!`"P*')#lrr&+ZrrbmEJ!1CB4-lKM`rq41ANje)PmJAk!P,S" +U!N+A6Y%LAa)I-"p+!@F%TdCJ!U0',SK1d5*I%Km`(b"I5J&R"+C(B!+L4dl4)Pp +`!D'B6Y%L,`!%)#m!#%(k!!SbI!!#6[#5rQ!'6%%)!8je6VS!*#!"6R8L,`!%)#m +!#%(k!!SbI!!#6[#5rQ!)6%%)!F0!6R9+J'X85S&V"Nkk!%C1G85"6VS!2N5"6R9 +%J%U"D`T1ZJ!`4)"%J8je4)&1ZJ!N4)"1G5)[!!3J,`!)3IS!#M*m!!*1m*,qB!K +-33!"`d"1G6m"5%&+3@BF)J"#38K"C`U#edK"5%!`!8K!J0mb!%*!5%"1G8K"2S) +[!c3!*J&b!8*!5%"Q$%K!-!*b!'!@dN&P%Y4#dB#`JfAdN!#$dN%)`3!!C1iQ(c3 +I6R8!!!%!N!0AHJ!!9RS!!!*k!3,f[$J`!*!$(!*U!"&%394"!*!$NPT&8Nm!N!1 +H4&*&6!#3!kT$6d4&!!-!YP0*@N8!N!2Q4%P86!!(!2*"6&*8!!B"8P088L-!!!' +QGQ9bF`!"!E*69&)J!!%"bP"cCA3!!!(L8%P$9!!"!Hj%6%p(!!!#"NCPBA3!!!) +53Nj%6!!!!Kj'8N9'!!!#+NP$6L-!!!)fBA9cG!!!!N)!!2rr+!#3#Irr#!!#M!# +3"[rr+!!#[`#3"3,rrcJ!!X-"![DF!!(rra`!+SB"![D!!!$rrbJ!,-`"![A-!!2 +rr`!!35i"![A3rj!%!!!Y,!#3"!3"rrmJ!#dk!*!&KIrr*!!YZJ%#pR3!Krrr!!! +Z%!#3"BErrb3!,Q!"![C-!)$rr`!!,Z)!N!@errmJ!#p!!*!&J[rr!!![XJ#3"!2 +SrrmJ!$!3!*!%"!(rrb!!-$`!N!@#rrmJ!$"-!*!&KIrr*!!`A!%#pP`!Krrr)!! +`E!#3"BErrb3!-(`"![CB!)$rrb!!-)`!N!@"rrmJ!$#F!*!&J2rr!!!`V!#3"3( +rrb!!-,m!N!8#rrmJ!$$d!*!%!J#3!b!!-4)!N!3#!3!()!!a)J#3"B$rr`!!-5i +!N!9rrrm!!$9P!*!%!qMrr`!!0TJ!N!3$k2rr)!!rX`#3"[rr)!!rc`#3"B$rr`! +!2pX!N!@!rrm!!$rl!*!&J2rr)!"!"J#3"[rr!!""#J#3"!C`FQpYF(3)a#"cG@C +QDAM(93: diff --git a/mac/tkMacResource.r b/mac/tkMacResource.r index 3ff3db4..491ff72 100644 --- a/mac/tkMacResource.r +++ b/mac/tkMacResource.r @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacResource.r,v 1.3 1998/09/14 18:23:39 stanton Exp $ + * RCS: @(#) $Id: tkMacResource.r,v 1.4 1999/04/16 01:51:32 stanton Exp $ */ /* @@ -73,12 +73,7 @@ resource 'vers' (2) { * will load the TEXT resource named "Init". */ -read 'TEXT' (0, "Init", purgeable, preload) - ":::tcl" TCL_VERSION ":library:init.tcl"; -read 'TEXT' (1, "History", purgeable, preload) - ":::tcl" TCL_VERSION ":library:history.tcl"; -read 'TEXT' (2, "Word", purgeable,preload) - ":::tcl" TCL_VERSION ":library:word.tcl"; +#include "tclMacTclCode.r" read 'TEXT' (10, "tk", purgeable, preload) "::library:tk.tcl"; read 'TEXT' (11, "button", purgeable, preload) "::library:button.tcl"; @@ -128,18 +123,20 @@ resource 'STR#' (128, "Tcl Environment Variables") { */ resource 'DLOG' (128, "Default About Box", purgeable) { - {85, 107, 243, 406}, dBoxProc, visible, goAway, 0, + {85, 107, 260, 412}, dBoxProc, visible, goAway, 0, 128, "", centerMainScreen }; resource 'DITL' (128, "About Box", purgeable) { { - {128, 128, 148, 186}, Button {enabled, "Ok"}, - { 14, 108, 117, 310}, StaticText {disabled, + {143, 147, 167, 201}, Button {enabled, "Ok"}, + { 14, 108, 137, 314}, StaticText {disabled, "Wish - Windowing Shell" "\n" "based on Tcl " - TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n" "Ray Johnson" "\n" - "Sun Microsystems Labs" "\n" "ray.johnson@eng.sun.com"}, - { 11, 24, 111, 92}, Picture {enabled, 128} + TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n" + "Ray Johnson & Jim Ingham" "\n" + "Sun Microsystems Labs" "\n" "ray.johnson@eng.sun.com" + "\n" "jim.ingham@eng.sun.com"}, + { 19, 24, 119, 92}, Picture {enabled, 128} } }; diff --git a/mac/tkMacSend.c b/mac/tkMacSend.c index 45a63bd..1bc27a4 100644 --- a/mac/tkMacSend.c +++ b/mac/tkMacSend.c @@ -6,18 +6,41 @@ * to interpreter. This current implementation for the Mac * has most functionality stubed out. * + * The current plan, which we have not had time to implement, is + * for the first Wish app to create a gestalt of type 'WIsH'. + * This gestalt will point to a table, in system memory, of + * Tk apps. Each Tk app, when it starts up, will register their + * name, and process ID, in this table. This will allow us to + * implement "tk appname". + * + * Then the send command will look up the process id of the target + * app in this table, and send an AppleEvent to that process. The + * AppleEvent handler is much like the do script handler, except that + * you have to specify the name of the tk app as well, since there may + * be many interps in one wish app, and you need to send it to the + * right one. + * + * Implementing this has been on our list of things to do, but what + * with the demise of Tcl at Sun, and the lack of resources at + * Scriptics it may not get done for awhile. So this sketch is + * offered for the brave to attempt if they need the functionality... + * * Copyright (c) 1989-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * 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. * - * RCS: @(#) $Id: tkMacSend.c,v 1.2 1998/09/14 18:23:39 stanton Exp $ + * RCS: @(#) $Id: tkMacSend.c,v 1.3 1999/04/16 01:51:32 stanton Exp $ */ +#include <Gestalt.h> #include "tkPort.h" #include "tkInt.h" +EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); + /* * The following structure is used to keep track of the * interpreters registered by this process. @@ -27,17 +50,12 @@ typedef struct RegisteredInterp { char *name; /* Interpreter's name (malloc-ed). */ Tcl_Interp *interp; /* Interpreter associated with * name. */ - TkWindow *winPtr; /* Main window for the application. */ struct RegisteredInterp *nextPtr; /* Next in list of names associated * with interps in this process. * NULL means end of list. */ } RegisteredInterp; -static RegisteredInterp *registry = NULL; -/* List of all interpreters - * registered by this process. */ - /* * A registry of all interpreters for a display is kept in a * property "InterpRegistry" on the root window of the display. @@ -61,54 +79,19 @@ typedef struct NameRegistry { * been modified, so it needs to be written * out when the NameRegistry is closed. */ unsigned long propLength; /* Length of the property, in bytes. */ - char *property; /* The contents of the property. See format - * above; this is *not* terminated by the - * first null character. Dynamically - * allocated. */ + char *property; /* The contents of the property, or NULL + * if none. See format description above; + * this is *not* terminated by the first + * null character. Dynamically allocated. */ int allocedByX; /* Non-zero means must free property with * XFree; zero means use ckfree. */ } NameRegistry; - /* - * When a result is being awaited from a sent command, one of - * the following structures is present on a list of all outstanding - * sent commands. The information in the structure is used to - * process the result when it arrives. You're probably wondering - * how there could ever be multiple outstanding sent commands. - * This could happen if interpreters invoke each other recursively. - * It's unlikely, but possible. - */ +static initialized = false; /* A flag to denote if we have initialized yet. */ -typedef struct PendingCommand { - int serial; /* Serial number expected in - * result. */ - TkDisplay *dispPtr; /* Display being used for communication. */ - char *target; /* Name of interpreter command is - * being sent to. */ - Window commWindow; /* Target's communication window. */ - Tk_TimerToken timeout; /* Token for timer handler used to check - * up on target during long sends. */ - Tcl_Interp *interp; /* Interpreter from which the send - * was invoked. */ - int code; /* Tcl return code for command - * will be stored here. */ - char *result; /* String result for command (malloc'ed), - * or NULL. */ - char *errorInfo; /* Information for "errorInfo" variable, - * or NULL (malloc'ed). */ - char *errorCode; /* Information for "errorCode" variable, - * or NULL (malloc'ed). */ - int gotResponse; /* 1 means a response has been received, - * 0 means the command is still outstanding. */ - struct PendingCommand *nextPtr; - /* Next in list of all outstanding - * commands. NULL means end of - * list. */ -} PendingCommand; - -static PendingCommand *pendingCommands = NULL; -/* List of all commands currently - * being waited for. */ +static RegisteredInterp *interpListPtr = NULL; +/* List of all interpreters + * registered by this process. */ /* * The information below is used for communication between processes @@ -206,9 +189,6 @@ int tkSendSerial = 0; static int AppendErrorProc _ANSI_ARGS_((ClientData clientData, XErrorEvent *errorPtr)); -static void AppendPropCarefully _ANSI_ARGS_((Display *display, - Window window, Atom property, char *value, - int length, PendingCommand *pendingPtr)); static void DeleteProc _ANSI_ARGS_((ClientData clientData)); static void RegAddName _ANSI_ARGS_((NameRegistry *regPtr, char *name, Window commWindow)); @@ -221,8 +201,7 @@ static NameRegistry * RegOpen _ANSI_ARGS_((Tcl_Interp *interp, TkWindow *winPtr, int lock)); static void SendEventProc _ANSI_ARGS_((ClientData clientData, XEvent *eventPtr)); -static int SendInit _ANSI_ARGS_((Tcl_Interp *interp, - TkWindow *winPtr)); +static int SendInit _ANSI_ARGS_((Tcl_Interp *interp)); static Bool SendRestrictProc _ANSI_ARGS_((Display *display, XEvent *eventPtr, char *arg)); static int ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr)); @@ -265,13 +244,103 @@ Tk_SetAppName( * "send" commands. Must be globally * unique. */ { - return name; + TkWindow *winPtr = (TkWindow *) tkwin; + Tcl_Interp *interp = winPtr->mainPtr->interp; + int i, suffix, offset, result; + int createCommand = 0; + RegisteredInterp *riPtr, *prevPtr; + char *actualName; + Tcl_DString dString; + Tcl_Obj *resultObjPtr, *interpNamePtr; + char *interpName; + + if (!initialized) { + SendInit(interp); + } + + /* + * See if the application is already registered; if so, remove its + * current name from the registry. The deletion of the command + * will take care of disposing of this entry. + */ + + for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL; + prevPtr = riPtr, riPtr = riPtr->nextPtr) { + if (riPtr->interp == interp) { + if (prevPtr == NULL) { + interpListPtr = interpListPtr->nextPtr; + } else { + prevPtr->nextPtr = riPtr->nextPtr; + } + break; + } + } + + /* + * Pick a name to use for the application. Use "name" if it's not + * already in use. Otherwise add a suffix such as " #2", trying + * larger and larger numbers until we eventually find one that is + * unique. + */ + + actualName = name; + suffix = 1; + offset = 0; + Tcl_DStringInit(&dString); + + TkGetInterpNames(interp, tkwin); + resultObjPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(resultObjPtr); + for (i = 0; ; ) { + result = Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr); + if (interpNamePtr == NULL) { + break; + } + interpName = Tcl_GetStringFromObj(interpNamePtr, NULL); + if (strcmp(actualName, interpName) == 0) { + if (suffix == 1) { + Tcl_DStringAppend(&dString, name, -1); + Tcl_DStringAppend(&dString, " #", 2); + offset = Tcl_DStringLength(&dString); + Tcl_DStringSetLength(&dString, offset + 10); + actualName = Tcl_DStringValue(&dString); + } + suffix++; + sprintf(actualName + offset, "%d", suffix); + i = 0; + } else { + i++; + } + } + + Tcl_DecrRefCount(resultObjPtr); + Tcl_ResetResult(interp); + + /* + * We have found a unique name. Now add it to the registry. + */ + + riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); + riPtr->interp = interp; + riPtr->name = ckalloc(strlen(actualName) + 1); + riPtr->nextPtr = interpListPtr; + interpListPtr = riPtr; + strcpy(riPtr->name, actualName); + + Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, + (ClientData) riPtr, NULL /* TODO: DeleteProc */); + if (Tcl_IsSafe(interp)) { + Tcl_HideCommand(interp, "send", "send"); + } + Tcl_DStringFree(&dString); + + return riPtr->name; } /* *-------------------------------------------------------------- * - * Tk_SendCmd -- + * Tk_SendObjCmd -- * * This procedure is invoked to process the "send" Tcl command. * See the user documentation for details on what it does. @@ -286,15 +355,127 @@ Tk_SetAppName( */ int -Tk_SendCmd( - ClientData clientData, /* Information about sender (only - * dispPtr field is used). */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - char **argv) /* Argument strings. */ +Tk_SendObjCmd( + ClientData clientData, /* Used only for deletion */ + Tcl_Interp *interp, /* The interp we are sending from */ + int objc, /* Number of arguments */ + Tcl_Obj *CONST objv[]) /* The arguments */ { - Tcl_SetResult(interp, "Send not yet implemented", TCL_STATIC); - return TCL_ERROR; + static char *sendOptions[] = {"-async", "-displayof", "-", (char *) NULL}; + char *stringRep, *destName; + int async = 0; + int i, index, firstArg; + RegisteredInterp *riPtr; + Tcl_Obj *resultPtr, *listObjPtr; + int result; + + for (i = 1; i < (objc - 1); ) { + stringRep = Tcl_GetStringFromObj(objv[i], NULL); + if (stringRep[0] == '-') { + if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + if (index == 0) { + async = 1; + i++; + } else if (index == 1) { + i += 2; + } else { + i++; + } + } else { + break; + } + } + + if (objc < (i + 2)) { + Tcl_WrongNumArgs(interp, 1, objv, + "?options? interpName arg ?arg ...?"); + return TCL_ERROR; + } + + destName = Tcl_GetStringFromObj(objv[i], NULL); + firstArg = i + 1; + + resultPtr = Tcl_GetObjResult(interp); + + /* + * See if the target interpreter is local. If so, execute + * the command directly without going through the DDE server. + * The only tricky thing is passing the result from the target + * interpreter to the invoking interpreter. Watch out: they + * could be the same! + */ + + for (riPtr = interpListPtr; (riPtr != NULL) + && (strcmp(destName, riPtr->name)); riPtr = riPtr->nextPtr) { + /* + * Empty loop body. + */ + + } + + if (riPtr != NULL) { + /* + * This command is to a local interp. No need to go through + * the server. + */ + + Tcl_Interp *localInterp; + + Tcl_Preserve((ClientData) riPtr); + localInterp = riPtr->interp; + Tcl_Preserve((ClientData) localInterp); + if (firstArg == (objc - 1)) { + /* + * This might be one of those cases where the new + * parser is faster. + */ + + result = Tcl_EvalObj(localInterp, objv[firstArg], TCL_EVAL_DIRECT); + } else { + listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + for (i = firstArg; i < objc; i++) { + Tcl_ListObjAppendList(interp, listObjPtr, objv[i]); + } + Tcl_IncrRefCount(listObjPtr); + result = Tcl_EvalObj(localInterp, listObjPtr, TCL_EVAL_DIRECT); + Tcl_DecrRefCount(listObjPtr); + } + if (interp != localInterp) { + if (result == TCL_ERROR) { + /* Tcl_Obj *errorObjPtr; */ + + /* + * An error occurred, so transfer error information from the + * destination interpreter back to our interpreter. Must clear + * interp's result before calling Tcl_AddErrorInfo, since + * Tcl_AddErrorInfo will store the interp's result in errorInfo + * before appending riPtr's $errorInfo; we've already got + * everything we need in riPtr's $errorInfo. + */ + + Tcl_ResetResult(interp); + Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp, + "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY)); + /* errorObjPtr = Tcl_GetObjVar2(localInterp, "errorCode", NULL, + TCL_GLOBAL_ONLY); + Tcl_SetObjErrorCode(interp, errorObjPtr); */ + } + Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp)); + } + Tcl_Release((ClientData) riPtr); + Tcl_Release((ClientData) localInterp); + } else { + /* + * This is a non-local request. Send the script to the server and poll + * it for a result. TODO!!! + */ + } + +done: + return result; } /* @@ -324,8 +505,19 @@ TkGetInterpNames( Tk_Window tkwin) /* Window whose display is to be used * for the lookup. */ { - Tcl_SetResult(interp, "Send not yet implemented", TCL_STATIC); - return TCL_ERROR; + Tcl_Obj *listObjPtr; + RegisteredInterp *riPtr; + + listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + riPtr = interpListPtr; + while (riPtr != NULL) { + Tcl_ListObjAppendElement(interp, listObjPtr, + Tcl_NewStringObj(riPtr->name, -1)); + riPtr = riPtr->nextPtr; + } + + Tcl_SetObjResult(interp, listObjPtr); + return TCL_OK; } /* @@ -348,11 +540,9 @@ TkGetInterpNames( static int SendInit( - Tcl_Interp *interp, /* Interpreter to use for error reporting + Tcl_Interp *interp) /* Interpreter to use for error reporting * (no errors are ever returned, but the * interpreter is needed anyway). */ - TkWindow *winPtr) /* Window that identifies the display to - * initialize. */ { return TCL_OK; } diff --git a/mac/tkMacShLib.exp b/mac/tkMacShLib.exp index 9fcc9ba..e6b4aa5 100644 --- a/mac/tkMacShLib.exp +++ b/mac/tkMacShLib.exp @@ -84,7 +84,6 @@ TkGetMenuHashTable TkGetMenuIndex TkGetMiterPoints TkGetPointerCoords -TkGetProlog TkGetServerInfo TkGetTransientMaster TkGrabDeadWindow diff --git a/mac/tkMacSubwindows.c b/mac/tkMacSubwindows.c index b37e9f8..09bf09b 100644 --- a/mac/tkMacSubwindows.c +++ b/mac/tkMacSubwindows.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacSubwindows.c,v 1.4 1998/09/14 18:23:39 stanton Exp $ + * RCS: @(#) $Id: tkMacSubwindows.c,v 1.5 1999/04/16 01:51:32 stanton Exp $ */ #include "tkInt.h" @@ -930,7 +930,8 @@ TkMacGetDrawablePort( contWinPtr = TkpGetOtherWindow(macWin->toplevel->winPtr); if (contWinPtr != NULL) { - resultPort = TkMacGetDrawablePort((Drawable) contWinPtr->privatePtr); + resultPort = TkMacGetDrawablePort( + (Drawable) contWinPtr->privatePtr); } else if (gMacEmbedHandler != NULL) { resultPort = gMacEmbedHandler->getPortProc( (Tk_Window) macWin->winPtr); diff --git a/mac/tkMacTest.c b/mac/tkMacTest.c index 6be2ebe..8f6db08 100644 --- a/mac/tkMacTest.c +++ b/mac/tkMacTest.c @@ -9,10 +9,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacTest.c,v 1.2 1998/09/14 18:23:39 stanton Exp $ + * RCS: @(#) $Id: tkMacTest.c,v 1.3 1999/04/16 01:51:32 stanton Exp $ */ #include <Types.h> +#include <tcl.h> /* * Forward declarations of procedures defined later in this file: diff --git a/mac/tkMacWindowMgr.c b/mac/tkMacWindowMgr.c index c073ca3..48ada11 100644 --- a/mac/tkMacWindowMgr.c +++ b/mac/tkMacWindowMgr.c @@ -3,12 +3,12 @@ * * Implements common window manager functions for the Macintosh. * - * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1995-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. * - * RCS: @(#) $Id: tkMacWindowMgr.c,v 1.3 1998/09/14 18:23:40 stanton Exp $ + * RCS: @(#) $Id: tkMacWindowMgr.c,v 1.4 1999/04/16 01:51:32 stanton Exp $ */ #include <Events.h> @@ -63,7 +63,7 @@ static int GenerateActivateEvents _ANSI_ARGS_((EventRecord *eventPtr, static int GenerateFocusEvent _ANSI_ARGS_((EventRecord *eventPtr, Window window)); static int GenerateKeyEvent _ANSI_ARGS_((EventRecord *eventPtr, - Window window)); + Window window, UInt32 savedCode)); static int GenerateUpdateEvent _ANSI_ARGS_((EventRecord *eventPtr, Window window)); static void GenerateUpdates _ANSI_ARGS_((RgnHandle updateRgn, @@ -104,6 +104,7 @@ WindowManagerMouse( Point where, where2; int xOffset, yOffset; short windowPart; + TkDisplay *dispPtr; frontWindow = FrontWindow(); @@ -122,7 +123,8 @@ WindowManagerMouse( } windowPart = FindWindow(eventPtr->where, &whichWindow); - tkwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + tkwin = Tk_IdToWindow(dispPtr->display, window); switch (windowPart) { case inSysWindow: SystemClick(eventPtr, (GrafPort *) whichWindow); @@ -293,8 +295,10 @@ GenerateUpdateEvent( { WindowRef macWindow; register TkWindow *winPtr; + TkDisplay *dispPtr; - winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window); if (winPtr == NULL) { return false; @@ -464,6 +468,7 @@ TkGenerateButtonEvent( Point where; Tk_Window tkwin; int dummy; + TkDisplay *dispPtr; /* * ButtonDown events will always occur in the front @@ -480,7 +485,8 @@ TkGenerateButtonEvent( return false; } - tkwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + tkwin = Tk_IdToWindow(dispPtr->display, window); GlobalToLocal(&where); if (tkwin != NULL) { @@ -517,8 +523,10 @@ GenerateActivateEvents( Window window) /* Root X window for event. */ { TkWindow *winPtr; + TkDisplay *dispPtr; - winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window); if (winPtr == NULL || winPtr->window == None) { return false; } @@ -629,8 +637,10 @@ GenerateFocusEvent( { XEvent event; Tk_Window tkwin; + TkDisplay *dispPtr; - tkwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + tkwin = Tk_IdToWindow(dispPtr->display, window); if (tkwin == NULL) { return false; } @@ -646,9 +656,9 @@ GenerateFocusEvent( event.xany.type = FocusOut; } - event.xany.serial = tkDisplayList->display->request; + event.xany.serial = dispPtr->display->request; event.xany.send_event = False; - event.xfocus.display = tkDisplayList->display; + event.xfocus.display = dispPtr->display; event.xfocus.window = window; event.xfocus.mode = NotifyNormal; event.xfocus.detail = NotifyDetailNone; @@ -679,23 +689,42 @@ GenerateFocusEvent( static int GenerateKeyEvent( EventRecord *eventPtr, /* Incoming Mac event */ - Window window) /* Root X window for event. */ + Window window, /* Root X window for event. */ + UInt32 savedKeyCode) /* If non-zero, this is a lead byte which + * should be combined with the character + * in this event to form one multi-byte + * character. */ { Point where; Tk_Window tkwin; XEvent event; - + unsigned char byte; + char buf[16]; + TkDisplay *dispPtr; + /* * The focus must be in the FrontWindow on the Macintosh. * We then query Tk to determine the exact Tk window * that owns the focus. */ - tkwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + tkwin = Tk_IdToWindow(dispPtr->display, window); tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr; if (tkwin == NULL) { return false; } + byte = (unsigned char) (eventPtr->message & charCodeMask); + if ((savedKeyCode == 0) && + (Tcl_ExternalToUtf(NULL, NULL, (char *) &byte, 1, 0, NULL, + buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK)) { + /* + * This event specifies a lead byte. Wait for the second byte + * to come in before sending the XEvent. + */ + + return false; + } where.v = eventPtr->where.v; where.h = eventPtr->where.h; @@ -710,7 +739,10 @@ GenerateKeyEvent( GlobalToLocal(&where); Tk_TopCoordsToWindow(tkwin, where.h, where.v, &event.xkey.x, &event.xkey.y); - event.xkey.keycode = eventPtr->message; + + event.xkey.keycode = byte | + ((savedKeyCode & charCodeMask) << 8) | + ((eventPtr->message & keyCodeMask) << 8); event.xany.serial = Tk_Display(tkwin)->request; event.xkey.window = Tk_WindowId(tkwin); @@ -770,7 +802,8 @@ GeneratePollingEvents() short part; int local_x, local_y; int generatedEvents = false; - + TkDisplay *dispPtr; + /* * First we get the current mouse position and determine * what Tk window the mouse is over (if any). @@ -792,7 +825,8 @@ GeneratePollingEvents() tkwin = NULL; } else { window = TkMacGetXWindow(whichwindow); - rootwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + rootwin = Tk_IdToWindow(dispPtr->display, window); if (rootwin == NULL) { tkwin = NULL; } else { @@ -859,6 +893,7 @@ GeneratePollingEvents2( int local_x, local_y; int generatedEvents = false; Rect bounds; + TkDisplay *dispPtr; /* * First we get the current mouse position and determine @@ -881,7 +916,8 @@ GeneratePollingEvents2( if (whichwindow != frontWin) { tkwin = NULL; } else { - rootwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + rootwin = Tk_IdToWindow(dispPtr->display, window); TkMacWinBounds((TkWindow *) rootwin, &bounds); if (!PtInRect(whereLocal, &bounds)) { tkwin = NULL; @@ -1110,6 +1146,7 @@ TkMacConvertEvent( WindowRef whichWindow; Window window; int eventFound = false; + static UInt32 savedKeyCode; switch (eventPtr->what) { case nullEvent: @@ -1153,11 +1190,28 @@ TkMacConvertEvent( break; } } + /* fall through */ + case keyUp: whichWindow = FrontWindow(); + if (whichWindow == NULL) { + /* + * This happens if we get a key event before Tk has had a + * chance to actually create and realize ".", if they type + * when "." is withdrawn(!), or between the time "." is + * destroyed and the app exits. + */ + + return false; + } window = TkMacGetXWindow(whichWindow); - eventFound |= GenerateKeyEvent(eventPtr, window); + if (GenerateKeyEvent(eventPtr, window, savedKeyCode) == 0) { + savedKeyCode = eventPtr->message; + return false; + } + eventFound = true; break; + case activateEvt: window = TkMacGetXWindow((WindowRef) eventPtr->message); eventFound |= GenerateActivateEvents(eventPtr, window); @@ -1210,6 +1264,7 @@ TkMacConvertEvent( break; } + savedKeyCode = 0; return eventFound; } @@ -1237,6 +1292,7 @@ TkMacConvertTkEvent( { int eventFound = false; Point where; + static UInt32 savedKeyCode; /* * By default, assume it is legal for us to set the cursor @@ -1292,9 +1348,16 @@ TkMacConvertTkEvent( break; } } + /* fall through. */ + case keyUp: - eventFound |= GenerateKeyEvent(eventPtr, window); + if (GenerateKeyEvent(eventPtr, window, savedKeyCode) == 0) { + savedKeyCode = eventPtr->message; + return false; + } + eventFound = true; break; + case activateEvt: /* * It is probably not legal for us to set the cursor @@ -1358,7 +1421,7 @@ TkMacConvertTkEvent( } break; } - + savedKeyCode = 0; return eventFound; } diff --git a/mac/tkMacWm.c b/mac/tkMacWm.c index ba32f5e..f965f5c 100644 --- a/mac/tkMacWm.c +++ b/mac/tkMacWm.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacWm.c,v 1.5 1998/11/11 17:31:51 jingham Exp $ + * RCS: @(#) $Id: tkMacWm.c,v 1.6 1999/04/16 01:51:32 stanton Exp $ */ #include <Gestalt.h> @@ -709,7 +709,7 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 2) { - interp->result = (wmTracing) ? "on" : "off"; + Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC); return TCL_OK; } return Tcl_GetBoolean(interp, argv[2], &wmTracing); @@ -739,9 +739,12 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x, + char buf[TCL_INTEGER_SPACE * 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); } return TCL_OK; } @@ -756,7 +759,8 @@ Tk_WmCmd( } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - interp->result = "aspect number can't be <= 0"; + Tcl_SetResult(interp, "aspect number can't be <= 0", + TCL_STATIC); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -777,7 +781,7 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->clientMachine != NULL) { - interp->result = wmPtr->clientMachine; + Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); } return TCL_OK; } @@ -875,8 +879,9 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->cmdArgv != NULL) { - interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - interp->freeProc = (Tcl_FreeProc *) free; + Tcl_SetResult(interp, + Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), + TCL_DYNAMIC); } return TCL_OK; } @@ -926,7 +931,8 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 3) { - interp->result = wmPtr->hints.input ? "passive" : "active"; + Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), + TCL_STATIC); return TCL_OK; } c = argv[3][0]; @@ -943,6 +949,7 @@ Tk_WmCmd( } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0) && (length >= 2)) { Window window; + char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: must be \"", @@ -953,7 +960,8 @@ Tk_WmCmd( if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } - sprintf(interp->result, "0x%x", (unsigned int) window); + sprintf(buf, "0x%x", (unsigned int) window); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0) && (length >= 2)) { char xSign, ySign; @@ -966,6 +974,8 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 3) { + char buf[16 + TCL_INTEGER_SPACE * 4]; + xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -977,8 +987,9 @@ Tk_WmCmd( width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(interp->result, "%dx%d%c%d%c%d", width, height, - xSign, wmPtr->x, ySign, wmPtr->y); + sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, + ySign, wmPtr->y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if (*argv[3] == '\0') { @@ -999,9 +1010,12 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth, + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, wmPtr->reqGridHeight, wmPtr->widthInc, wmPtr->heightInc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } @@ -1028,19 +1042,19 @@ Tk_WmCmd( return TCL_ERROR; } if (reqWidth < 0) { - interp->result = "baseWidth can't be < 0"; + Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); return TCL_ERROR; } if (reqHeight < 0) { - interp->result = "baseHeight can't be < 0"; + Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); return TCL_ERROR; } if (widthInc < 0) { - interp->result = "widthInc can't be < 0"; + Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC); return TCL_ERROR; } if (heightInc < 0) { - interp->result = "heightInc can't be < 0"; + Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, @@ -1060,7 +1074,7 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - interp->result = wmPtr->leaderName; + Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); } return TCL_OK; } @@ -1093,8 +1107,9 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - interp->result = Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap); + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), + TCL_STATIC); } return TCL_OK; } @@ -1153,8 +1168,9 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - interp->result = Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_mask); + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), + TCL_STATIC); } return TCL_OK; } @@ -1179,7 +1195,9 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 3) { - interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : ""; + Tcl_SetResult(interp, + ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), + TCL_STATIC); return TCL_OK; } else { wmPtr->iconName = Tk_GetUid(argv[3]); @@ -1199,8 +1217,11 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - sprintf(interp->result, "%d %d", wmPtr->hints.icon_x, + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", wmPtr->hints.icon_x, wmPtr->hints.icon_y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } @@ -1228,7 +1249,7 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->icon != NULL) { - interp->result = Tk_PathName(wmPtr->icon); + Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); } return TCL_OK; } @@ -1282,8 +1303,10 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 3) { - sprintf(interp->result, "%d %d", wmPtr->maxWidth, - wmPtr->maxHeight); + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", wmPtr->maxWidth, wmPtr->maxHeight); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) @@ -1303,8 +1326,10 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 3) { - sprintf(interp->result, "%d %d", wmPtr->minWidth, - wmPtr->minHeight); + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) @@ -1328,9 +1353,9 @@ Tk_WmCmd( } if (argc == 3) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - interp->result = "1"; + Tcl_SetResult(interp, "1", TCL_STATIC); } else { - interp->result = "0"; + Tcl_SetResult(interp, "0", TCL_STATIC); } return TCL_OK; } @@ -1351,9 +1376,9 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->sizeHintsFlags & USPosition) { - interp->result = "user"; + Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PPosition) { - interp->result = "program"; + Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } @@ -1408,7 +1433,7 @@ Tk_WmCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - interp->result = protPtr->command; + Tcl_SetResult(interp, protPtr->command, TCL_STATIC); return TCL_OK; } } @@ -1452,9 +1477,12 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 3) { - sprintf(interp->result, "%d %d", + char buf[TCL_INTEGER_SPACE * 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); return TCL_OK; } if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK) @@ -1487,9 +1515,9 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->sizeHintsFlags & USSize) { - interp->result = "user"; + Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PSize) { - interp->result = "program"; + Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } @@ -1521,20 +1549,20 @@ Tk_WmCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - interp->result = "icon"; + Tcl_SetResult(interp, "icon", TCL_STATIC); } else { switch (wmPtr->hints.initial_state) { case NormalState: - interp->result = "normal"; + Tcl_SetResult(interp, "normal", TCL_STATIC); break; case IconicState: - interp->result = "iconic"; + Tcl_SetResult(interp, "iconic", TCL_STATIC); break; case WithdrawnState: - interp->result = "withdrawn"; + Tcl_SetResult(interp, "withdrawn", TCL_STATIC); break; case ZoomState: - interp->result = "zoomed"; + Tcl_SetResult(interp, "zoomed", TCL_STATIC); break; } } @@ -1546,8 +1574,9 @@ Tk_WmCmd( return TCL_ERROR; } if (argc == 3) { - interp->result = (wmPtr->titleUid != NULL) ? wmPtr->titleUid - : winPtr->nameUid; + Tcl_SetResult(interp, + ((wmPtr->titleUid != NULL) ? wmPtr->titleUid : winPtr->nameUid), + TCL_STATIC); return TCL_OK; } else { wmPtr->titleUid = Tk_GetUid(argv[3]); @@ -1566,7 +1595,7 @@ Tk_WmCmd( } if (argc == 3) { if (wmPtr->master != None) { - interp->result = wmPtr->masterWindowName; + Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC); } return TCL_OK; } @@ -2146,7 +2175,7 @@ UpdateSizeHints( * * Results: * A standard Tcl return value, plus an error message in - * interp->result if an error occurs. + * the interp's result if an error occurs. * * Side effects: * The size and/or location of winPtr may change. @@ -2399,6 +2428,7 @@ Tk_CoordsToWindow( * far that contains point. */ int x, y; /* Coordinates in winPtr. */ int tmpx, tmpy, bd; + TkDisplay *dispPtr; /* * Step 1: find the top-level window that contains the desired point. @@ -2411,7 +2441,8 @@ Tk_CoordsToWindow( return NULL; } rootChild = TkMacGetXWindow(whichWin); - winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, rootChild); + dispPtr = TkGetDisplayList(); + winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, rootChild); if (winPtr == NULL) { return NULL; } @@ -3255,6 +3286,7 @@ TkMacGrowToplevel( Point start) { Point where = start; + TkDisplay *dispPtr; GlobalToLocal(&where); if (where.h > (whichWindow->portRect.right - 16) && @@ -3267,7 +3299,8 @@ TkMacGrowToplevel( long growResult; window = TkMacGetXWindow(whichWindow); - winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window); wmPtr = winPtr->wmInfoPtr; /* TODO: handle grid size options. */ @@ -3330,15 +3363,19 @@ TkSetWMName( { Str255 pTitle; GWorldPtr macWin; + int destWrote; if (Tk_IsEmbedded(winPtr)) { return; } + Tcl_UtfToExternal(NULL, NULL, titleUid, + strlen(titleUid), 0, NULL, + (char *) &pTitle[1], + 255, NULL, &destWrote, NULL); /* Internalize native */ + pTitle[0] = destWrote; - macWin = TkMacGetDrawablePort(winPtr->window); - - strcpy((char *) pTitle + 1, titleUid); - pTitle[0] = strlen(titleUid); + macWin = TkMacGetDrawablePort(winPtr->window); + SetWTitle((WindowPtr) macWin, pTitle); } @@ -3595,7 +3632,8 @@ TkMacZoomToplevel( * has changed. */ window = TkMacGetXWindow(whichWindow); - tkwin = Tk_IdToWindow(tkDisplayList->display, window); + dispPtr = TkGetDisplayList(); + tkwin = Tk_IdToWindow(dispPtr->display, window); if (tkwin == NULL) { return false; } @@ -3697,42 +3735,42 @@ TkUnsupported1Cmd( switch (wmPtr->style) { case noGrowDocProc: case documentProc: - interp->result = "documentProc"; + Tcl_SetResult(interp, "documentProc", TCL_STATIC); break; case dBoxProc: - interp->result = "dBoxProc"; + Tcl_SetResult(interp, "dBoxProc", TCL_STATIC); break; case plainDBox: - interp->result = "plainDBox"; + Tcl_SetResult(interp, "plainDBox", TCL_STATIC); break; case altDBoxProc: - interp->result = "altDBoxProc"; + Tcl_SetResult(interp, "altDBoxProc", TCL_STATIC); break; case movableDBoxProc: - interp->result = "movableDBoxProc"; + Tcl_SetResult(interp, "movableDBoxProc", TCL_STATIC); break; case zoomDocProc: case zoomNoGrow: - interp->result = "zoomDocProc"; + Tcl_SetResult(interp, "zoomDocProc", TCL_STATIC); break; case rDocProc: - interp->result = "rDocProc"; + Tcl_SetResult(interp, "rDocProc", TCL_STATIC); break; case floatProc: case floatGrowProc: - interp->result = "floatProc"; + Tcl_SetResult(interp, "floatProc", TCL_STATIC); break; case floatZoomProc: case floatZoomGrowProc: - interp->result = "floatZoomProc"; + Tcl_SetResult(interp, "floatZoomProc", TCL_STATIC); break; case floatSideProc: case floatSideGrowProc: - interp->result = "floatSideProc"; + Tcl_SetResult(interp, "floatSideProc", TCL_STATIC); break; case floatSideZoomProc: case floatSideZoomGrowProc: - interp->result = "floatSideZoomProc"; + Tcl_SetResult(interp, "floatSideZoomProc", TCL_STATIC); break; default: panic("invalid style"); diff --git a/mac/tkMacXStubs.c b/mac/tkMacXStubs.c index 04b83a4..f554ed8 100644 --- a/mac/tkMacXStubs.c +++ b/mac/tkMacXStubs.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacXStubs.c,v 1.5 1999/04/16 01:25:55 stanton Exp $ + * RCS: @(#) $Id: tkMacXStubs.c,v 1.6 1999/04/16 01:51:33 stanton Exp $ */ #include "tkInt.h" @@ -22,7 +22,6 @@ #include <Xatom.h> -#include <Gestalt.h> #include <Windows.h> #include <Fonts.h> #include <QDOffscreen.h> @@ -275,15 +274,6 @@ DefaultErrorHandler( } - -void -Tk_FreeXId ( - Display *display, - XID xid) -{ - /* no-op function needed for stubs implementation */ -} - char * XGetAtomName( Display * display, @@ -525,6 +515,47 @@ XForceScreenSaver( */ display->request++; } + +void +Tk_FreeXId ( + Display *display, + XID xid) +{ + /* no-op function needed for stubs implementation. */ +} + +void +Tk_3DHorizontalBevel ( + Tk_Window tkwin, + Drawable d, + Tk_3DBorder b, + int x, + int y, + int width, + int height, + int leftIn, + int rightIn, + int topBevel, + int relief) +{ + /* no-op function needed for stubs implementation. */ +} + +void +Tk_3DVerticalBevel ( + Tk_Window tkwin, + Drawable d, + Tk_3DBorder b, + int x, + int y, + int width, + int height, + int leftBevel, + int relief) +{ + /* no-op function needed for stubs implementation. */ +} + /* *---------------------------------------------------------------------- @@ -551,17 +582,14 @@ TkGetServerInfo( Tk_Window tkwin) /* Token for window; this selects a * particular display and server. */ { - char buffer[50]; - long result; - short low, major, minor, micro; - - Gestalt(gestaltSystemVersion, &result); - low = LoWord(result); - major = (low & 0x0F00) >> 8; - minor = (low & 0x00F0) >> 4; - micro = (low & 0x000F); - sprintf(buffer, "MacOS %d.%d.%d", major, minor, micro); - Tcl_AppendResult(interp, buffer, (char *) NULL); + 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); } /* * Image stuff @@ -721,24 +749,3 @@ TkGetDefaultScreenName( } return screenName; } - -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 ) -{ - /* no-op required for stubs implementation */ - /* this function will probably be filled in at some point */ -} - -void Tk_3DVerticalBevel ( - Tk_Window tkwin, - Drawable drawable, Tk_3DBorder border, int x, - int y, int width, int height, int leftBevel, - int relief ) -{ - /* no-op required for stubs implementation */ - /* this function will probably be filled in at some point */ -} - diff --git a/tests/README b/tests/README index 23fc4a5..facea75 100644 --- a/tests/README +++ b/tests/README @@ -1,30 +1,7 @@ -Tk Test Suite --------------- +README -- Tk test suite design document. -RCS: @(#) $Id: README,v 1.2 1998/09/14 18:23:41 stanton Exp $ +RCS: @(#) $Id: README,v 1.3 1999/04/16 01:51:33 stanton Exp $ -This directory contains a set of validation tests for Tk. -Each of the files whose name ends in ".test" is intended to -fully exercise one or a few Tk features. The features -tested by a given file are listed in the first line of the -file. The test suite is nowhere near complete yet. Contributions -of additional tests would be most welcome. - -You can run the tests in two ways: - (a) type "make test" in the directory ../unix; this will run all of - the tests. - (b) start up tktest in this directory, then "source" the test - file (for example, type "source pack.test"). To run all - of the tests, type "source all". -In either case no output will be generated if all goes well, except -for a listing of the tests. If there are errors then additional -messages will appear. - -For more details on the testing environment, see the README -file in the Tcl test directory. - -You can also run a set of visual tests, which create various screens -that you can verify visually for appropriate behavior. The visual -tests are available through the "visual" script: if you invoke this -script, it creates a main window with a bunch of menus. Each menu -runs a particular test. +This directory contains a set of validation tests for the Tk commands. +Please see the tests/README file in the Tcl source distribution for +information about the test suite. diff --git a/tests/all b/tests/all deleted file mode 100644 index 9a473ef..0000000 --- a/tests/all +++ /dev/null @@ -1,84 +0,0 @@ -# This file contains a top-level script to run all of the Tcl -# tests. Execute it by invoking "source all" when running tclTest -# in this directory. -# -# RCS: @(#) $Id: all,v 1.6 1999/04/16 01:25:55 stanton Exp $ - -set TESTS_DIR [file join [pwd] [file dirname [info script]]] -source [file join $TESTS_DIR defs] -set currentDir [pwd] - -catch {array set flag $argv} -set requiredSourceFiles [list arc.tcl bugs.tcl butGeom2.tcl \ - canvPsBmap.tcl canvPsText.tcl bevel.tcl butGeom.tcl \ - canvPsArc.tcl canvPsGrph.tcl cmap.tcl filebox.test \ - option.file1 option.file2 visual README defs] - -# -# Set the TMP_DIR to pwd or the arg of -tmpdir, if given. -# - -if {[info exists flag(-tmpdir)]} { - set TMP_DIR $flag(-tmpdir) - if {![file exists $TMP_DIR]} { - if {[catch {file mkdir $TMP_DIR} msg]} { - error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$msg" - } - file mkdir $TMP_DIR - } elseif {![file isdir $TMP_DIR]} { - error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$TMP_DIR is not a directory" - } - if {[string compare [file pathtype $TMP_DIR] absolute] != 0} { - set TMP_DIR [file join [pwd] $TMP_DIR] - } - cd $TMP_DIR -} - -# -# copy each required source file to the current dir (if it's not already there). -# - -if {[string compare $TESTS_DIR [pwd]] != 0} { - - foreach file $requiredSourceFiles { - if {![file exists $file]} { - catch {file copy [file join $TESTS_DIR $file] .} - } - } -} - -if {$tcl_platform(os) == "Win32s"} { - set globPattern [file join $TESTS_DIR *.tes] -} else { - set globPattern [file join $TESTS_DIR *.test] -} - -foreach file [lsort [glob $globPattern]] { - set tail [file tail $file] - if {[string match l.*.test $tail]} { - # This is an SCCS lockfile; ignore it - continue - } - puts stdout $tail - if {[catch {source $file} msg]} { - puts stdout $msg - } -} - -# remove the required source files from the current dir. -if {[info exists TMP_DIR]} { - foreach file $requiredSourceFiles { - catch {file delete -force $file} - } - cd $currentDir -} - -# exit if Tk is running in non-interactive mode. -# Don't exit at the end of all the tests on the Mac, since -# this destroys the window that contains the test results... - -if {([info exists tk_version] && !$tcl_interactive) \ - || [string compare $tcl_platform(platform) macintosh]} { - catch {destroy .} - exit -} diff --git a/tests/all.tcl b/tests/all.tcl new file mode 100644 index 0000000..fc2b89d --- /dev/null +++ b/tests/all.tcl @@ -0,0 +1,78 @@ +# all.tcl -- +# +# This file contains a top-level script to run all of the Tk +# tests. Execute it by invoking "source all.tcl" when running tktest +# in this directory. +# +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: all.tcl,v 1.2 1999/04/16 01:51:33 stanton Exp $ + +if {[lsearch ::tcltest [namespace children]] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} +set ::tcltest::testSingleFile false + +puts stdout "Tk $tk_patchLevel tests running in interp: [info nameofexecutable]" +puts stdout "Tests running in working dir: $::tcltest::workingDir" +if {[llength $::tcltest::skip] > 0} { + puts stdout "Skipping tests that match: $::tcltest::skip" +} +if {[llength $::tcltest::match] > 0} { + puts stdout "Only running tests that match: $::tcltest::match" +} + +# Use command line specified glob pattern (specified by -file or -f) +# if one exists. Otherwise use *.test. If given, the file pattern +# should be specified relative to the dir containing this file. If no +# files are found to match the pattern, print an error message and exit. +set fileIndex [expr {[lsearch $argv "-file"] + 1}] +set fIndex [expr {[lsearch $argv "-f"] + 1}] +if {($fileIndex < 1) || ($fIndex > $fileIndex)} { + set fileIndex $fIndex +} +if {$fileIndex > 0} { + set globPattern [file join $::tcltest::testsDir [lindex $argv $fileIndex]] + puts stdout "Sourcing files that match: $globPattern" +} else { + set globPattern [file join $::tcltest::testsDir *.test] +} +set fileList [glob -nocomplain $globPattern] +if {[llength $fileList] < 1} { + puts "Error: no files found matching $globPattern" + exit +} +set timeCmd {clock format [clock seconds]} +puts stdout "Tests began at [eval $timeCmd]" + +# source each of the specified tests +foreach file [lsort $fileList] { + set tail [file tail $file] + if {[string match l.*.test $tail]} { + # This is an SCCS lockfile; ignore it + continue + } + puts stdout $tail + if {[catch {source $file} msg]} { + puts stdout $msg + } +} + +# cleanup +puts stdout "\nTests ended at [eval $timeCmd]" +::tcltest::cleanupTests 1 +return + + + + + + + + + + + + + diff --git a/tests/arc.tcl b/tests/arc.tcl index 33056f5..4315361 100644 --- a/tests/arc.tcl +++ b/tests/arc.tcl @@ -1,7 +1,7 @@ # This file creates a visual test for arcs. It is part of the Tk # visual test suite, which is invoked via the "visual" script. # -# RCS: @(#) $Id: arc.tcl,v 1.2 1998/09/14 18:23:42 stanton Exp $ +# RCS: @(#) $Id: arc.tcl,v 1.3 1999/04/16 01:51:33 stanton Exp $ catch {destroy .t} toplevel .t @@ -138,3 +138,16 @@ bind .t.c a { bind .t.c b {set go 0} bind .t.c <Control-x> {.t.c delete current} + + + + + + + + + + + + + diff --git a/tests/bell.test b/tests/bell.test index 0c88769..e8c2040 100644 --- a/tests/bell.test +++ b/tests/bell.test @@ -2,16 +2,13 @@ # It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998 by Scriptics Corporation. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: bell.test,v 1.3 1998/09/30 19:01:22 rjohnson Exp $ +# RCS: @(#) $Id: bell.test,v 1.4 1999/04/16 01:51:33 stanton Exp $ -if {[string compare test [info procs test]] == 1} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } test bell-1.1 {bell command} { @@ -29,9 +26,24 @@ test bell-1.4 {bell command} { after 500 bell -displayof . after 200 - bell -dis . - after 200 bell after 200 bell } {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/bevel.tcl b/tests/bevel.tcl index 815590a..ae6039a 100644 --- a/tests/bevel.tcl +++ b/tests/bevel.tcl @@ -2,7 +2,7 @@ # widgets. It is part of the Tk visual test suite, which is invoked # via the "visual" script. # -# RCS: @(#) $Id: bevel.tcl,v 1.2 1998/09/14 18:23:42 stanton Exp $ +# RCS: @(#) $Id: bevel.tcl,v 1.3 1999/04/16 01:51:33 stanton Exp $ catch {destroy .t} toplevel .t @@ -126,3 +126,16 @@ foreach i {1 2 3} { .t.t insert end rrr r1 .t.t insert end ***** .t.t insert end rrr r1 + + + + + + + + + + + + + diff --git a/tests/bgerror.test b/tests/bgerror.test index b718483..cf6489b 100644 --- a/tests/bgerror.test +++ b/tests/bgerror.test @@ -2,17 +2,15 @@ # It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: bgerror.test,v 1.2 1998/09/14 18:23:42 stanton Exp $ +# RCS: @(#) $Id: bgerror.test,v 1.3 1999/04/16 01:51:33 stanton Exp $ -if {[info commands test] == ""} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } - test bgerror-1.1 {bgerror / tkerror compat} { set errRes {} proc tkerror {err} { @@ -57,3 +55,19 @@ catch {rename tkerror {}} # would be needed too, but that's not easy at all # to emulate. +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/bind.test b/tests/bind.test index e3e5f51..a62b7a1 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -4,15 +4,13 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. -# Copyright (c) 1998 by Scriptics Corporation. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: bind.test,v 1.4 1998/10/10 00:30:37 rjohnson Exp $ +# RCS: @(#) $Id: bind.test,v 1.5 1999/04/16 01:51:34 stanton Exp $ -if {[string compare test [info procs test]] != 0} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {destroy .b} @@ -254,7 +252,7 @@ test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} { set x } {a1 bye.all2 bye.a1 b1 bye.c1} -test bind-7.1 {Tk_CreateBinding procedure: error} { +test bind-7.1 {Tk_CreateBinding procedure: bad binding} { catch {destroy .b.c} canvas .b.c list [catch {.b.c bind foo <} msg] $msg @@ -1470,8 +1468,11 @@ test bind-16.35 {ExpandPercents procedure} {nonPortable} { 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} {{}} {{}} { } {\$} \\\{" +} "a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9" test bind-16.36 {ExpandPercents procedure} { setup bind .b.f <Configure> {set x "%B"} @@ -1539,10 +1540,10 @@ test bind-16.43 {ExpandPercents procedure} { test bind-17.1 {event command} { list [catch {event} msg] $msg -} {1 {wrong # args: should be "event option ?arg1?"}} +} {1 {wrong # args: should be "event option ?arg?"}} test bind-17.2 {event command} { - list [catch {event {}} msg] $msg -} {1 {bad option "": should be add, delete, generate, info}} + 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 ...?"}} @@ -1611,8 +1612,7 @@ test bind-17.16 {event command: generate} { } {1 {bad event type or keysym "xyz"}} test bind-17.17 {event command} { list [catch {event foo} msg] $msg -} {1 {bad option "foo": should be add, delete, generate, info}} - +} {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 @@ -1971,73 +1971,73 @@ test bind-22.16 {HandleEventGenerate} { } {foo 99 100 101 102} test bind-22.17 {HandleEventGenerate} { list [catch {event gen . <Button> -when xyz} msg] $msg -} {1 {bad position "xyz": should be now, head, mark, tail}} -set i 14 +} {1 {bad -when value "xyz": must be now, head, mark, or tail}} +set i 18 foreach check { {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}} {<Configure> %a {-above .b} {[winfo id .b]}} - {<Configure> %a {-above xyz} {{1 {expected integer but got "xyz"}}}} + {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}} {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}} - {<Key> %b {-above .} {{1 {bad option to <Key> event: "-above"}}}} + {<Key> %b {-above .} {{1 {<Key> event doesn't accept "-above" option}}}} {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}} {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}} - {<Key> %k {-borderwidth 2i} {{1 {bad option to <Key> event: "-borderwidth"}}}} + {<Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}} {<Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}} {<Button> %b {-button 1} 1} - {<Key> %k {-button 1} {{1 {bad option to <Key> event: "-button"}}}} + {<Key> %k {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}} {<Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}} {<Expose> %c {-count 20} 20} - {<Key> %b {-count 20} {{1 {bad option to <Key> event: "-count"}}}} + {<Key> %b {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}} - {<Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, NotifyDetailNone}}}} + {<Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}} {<FocusIn> %d {-detail NotifyVirtual} {{}}} {<Enter> %d {-detail NotifyVirtual} NotifyVirtual} - {<Key> %k {-detail NotifyVirtual} {{1 {bad option to <Key> event: "-detail"}}}} + {<Key> %k {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}} {<Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}} {<Enter> %f {-focus 1} 1} - {<Key> %k {-focus 1} {{1 {bad option to <Key> event: "-focus"}}}} + {<Key> %k {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}} {<Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}} {<Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}} {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}} - {<Key> %k {-height 2i} {{1 {bad option to <Key> event: "-height"}}}} + {<Key> %k {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}} {<Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}} {<Key> %k {-keycode 20} 20} - {<Button> %b {-keycode 20} {{1 {bad option to <Button> event: "-keycode"}}}} + {<Button> %b {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}} {<Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}} {<Key> %K {-keysym a} a} - {<Button> %b {-keysym a} {{1 {bad option to <Button> event: "-keysym"}}}} + {<Button> %b {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}} - {<Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, NotifyWhileGrabbed}}}} + {<Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}} {<Enter> %m {-mode NotifyNormal} NotifyNormal} {<FocusIn> %m {-mode NotifyNormal} {{}}} - {<Key> %k {-mode NotifyNormal} {{1 {bad option to <Key> event: "-mode"}}}} + {<Key> %k {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}} {<Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}} {<Map> %o {-override 1} 1} {<Reparent> %o {-override 1} 1} {<Configure> %o {-override 1} 1} - {<Key> %k {-override 1} {{1 {bad option to <Key> event: "-override"}}}} + {<Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}} - {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}} + {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}} {<Circulate> %p {-place PlaceOnTop} PlaceOnTop} - {<Key> %k {-place PlaceOnTop} {{1 {bad option to <Key> event: "-place"}}}} + {<Key> %k {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}} {<Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}} {<Key> %R {-root .b} {[winfo id .b]}} - {<Key> %R {-root xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %R {-root xyz} {{1 {bad window name/identifier "xyz"}}}} {<Key> %R {-root [winfo id .b]} {[winfo id .b]}} {<Button> %R {-root .b} {[winfo id .b]}} {<Motion> %R {-root .b} {[winfo id .b]}} {<<Paste>> %R {-root .b} {[winfo id .b]}} {<Enter> %R {-root .b} {[winfo id .b]}} - {<Configure> %R {-root .b} {{1 {bad option to <Configure> event: "-root"}}}} + {<Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}} {<Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}} {<Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} @@ -2045,7 +2045,7 @@ foreach check { {<Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {<<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {<Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} - {<Configure> %X {-rootx 2i} {{1 {bad option to <Configure> event: "-rootx"}}}} + {<Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}} {<Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}} {<Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} @@ -2053,7 +2053,7 @@ foreach check { {<Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {<<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {<Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} - {<Configure> %Y {-rooty 2i} {{1 {bad option to <Configure> event: "-rooty"}}}} + {<Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}} {<Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}} {<Key> %E {-sendevent 1} 1} @@ -2069,19 +2069,19 @@ foreach check { {<Motion> %s {-state 1} 1} {<<Paste>> %s {-state 1} 1} {<Enter> %s {-state 1} 1} - {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, VisibilityFullyObscured}}}} + {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}} {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured} - {<Configure> %s {-state xyz} {{1 {bad option to <Configure> event: "-state"}}}} + {<Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}} {<Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}} {<Key> %S {-subwindow .b} {[winfo id .b]}} - {<Key> %S {-subwindow xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %S {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}} {<Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}} {<Button> %S {-subwindow .b} {[winfo id .b]}} {<Motion> %S {-subwindow .b} {[winfo id .b]}} {<<Paste>> %S {-subwindow .b} {[winfo id .b]}} {<Enter> %S {-subwindow .b} {[winfo id .b]}} - {<Configure> %S {-subwindow .b} {{1 {bad option to <Configure> event: "-subwindow"}}}} + {<Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}} {<Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}} {<Key> %t {-time 100} 100} @@ -2090,16 +2090,16 @@ foreach check { {<<Paste>> %t {-time 100} 100} {<Enter> %t {-time 100} 100} {<Property> %t {-time 100} 100} - {<Configure> %t {-time 100} {{1 {bad option to <Configure> event: "-time"}}}} + {<Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}} {<Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}} {<Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}} {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}} - {<Key> %k {-width 2i} {{1 {bad option to <Key> event: "-width"}}}} + {<Key> %k {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}} {<Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}} {<Unmap> %W {-window .b.f} .b.f} - {<Unmap> %W {-window xyz} {{1 {expected integer but got "xyz"}}}} + {<Unmap> %W {-window xyz} {{1 {bad window name/identifier "xyz"}}}} {<Unmap> %W {-window [winfo id .b.f]} .b.f} {<Unmap> %W {-window .b.f} .b.f} {<Map> %W {-window .b.f} .b.f} @@ -2107,7 +2107,7 @@ foreach check { {<Configure> %W {-window .b.f} .b.f} {<Gravity> %W {-window .b.f} .b.f} {<Circulate> %W {-window .b.f} .b.f} - {<Key> %W {-window .b.f} {{1 {bad option to <Key> event: "-window"}}}} + {<Key> %W {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}} {<Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}} {<Key> %x {-x 2i} {[winfo pixels .b.f 2i]}} @@ -2119,7 +2119,7 @@ foreach check { {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}} {<Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}} {<Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {<Map> %x {-x 2i} {{1 {bad option to <Map> event: "-x"}}}} + {<Map> %x {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}} {<Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}} {<Key> %y {-y 2i} {[winfo pixels .b.f 2i]}} @@ -2131,9 +2131,9 @@ foreach check { {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}} {<Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}} {<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {<Map> %y {-y 2i} {{1 {bad option to <Map> event: "-y"}}}} + {<Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}} - {<Key> %k {-xyz 1} {{1 {bad option to <Key> event: "-xyz"}}}} + {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -width, -window, -x, or -y}}}} } { set event [lindex $check 0] test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" { @@ -2244,7 +2244,17 @@ test bind-24.12 {FindSequence procedure: not new sequence, don't create} { 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 {}} test bind-25.1 {ParseEventDescription procedure} { list [catch {bind .b \x7 test} msg] $msg @@ -2557,3 +2567,20 @@ test bind-31.2 {MouseWheel events} { destroy .b + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/bitmap.test b/tests/bitmap.test new file mode 100644 index 0000000..2049840 --- /dev/null +++ b/tests/bitmap.test @@ -0,0 +1,116 @@ +# This file is a Tcl script to test out the procedures in the file +# tkBitmap.c. It is organized in the standard white-box fashion for +# Tcl tests. +# +# Copyright (c) 1998 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: bitmap.test,v 1.2 1999/04/16 01:51:34 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {[info commands testbitmap] != "testbitmap"} { + puts "testbitmap command not available; skipping tests" + ::tcltest::cleanupTests + return +} + +eval destroy [winfo children .] +wm geometry . {} +raise . + +test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} { + set x gray25 + lindex $x 0 + destroy .b1 + button .b1 -bitmap $x + lindex $x 0 + testbitmap gray25 +} {{1 0}} +test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} { + 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} { + set x gray25 + destroy .b1 .b2 + button .b1 -bitmap $x + set result {} + lappend result [testbitmap gray25] + button .b2 -bitmap $x + pack .b1 .b2 -side top + lappend result [testbitmap gray25] +} {{{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-3.1 {Tk_FreeBitmapFromObj - reference counts} { + 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] + destroy .b2 + lappend result [testbitmap questhead] + destroy .b3 + lappend result [testbitmap questhead] +} {{{3 1}} {{2 1}} {{1 1}} {}} + +test bitmap-4.1 {FreeBitmapObjProc} { + destroy .b + set x [format questhead] + button .b -bitmap $x + set y [format questhead] + .b configure -bitmap $y + set z [format questhead] + .b configure -bitmap $z + set result {} + lappend result [testbitmap questhead] + set x red + lappend result [testbitmap questhead] + set z 32 + lappend result [testbitmap questhead] + destroy .b + lappend result [testbitmap questhead] + set y bogus + set result +} {{{1 3}} {{1 2}} {{1 1}} {}} + +destroy .t + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/border.test b/tests/border.test new file mode 100644 index 0000000..e59b405 --- /dev/null +++ b/tests/border.test @@ -0,0 +1,195 @@ +# This file is a Tcl script to test out the procedures in the file +# tkBorder.c. It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1998 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: border.test,v 1.2 1999/04/16 01:51:34 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {[info commands testborder] != "testborder"} { + puts "testborder command not available; skipping tests" + ::tcltest::cleanupTests + return +} + +eval destroy [winfo children .] +wm geometry . {} +raise . + +# Create a top-level with its own colormap (so we can test under +# controlled conditions), then check to make sure that the visual +# is color-mapped with 256 borders. If not, just skip this whole +# test file. + +if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] { + ::tcltest::cleanupTests + return +} +wm geom .t +0+0 +if {[winfo depth .t] != 8} { + destroy .t + ::tcltest::cleanupTests + return +} + +test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} { + 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} { + 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} { + set x orange + destroy .b1 .b2 + button .b1 -bg $x -text First + set result {} + 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} { + 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 + lappend result [testborder purple] + button .b2 -bg $x -text Third + pack .b2 -side top + lappend result [testborder purple] +} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} + +test border-3.1 {Tk_Free3DBorder - reference counts} { + 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] + destroy .b2 + 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} { + destroy .b .t.b .t2 .t3 + toplevel .t2 -visual {pseudocolor 8} -colormap new + toplevel .t3 -visual {pseudocolor 8} -colormap new + set x purple + button .b -bg $x -text .b1 + button .t.b1 -bg $x -text .t.b1 + button .t.b2 -bg $x -text .t.b2 + button .t2.b1 -bg $x -text .t2.b1 + button .t2.b2 -bg $x -text .t2.b2 + button .t2.b3 -bg $x -text .t2.b3 + button .t3.b1 -bg $x -text .t3.b1 + 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] + destroy .b + lappend result [testborder purple] + destroy .t3 + 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}} {}} + +test border-4.1 {FreeBorderObjProc} { + destroy .b + set x [format purple] + button .b -bg $x -text .b1 + set y [format purple] + .b configure -bg $y + set z [format purple] + .b configure -bg $z + set result {} + lappend result [testborder purple] + set x red + lappend result [testborder purple] + set z 32 + lappend result [testborder purple] + destroy .b + lappend result [testborder purple] + set y bogus + set result +} {{{1 3}} {{1 2}} {{1 1}} {}} + +catch {destroy .b} +button .b +test get-2.1 {Tk_GetReliefFromObj} { + .b configure -relief flat + .b cget -relief +} {flat} +test get-2.2 {Tk_GetReliefFromObj} { + .b configure -relief groove + .b cget -relief +} {groove} +test get-2.3 {Tk_GetReliefFromObj} { + .b configure -relief raised + .b cget -relief +} {raised} +test get-2.3 {Tk_GetReliefFromObj} { + .b configure -relief ridge + .b cget -relief +} {ridge} +test get-2.3 {Tk_GetReliefFromObj} { + .b configure -relief solid + .b cget -relief +} {solid} +test get-2.3 {Tk_GetReliefFromObj} { + .b configure -relief sunken + .b cget -relief +} {sunken} +test get-2.4 {Tk_GetReliefFromObj - error} { + list [catch {.b configure -relief upanddown} msg] $msg +} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}} + +destroy .t + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/bugs.tcl b/tests/bugs.tcl index 880e216..e1492b4 100644 --- a/tests/bugs.tcl +++ b/tests/bugs.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: bugs.tcl,v 1.2 1998/09/14 18:23:43 stanton Exp $ +# RCS: @(#) $Id: bugs.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $ if {[info procs test] != "test"} { source defs @@ -28,3 +28,16 @@ test crash-1.1 {color} { . configure -bg rgb:345 set foo "" } {} + + + + + + + + + + + + + diff --git a/tests/butGeom.tcl b/tests/butGeom.tcl index 7f124df..da91d08 100644 --- a/tests/butGeom.tcl +++ b/tests/butGeom.tcl @@ -1,7 +1,7 @@ # This file creates a visual test for button layout. It is part of # the Tk visual test suite, which is invoked via the "visual" script. # -# RCS: @(#) $Id: butGeom.tcl,v 1.2 1998/09/14 18:23:43 stanton Exp $ +# RCS: @(#) $Id: butGeom.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $ catch {destroy .t} toplevel .t @@ -113,3 +113,16 @@ proc config {option value} { $w configure $option $value } } + + + + + + + + + + + + + diff --git a/tests/butGeom2.tcl b/tests/butGeom2.tcl index 36122ea..9dc223e 100644 --- a/tests/butGeom2.tcl +++ b/tests/butGeom2.tcl @@ -1,7 +1,7 @@ # This file creates a visual test for button layout. It is part of # the Tk visual test suite, which is invoked via the "visual" script. # -# RCS: @(#) $Id: butGeom2.tcl,v 1.2 1998/09/14 18:23:43 stanton Exp $ +# RCS: @(#) $Id: butGeom2.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $ catch {destroy .t} toplevel .t @@ -111,3 +111,16 @@ proc config-but {option value} { $w configure $option $value } } + + + + + + + + + + + + + diff --git a/tests/button.test b/tests/button.test index 1e36dd2..309c795 100644 --- a/tests/button.test +++ b/tests/button.test @@ -4,23 +4,23 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: button.test,v 1.2 1998/09/14 18:23:43 stanton Exp $ +# RCS: @(#) $Id: button.test,v 1.3 1999/04/16 01:51:34 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\"" puts "image, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -51,255 +51,217 @@ update set i 1 foreach test { {-activebackground #012345 #012345 non-existent - {unknown color name "non-existent"}} + {unknown color name "non-existent"} {0 1 1 1}} {-activeforeground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} + {unknown color name "non-existent"} {0 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"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bitmap questhead questhead badValue {bitmap "badValue" not defined}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-command "set x" {set x} {} {}} - {-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 {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}} - {-offvalue lousy lousy {} {}} - {-offvalue fantastic fantastic {} {}} - {-padx 12 12 420x {bad screen distance "420x"}} - {-pady 12 12 420x {bad screen distance "420x"}} - {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}} - {-selectimage image1 image1 bogus {image "bogus" doesn't exist}} - {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}} - {-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"}} + {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}} + {-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"} + {0 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}} + {-offvalue lousy lousy {} {} {0 0 1 0}} + {-offvalue fantastic fantastic {} {} {0 0 1 0}} + {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}} + {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}} + {-relief groove groove 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} {0 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}} + {-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}} } { set name [lindex $test 0] - test button-1.$i {configuration options} { - .c configure $name [lindex $test 1] - lindex [.c configure $name] 4 - } [lindex $test 2] - incr i - if {[lindex $test 3] != ""} { - test button-1.$i {configuration options} { - list [catch {.c configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] + set classes [lindex $test 5] + foreach w {.l .b .c .r} hasOption [lindex $test 5] { + if $hasOption { + test button-1.$i {configuration options} { + $w configure $name [lindex $test 1] + lindex [$w configure $name] 4 + } [lindex $test 2] + incr i + if {[lindex $test 3] != ""} { + test button-1.$i {configuration options} { + list [catch {$w configure $name [lindex $test 3]} msg] $msg + } [list 1 [lindex $test 4]] + } + $w configure $name [lindex [$w configure $name] 3] + } else { + test button-1.$i {configuration options} { + list [catch {$w configure $name [lindex $test 1]} msg] $msg + } "1 {unknown option \"$name\"}" + } } - .c configure $name [lindex [.c configure $name] 3] incr i } test button-1.$i {configuration options} { .c configure -selectcolor {} } {} incr i -# the following tests only work on buttons, not checkbuttons -test button-1.$i {configuration options} { - .b configure -default active - lindex [.b configure -default] 4 -} active -incr i -test button-1.$i {configuration options} { - .b configure -default normal - lindex [.b configure -default] 4 -} normal -incr i -test button-1.$i {configuration options} { - .b configure -default disabled - lindex [.b configure -default] 4 -} disabled -incr i -test button-1.$i {configuration options} { - .b configure -default active - lindex [.b configure -default] 3 -} disabled -incr i -test button-1.$i {configuration options} { - list [catch {.b configure -default no_way} msg] $msg -} {1 {bad -default value "no_way": must be normal, active, or disabled}} -set i 1 -foreach check { - {-activebackground 1 0 0 0} - {-activeforeground 1 0 0 0} - {-anchor 0 0 0 0} - {-background 0 0 0 0} - {-bd 0 0 0 0} - {-bg 0 0 0 0} - {-bitmap 0 0 0 0} - {-borderwidth 0 0 0 0} - {-command 1 0 0 0} - {-cursor 0 0 0 0} - {-default 1 0 1 1} - {-disabledforeground 1 0 0 0} - {-fg 0 0 0 0} - {-font 0 0 0 0} - {-foreground 0 0 0 0} - {-height 0 0 0 0} - {-image 0 0 0 0} - {-indicatoron 1 1 0 0} - {-offvalue 1 1 0 1} - {-onvalue 1 1 0 1} - {-padx 0 0 0 0} - {-pady 0 0 0 0} - {-relief 0 0 0 0} - {-selectcolor 1 1 0 0} - {-selectimage 1 1 0 0} - {-state 1 0 0 0} - {-text 0 0 0 0} - {-textvariable 0 0 0 0} - {-value 1 1 1 0} - {-variable 1 1 0 0} - {-width 0 0 0 0} +test button-3.1 {ButtonCreate - not enough cd ../unix } { - test button-2.$i {label-specific options} " - catch {.l configure [lindex $check 0]} - " [lindex $check 1] - incr i - test button-2.$i {button-specific options} " - catch {.b configure [lindex $check 0]} - " [lindex $check 2] - incr i - test button-2.$i {checkbutton-specific options} " - catch {.c configure [lindex $check 0]} - " [lindex $check 3] - incr i - test button-2.$i {radiobutton-specific options} " - catch {.r configure [lindex $check 0]} - " [lindex $check 4] - incr i -} - -test button-3.1 {ButtonCreate procedure} { list [catch {button} msg] $msg } {1 {wrong # args: should be "button pathName ?options?"}} -test button-3.2 {ButtonCreate procedure} { +test button-3.2 {ButtonCreate procedure - setting label class} { catch {destroy .x} label .x winfo class .x } {Label} -test button-3.3 {ButtonCreate procedure} { +test button-3.3 {ButtonCreate - setting button class} { catch {destroy .x} button .x winfo class .x } {Button} -test button-3.4 {ButtonCreate procedure} { +test button-3.4 {ButtonCreate - setting checkbutton class} { catch {destroy .x} checkbutton .x winfo class .x } {Checkbutton} -test button-3.5 {ButtonCreate procedure} { +test button-3.5 {ButtonCreate - setting radiobutton class} { catch {destroy .x} radiobutton .x winfo class .x } {Radiobutton} rename button gorp -test button-3.6 {ButtonCreate procedure} { +test button-3.6 {ButtonCreate - setting class} { catch {destroy .x} gorp .x winfo class .x } {Button} rename gorp button -test button-3.7 {ButtonCreate procedure} { +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} { +test button-3.8 {ButtonCreate procedure - error in default option value} { + catch {destroy .funny} + option add *funny.background bogus + list [catch {button .funny} msg] $msg $errorInfo +} {1 {unknown color name "bogus"} {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} + set x [button .abcd] + destroy .abc + set x +} {.abcd} -test button-4.1 {ButtonWidgetCmd procedure} { +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 procedure, "cget" option} { +test button-4.2 {ButtonWidgetCmd - bad option name} { list [catch {.b c} msg] $msg -} {1 {bad option "c": must be cget, configure, flash, or invoke}} -test button-4.3 {ButtonWidgetCmd procedure, "cget" option} { +} {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.4 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.5 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.b cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} -test button-4.5 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.6 {ButtonWidgetCmd procedure, "cget" option} { .b configure -highlightthickness 3 .b cget -highlightthickness } {3} -test button-4.6 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.7 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.l cget -disabledforeground} msg] $msg } {1 {unknown option "-disabledforeground"}} -test button-4.7 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.8 {ButtonWidgetCmd procedure, "cget" option} { catch {.b cget -disabledforeground} } {0} -test button-4.8 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.9 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.b cget -variable} msg] $msg } {1 {unknown option "-variable"}} -test button-4.9 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.10 {ButtonWidgetCmd procedure, "cget" option} { catch {.c cget -variable} } {0} -test button-4.10 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.11 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.c cget -value} msg] $msg } {1 {unknown option "-value"}} -test button-4.11 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.12 {ButtonWidgetCmd procedure, "cget" option} { catch {.r cget -value} } {0} -test button-4.12 {ButtonWidgetCmd procedure, "cget" option} { +test button-4.13 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.r cget -onvalue} msg] $msg } {1 {unknown option "-onvalue"}} -test button-4.13 {ButtonWidgetCmd procedure, "configure" option} { +test button-4.14 {ButtonWidgetCmd procedure, "configure" option} { llength [.c configure] } {36} -test button-4.14 {ButtonWidgetCmd procedure, "configure" option} { +test button-4.15 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.b configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} -test button-4.15 {ButtonWidgetCmd procedure, "configure" option} { +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.16 {ButtonWidgetCmd procedure, "configure" option} { +test button-4.17 {ButtonWidgetCmd procedure, "configure" option} { .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.17 {ButtonWidgetCmd procedure, "deselect" option} { +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.18 {ButtonWidgetCmd procedure, "deselect" option} { +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.19 {ButtonWidgetCmd procedure, "deselect" option} { +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.20 {ButtonWidgetCmd procedure, "deselect" option} { +test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} { set value 1 .c d set value } {0} -test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} { +test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} { set value2 green .r deselect set value2 } {green} -test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} { +test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} { set value2 red .r deselect set value2 } {} -test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} { +test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} { set value 1 trace variable value w bogusTrace set result [list [catch {.c deselect} msg] $msg $errorInfo $value] @@ -308,7 +270,7 @@ test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} { } {1 {can't set "value": trace aborted} {can't set "value": trace aborted while executing ".c deselect"} 0} -test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} { +test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} { set value2 red trace variable value2 w bogusTrace set result [list [catch {.r deselect} msg] $msg $errorInfo $value2] @@ -317,40 +279,40 @@ test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} { } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted while executing ".r deselect"} {}} -test button-4.25 {ButtonWidgetCmd procedure, "flash" option} { +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.26 {ButtonWidgetCmd procedure, "flash" option} { +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.27 {ButtonWidgetCmd procedure, "flash" option} { +test button-4.28 {ButtonWidgetCmd procedure, "flash" option} { list [catch {.b flash} msg] $msg } {0 {}} -test button-4.28 {ButtonWidgetCmd procedure, "flash" option} { +test button-4.29 {ButtonWidgetCmd procedure, "flash" option} { list [catch {.c flash} msg] $msg } {0 {}} -test button-4.29 {ButtonWidgetCmd procedure, "flash" option} { +test button-4.30 {ButtonWidgetCmd procedure, "flash" option} { list [catch {.r f} msg] $msg } {0 {}} -test button-4.30 {ButtonWidgetCmd procedure, "invoke" option} { +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.31 {ButtonWidgetCmd procedure, "invoke" option} { +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.32 {ButtonWidgetCmd procedure, "invoke" option} { +test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} { .b configure -command {set x invoked} set x "not invoked" .b invoke set x } {invoked} -test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} { +test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} { .b configure -command {set x invoked} -state disabled set x "not invoked" .b invoke set x } {not invoked} -test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} { +test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} { set value bogus .c configure -command {set x invoked} -variable value -onvalue 1 \ -offvalue 0 @@ -358,35 +320,35 @@ test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} { .c invoke list $x $value } {invoked 1} -test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} { +test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} { set value2 green .r configure -command {set x invoked} -variable value2 -value red set x "not invoked" .r i list $x $value2 } {invoked red} -test button-4.36 {ButtonWidgetCmd procedure, "select" option} { +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.37 {ButtonWidgetCmd procedure, "select" option} { +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.38 {ButtonWidgetCmd procedure, "select" option} { +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.39 {ButtonWidgetCmd procedure, "select" option} { +test button-4.40 {ButtonWidgetCmd procedure, "select" option} { set value bogus .c configure -command {} -variable value -onvalue lovely -offvalue 0 .c s set value } {lovely} -test button-4.40 {ButtonWidgetCmd procedure, "select" option} { +test button-4.41 {ButtonWidgetCmd procedure, "select" option} { set value2 green .r configure -command {} -variable value2 -value red .r select set value2 } {red} -test button-4.41 {ButtonWidgetCmd procedure, "select" option} { +test button-4.42 {ButtonWidgetCmd procedure, "select" option} { set value2 yellow trace variable value2 w bogusTrace set result [list [catch {.r select} msg] $msg $errorInfo $value2] @@ -395,19 +357,19 @@ test button-4.41 {ButtonWidgetCmd procedure, "select" option} { } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted while executing ".r select"} red} -test button-4.42 {ButtonWidgetCmd procedure, "toggle" option} { +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.43 {ButtonWidgetCmd procedure, "toggle" option} { +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.44 {ButtonWidgetCmd procedure, "toggle" option} { +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.45 {ButtonWidgetCmd procedure, "toggle" option} { +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.46 {ButtonWidgetCmd procedure, "toggle" option} { +test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} { set value bogus .c configure -command {} -variable value -onvalue sunshine -offvalue rain .c toggle @@ -417,7 +379,7 @@ test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} { .c toggle lappend result $value } {sunshine rain sunshine} -test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} { +test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} { .c configure -onvalue xyz -offvalue abc set value xyz trace variable value w bogusTrace @@ -427,7 +389,7 @@ test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} { } {1 {can't set "value": trace aborted} {can't set "value": trace aborted while executing ".c toggle"} abc} -test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} { +test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} { .c configure -onvalue xyz -offvalue abc set value abc trace variable value w bogusTrace @@ -437,9 +399,6 @@ test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} { } {1 {can't set "value": trace aborted} {can't set "value": trace aborted while executing ".c toggle"} xyz} -test button-4.49 {ButtonWidgetCmd procedure} { - list [catch {.c bad_option} msg] $msg -} {1 {bad option "bad_option": must be cget, configure, deselect, flash, invoke, select, or toggle}} test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} { catch {unset value}; set value(1) 1; set result [list [catch {.c toggle} msg] $msg $errorInfo] @@ -462,7 +421,14 @@ test button-5.1 {DestroyButton procedure} { eval destroy [winfo children .] } {} -test button-6.1 {ConfigureButton procedure} { +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} set x From-x set y From-y @@ -471,7 +437,7 @@ test button-6.1 {ConfigureButton procedure} { set x New lindex [.b1 configure -text] 4 } {From-y} -test button-6.2 {ConfigureButton procedure} { +test button-6.2 {ConfigureButton - variable traces} { catch {destroy .b1} catch {unset x} checkbutton .b1 -variable x @@ -482,7 +448,7 @@ test button-6.2 {ConfigureButton procedure} { .b1 toggle set y } {1} -test button-6.3 {ConfigureButton procedure} { +test button-6.3 {ConfigureButton - image handling} { catch {destroy .b1} eval image delete [image names] image create test image1 @@ -492,18 +458,12 @@ test button-6.3 {ConfigureButton procedure} { .b1 configure -image image2 image names } {image2} -test button-6.4 {ConfigureButton procedure} { - catch {destroy .b1} - button .b1 -text "Test" -state disabled - list [catch {.b1 configure -state bogus} msg] $msg \ - [lindex [.b1 configure -state] 4] -} {1 {bad state value "bogus": must be normal, active, or disabled} normal} -test button-6.5 {ConfigureButton procedure} { +test button-6.5 {ConfigureButton - default value for variable} { catch {destroy .b1} checkbutton .b1 .b1 cget -variable } {b1} -test button-6.6 {ConfigureButton procedure} { +test button-6.6 {ConfigureButton - setting selected state from variable} { catch {destroy .b1} set x 0 set y Shiny @@ -512,19 +472,19 @@ test button-6.6 {ConfigureButton procedure} { .b1 toggle set y } 0 -test button-6.7 {ConfigureButton procedure} { +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 procedure} { +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 procedure} { +test button-6.9 {ConfigureButton - error in setting variable} { catch {destroy .b1} catch {unset x} trace variable x w bogusTrace @@ -532,23 +492,23 @@ test button-6.9 {ConfigureButton procedure} { trace vdelete x w bogusTrace set result } {1 {can't set "x": trace aborted}} -test button-6.10 {ConfigureButton procedure} { +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 procedure} { +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 procedure} { +test button-6.12 {ConfigureButton - using current value of variable} { catch {destroy .b1} set x Override button .b1 -textvariable x -text "Button 1" set x } {Override} -test button-6.13 {ConfigureButton procedure} { +test button-6.13 {ConfigureButton - variable handling} { catch {destroy .b1} catch {unset x} trace variable x w bogusTrace @@ -557,7 +517,7 @@ test button-6.13 {ConfigureButton procedure} { trace vdelete x w bogusTrace set result } {1 {can't set "x": trace aborted} foo} -test button-6.14 {ConfigureButton procedure} { +test button-6.14 {ConfigureButton - -width option} { catch {destroy .b1} button .b1 -text "Button 1" list [catch {.b1 configure -width 1i} msg] $msg $errorInfo @@ -565,7 +525,7 @@ test button-6.14 {ConfigureButton procedure} { (processing -width option) invoked from within ".b1 configure -width 1i"}} -test button-6.15 {ConfigureButton procedure} { +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 @@ -573,7 +533,7 @@ test button-6.15 {ConfigureButton procedure} { (processing -height option) invoked from within ".b1 configure -height 0.5c"}} -test button-6.16 {ConfigureButton procedure} { +test button-6.16 {ConfigureButton - -width option} { catch {destroy .b1} button .b1 -bitmap questhead list [catch {.b1 configure -width abc} msg] $msg $errorInfo @@ -581,7 +541,7 @@ test button-6.16 {ConfigureButton procedure} { (processing -width option) invoked from within ".b1 configure -width abc"}} -test button-6.17 {ConfigureButton procedure} { +test button-6.17 {ConfigureButton - -height option} { catch {destroy .b1} eval image delete [image names] image create test image1 @@ -591,7 +551,7 @@ test button-6.17 {ConfigureButton procedure} { (processing -height option) invoked from within ".b1 configure -height 0.5x"}} -test button-6.18 {ConfigureButton procedure} {nonPortable fonts} { +test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} { catch {destroy .b1} button .b1 -text "Sample text" -width 10 -height 2 pack .b1 @@ -599,7 +559,7 @@ test button-6.18 {ConfigureButton procedure} {nonPortable fonts} { .b1 configure -bitmap questhead lappend result [winfo reqwidth .b1] [winfo reqheight .b1] } {102 46 20 12} -test button-6.19 {ConfigureButton procedure} { +test button-6.19 {ConfigureButton - computing geometry} { catch {destroy .b1} button .b1 -text "Button 1" set old [winfo reqwidth .b1] @@ -820,3 +780,19 @@ eval destroy [winfo children .] option clear +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/canvImg.test b/tests/canvImg.test index 05af9df..a79c15e 100644 --- a/tests/canvImg.test +++ b/tests/canvImg.test @@ -4,23 +4,23 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: canvImg.test,v 1.2 1998/09/14 18:23:43 stanton Exp $ +# RCS: @(#) $Id: canvImg.test,v 1.3 1999/04/16 01:51:34 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -395,3 +395,20 @@ test canvImg-11.3 {ImageChangedProc procedure} { update set y } {{foo2 display 0 0 20 40 50 40}} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/canvPs.test b/tests/canvPs.test index 6fc4bd0..08d72cf 100644 --- a/tests/canvPs.test +++ b/tests/canvPs.test @@ -3,14 +3,13 @@ # TkCanvPostscriptCmd in generic/tkCanvPs.c # # Copyright (c) 1995 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: canvPs.test,v 1.2 1998/09/14 18:23:43 stanton Exp $ +# RCS: @(#) $Id: canvPs.test,v 1.3 1999/04/16 01:51:34 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -95,11 +94,24 @@ test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} { set status } ok -# Clean-up - +# cleanup removeFile foo.ps removeFile bar.ps - foreach i [winfo children .] { destroy $i } +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/canvPsArc.tcl b/tests/canvPsArc.tcl index 8b77091..4acdbbe 100644 --- a/tests/canvPsArc.tcl +++ b/tests/canvPsArc.tcl @@ -2,7 +2,7 @@ # for bitmaps in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. # -# RCS: @(#) $Id: canvPsArc.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $ +# RCS: @(#) $Id: canvPsArc.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $ catch {destroy .t} toplevel .t @@ -43,3 +43,16 @@ $c create arc .5i 4.5i 2i 6i -style arc -start 135 -extent 315 -width 3m \ -outline black -outlinestipple gray25 $c create arc 3.5i 4.5i 5.5i 5.5i -style arc -start 45 -extent -90 -width 1m \ -outline black + + + + + + + + + + + + + diff --git a/tests/canvPsBmap.tcl b/tests/canvPsBmap.tcl index 15f41a4..dbc9c83 100644 --- a/tests/canvPsBmap.tcl +++ b/tests/canvPsBmap.tcl @@ -2,7 +2,7 @@ # for bitmaps in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. # -# RCS: @(#) $Id: canvPsBmap.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $ +# RCS: @(#) $Id: canvPsBmap.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $ catch {destroy .t} toplevel .t @@ -69,3 +69,16 @@ $c create bitmap 5.5i 5.5i \ -bitmap @[file join $tk_library demos/images/flagup.bmp] \ -background {} -foreground black -anchor se $c create rect 5.47i 5.47i 5.53i 5.53i -fill {} -outline black + + + + + + + + + + + + + diff --git a/tests/canvPsGrph.tcl b/tests/canvPsGrph.tcl index 8458727..1b27898 100644 --- a/tests/canvPsGrph.tcl +++ b/tests/canvPsGrph.tcl @@ -2,7 +2,7 @@ # for some of the graphical objects in canvases. It is part of the Tk # visual test suite, which is invoked via the "visual" script. # -# RCS: @(#) $Id: canvPsGrph.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $ +# RCS: @(#) $Id: canvPsGrph.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $ catch {destroy .t} toplevel .t @@ -85,3 +85,16 @@ proc mkObjs c { } mkObjs $c + + + + + + + + + + + + + diff --git a/tests/canvPsText.tcl b/tests/canvPsText.tcl index 61df240..145dcc7 100644 --- a/tests/canvPsText.tcl +++ b/tests/canvPsText.tcl @@ -2,7 +2,7 @@ # for text in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. # -# RCS: @(#) $Id: canvPsText.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $ +# RCS: @(#) $Id: canvPsText.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $ catch {destroy .t} toplevel .t @@ -81,3 +81,16 @@ proc setStipple c { global stipple $c itemconfigure text -stipple $stipple } + + + + + + + + + + + + + diff --git a/tests/canvRect.test b/tests/canvRect.test index c582990..9ba8c8d 100644 --- a/tests/canvRect.test +++ b/tests/canvRect.test @@ -3,14 +3,13 @@ # in the standard fashion for Tcl tests. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: canvRect.test,v 1.2 1998/09/14 18:23:44 stanton Exp $ +# RCS: @(#) $Id: canvRect.test,v 1.3 1999/04/16 01:51:35 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -294,7 +293,7 @@ test canvRect-10.1 {TranslateRectOval procedure} { # 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 win32sCrash macCrash} { +test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable macCrash} { # Crashes on Mac because the XGetImage() call isn't implemented, causing a # dereference of NULL. @@ -327,3 +326,20 @@ restore showpage end %%EOF } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/canvText.test b/tests/canvText.test index 9263e87..f0d9b85 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -3,14 +3,13 @@ # fashion for Tcl tests. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: canvText.test,v 1.3 1998/10/16 00:46:19 rjohnson Exp $ +# RCS: @(#) $Id: canvText.test,v 1.4 1999/04/16 01:51:35 stanton Exp $ -if {"[info procs test]" != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -174,7 +173,7 @@ test canvText-5.1 {ConfigureText procedure: adjust cursor} { .c delete x } {} -test canvText-6.1 {ComputeTextBbox procedure} {fonts} { +test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} { .c itemconfig test -font $font -text 0 .c coords test 0 0 set x {} @@ -200,7 +199,7 @@ test canvText-6.1 {ComputeTextBbox procedure} {fonts} { focus .c .c focus test .c itemconfig test -text "abcd\nefghi\njklmnopq" -test canvText-7.1 {DisplayText procedure: stippling} { +test canvText-7.0 {DisplayText procedure: stippling} { .c itemconfig test -stipple gray50 update .c itemconfig test -stipple {} @@ -491,3 +490,19 @@ restore showpage end %%EOF " +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/canvWind.test b/tests/canvWind.test index 2ae6ac8..76db55c 100644 --- a/tests/canvWind.test +++ b/tests/canvWind.test @@ -3,14 +3,13 @@ # fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: canvWind.test,v 1.2 1998/09/14 18:23:44 stanton Exp $ +# RCS: @(#) $Id: canvWind.test,v 1.3 1999/04/16 01:51:35 stanton Exp $ -if {"[info procs test]" != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -131,3 +130,21 @@ test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} { update lappend x [list [winfo ismapped $f] [winfo x $f]] } {{1 3} {1 -79} {0 -79} {1 255} {0 255}} +catch {destroy .t} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/canvas.test b/tests/canvas.test index c37a36a..ee612ef 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -3,15 +3,13 @@ # standard fashion for Tcl tests. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. -# Copyright (c) 1998 by Scriptics Corporation. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: canvas.test,v 1.4 1998/10/13 18:13:07 rjohnson Exp $ +# RCS: @(#) $Id: canvas.test,v 1.5 1999/04/16 01:51:35 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -75,7 +73,16 @@ canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \ -highlightthickness 0 pack .c update -test canvas-2.1 {CanvasWidgetCmd, xview option} { + +test canvas-2.1 {CanvasWidgetCmd, bind option} { + 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} { + 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 configure -xscrollincrement 40 -yscrollincrement 5 .c xview moveto 0 update @@ -84,7 +91,7 @@ test canvas-2.1 {CanvasWidgetCmd, xview option} { update lappend x [.c xview] } {{0 0.3} {0.4 0.7}} -test canvas-2.2 {CanvasWidgetCmd, xview option} {nonPortable} { +test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} { # This test gives slightly different results on platforms such # as NetBSD. I don't know why... .c configure -xscrollincrement 0 -yscrollincrement 5 @@ -236,3 +243,20 @@ test canvas-9.1 {canvas id creation and deletion} { set x "" } {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/clipboard.test b/tests/clipboard.test index 1c1b43b..7e482e9 100644 --- a/tests/clipboard.test +++ b/tests/clipboard.test @@ -3,19 +3,18 @@ # fashion for Tcl tests. # # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: clipboard.test,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: clipboard.test,v 1.3 1999/04/16 01:51:35 stanton Exp $ # # Note: Multiple display clipboard handling will only be tested if the # environment variable TK_ALT_DISPLAY is set to an alternate display. # -if {[string compare test [info procs test]] == 1} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } eval destroy [winfo child .] @@ -232,3 +231,20 @@ test clipboard-7.13 {Tk_ClipboardCmd procedure} { test clipboard-7.14 {Tk_ClipboardCmd procedure} { list [catch {clipboard error} msg] $msg } {1 {bad option "error": must be clear or append}} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/clrpick.test b/tests/clrpick.test index a56b6b3..db101b8 100644 --- a/tests/clrpick.test +++ b/tests/clrpick.test @@ -2,22 +2,27 @@ # It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: clrpick.test,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: clrpick.test,v 1.3 1999/04/16 01:51:35 stanton Exp $ # -if {[string compare test [info procs test]] == 1} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } +# Some tests require user interaction on non-unix platform + +set ::tcltest::testConfig(nonUnixUserInteraction) \ + [expr {$::tcltest::testConfig(userInteraction) || \ + $::tcltest::testConfig(unixOnly)}] + test clrpick-1.1 {tk_chooseColor command} { list [catch {tk_chooseColor -foo} msg] $msg -} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}} +} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}} -catch {tk_chooseColor -foo} msg +catch {tk_chooseColor -foo 1} msg regsub -all , $msg "" options regsub \"-foo\" $options "" options @@ -31,7 +36,7 @@ foreach option $options { test clrpick-1.3 {tk_chooseColor command} { list [catch {tk_chooseColor -foo bar} msg] $msg -} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}} +} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}} test clrpick-1.4 {tk_chooseColor command} { list [catch {tk_chooseColor -initialcolor} msg] $msg @@ -55,14 +60,6 @@ if {[info commands tkColorDialog] == ""} { set isNative 0 } -if {$isNative && ![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test." - return -} - proc ToPressButton {parent btn} { global isNative if {!$isNative} { @@ -141,8 +138,9 @@ set verylongstring $verylongstring$verylongstring # let's soak up a bunch of colors...so that # machines with small color palettes still fail. +# some tests will be skipped if there are no more colors set numcolors 32 -set nomorecolors 0 +set ::tcltest::testConfig(colorsLeftover) 1 set i 0 canvas .c pack .c -expand 1 -fill both @@ -160,7 +158,7 @@ while {$i<$numcolors} { set g [expr $g/256] set b [expr $b/256] if {"$color" != "#[format %02x%02x%02x $r $g $b]"} { - set nomorecolors 1 + set ::tcltest::testConfig(colorsLeftover) 0 } } .c delete $i @@ -169,47 +167,62 @@ while {$i<$numcolors} { destroy .c -if {!$nomorecolors} { - set color #404040 - test clrpick-2.1 {tk_chooseColor command} { - ToPressButton $parent ok - tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color -parent $parent - } "$color" +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} { - if {$tcl_platform(platform) == "macintosh"} { - set colors "32768 32768 16384" - } else { - set colors "128 128 64" - } - ToChooseColorByKey $parent 128 128 64 - tk_chooseColor -parent $parent -title "choose $colors" - } "$color" +set color #808040 +test clrpick-2.2 {tk_chooseColor command} \ + {nonUnixUserInteraction colorsLeftover} { + if {$tcl_platform(platform) == "macintosh"} { + set colors "32768 32768 16384" + } else { + 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} { - ToPressButton $parent ok - tk_chooseColor -parent $parent -title "Press OK" - } "$color" -} else { - puts "Skipped tests clrpick2.1, clrpick2.2 and clrpick2.3 because" - puts "you ran out of colors in your color palette, and this would" - puts "have caused the tests to generate errors." -} +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} { +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} { +test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} { 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} { +test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} { after 1 {set x 53} ToPressButton $parent cancel tk_chooseColor -parent $parent -title "Press Cancel" } "" + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/cmap.tcl b/tests/cmap.tcl index fb92643..dca7f71 100644 --- a/tests/cmap.tcl +++ b/tests/cmap.tcl @@ -2,7 +2,7 @@ # property. It is part of the Tk visual test suite, which is invoked # via the "visual" script. # -# RCS: @(#) $Id: cmap.tcl,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: cmap.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $ catch {destroy .t} toplevel .t -colormap new @@ -59,3 +59,16 @@ pack .t2.quit -side bottom -pady 3 -ipadx 4 -ipady 2 frame .t2.f -height 320 -width 320 pack .t2.f -side bottom colors .t2.f 0 0 4 + + + + + + + + + + + + + diff --git a/tests/cmds.test b/tests/cmds.test index 6524f3c..c6301d9 100644 --- a/tests/cmds.test +++ b/tests/cmds.test @@ -2,14 +2,13 @@ # tkCmds.c. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: cmds.test,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: cmds.test,v 1.3 1999/04/16 01:51:35 stanton Exp $ -if {[string compare test [info procs test]] == 1} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } eval destroy [winfo child .] @@ -41,3 +40,20 @@ test cmds-1.5 {tkwait visibility, window gets deleted} { 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} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/color.test b/tests/color.test index 7c68ec3..3b86efc 100644 --- a/tests/color.test +++ b/tests/color.test @@ -1,15 +1,20 @@ # This file is a Tcl script to test out the procedures in the file # tkColor.c. It is organized in the standard fashion for Tcl tests. # -# Copyright (c) 1995 Sun Microsystems, Inc. +# Copyright (c) 1995-1998 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: color.test,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: color.test,v 1.3 1999/04/16 01:51:36 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} -if {[info procs test] != "test"} { - source defs +if {[info commands testcolor] != "testcolor"} { + puts "testcolor command not available; skipping tests" + ::tcltest::cleanupTests + return } eval destroy [winfo children .] @@ -103,11 +108,13 @@ proc colorsFree {w {red 31} {green 245} {blue 192}} { # test file. if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] { + ::tcltest::cleanupTests return } wm geom .t +0+0 if {[winfo depth .t] != 8} { destroy .t + ::tcltest::cleanupTests return } mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40 @@ -115,31 +122,75 @@ pack .t.c update if ![colorsFree .t.c 101 233 17] { destroy .t + ::tcltest::cleanupTests return } mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0 pack .t.c2 if [colorsFree .t.c] { destroy .t + ::tcltest::cleanupTests return } destroy .t.c .t.c2 -test color-1.1 {Tk_GetColor procedure} { - c255 [winfo rgb .t red] +test color-1.1 {Tk_AllocColorFromObj - converting internal reps} { + set x green + lindex $x 0 + destroy .b1 + button .b1 -foreground $x -text .b1 + lindex $x 0 + testcolor green +} {{1 0}} +test color-1.2 {Tk_AllocColorFromObj - discard stale color} { + set x green + destroy .b1 .b2 + button .b1 -foreground $x -text First + destroy .b1 + set result {} + lappend result [testcolor green] + button .b2 -foreground $x -text Second + lappend result [testcolor green] +} {{} {{1 1}}} +test color-1.3 {Tk_AllocColorFromObj - reuse existing color} { + set x green + destroy .b1 .b2 + button .b1 -foreground $x -text First + set result {} + lappend result [testcolor green] + button .b2 -foreground $x -text Second + pack .b1 .b2 -side top + lappend result [testcolor green] +} {{{1 1}} {{2 1}}} +test color-1.4 {Tk_AllocColorFromObj - try other colors in list} { + set x purple + destroy .b1 .b2 .t.b + button .b1 -foreground $x -text First + pack .b1 -side top + set result {} + lappend result [testcolor purple] + button .t.b -foreground $x -text Second + pack .t.b -side top + lappend result [testcolor purple] + button .b2 -foreground $x -text Third + pack .b2 -side top + lappend result [testcolor purple] +} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} + +test color-2.1 {Tk_GetColor procedure} { + c255 [winfo rgb .t #FF0000] } {255 0 0} -test color-1.2 {Tk_GetColor procedure} { +test color-2.2 {Tk_GetColor procedure} { list [catch {winfo rgb .t noname} msg] $msg } {1 {unknown color name "noname"}} - -test color-1.3 {Tk_GetColor procedure} { +test color-2.3 {Tk_GetColor procedure} { c255 [winfo rgb .t #123456] } {18 52 86} -test color-1.4 {Tk_GetColor procedure} { +test color-2.4 {Tk_GetColor procedure} { list [catch {winfo rgb .t #xyz} msg] $msg } {1 {invalid color name "#xyz"}} -test color-2.1 {Tk_FreeColor procedure, reference counting} { +test color-3.1 {Tk_FreeColor procedure, reference counting} { eval destroy [winfo child .t] mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40 pack .t.c @@ -153,7 +204,7 @@ test color-2.1 {Tk_FreeColor procedure, reference counting} { .t.c2 delete $last lappend result [colorsFree .t] } {0 1} -test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} { +test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} { eval destroy [winfo child .t] mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40 pack .t.c @@ -163,5 +214,86 @@ test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} { update closest .t 241 241 1 } {240 240 0} +test color-3.3 {Tk_FreeColorFromObj - reference counts} { + set x purple + destroy .b1 .b2 .t.b + button .b1 -foreground $x -text First + pack .b1 -side top + button .t.b -foreground $x -text Second + pack .t.b -side top + button .b2 -foreground $x -text Third + pack .b2 -side top + set result {} + lappend result [testcolor purple] + destroy .b1 + lappend result [testcolor purple] + destroy .b2 + lappend result [testcolor purple] + destroy .t.b + lappend result [testcolor purple] +} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} +test color-3.4 {Tk_FreeColorFromObj - unlinking from list} { + destroy .b .t.b .t2 .t3 + toplevel .t2 -visual {pseudocolor 8} -colormap new + toplevel .t3 -visual {pseudocolor 8} -colormap new + set x purple + button .b -foreground $x -text .b1 + button .t.b1 -foreground $x -text .t.b1 + button .t.b2 -foreground $x -text .t.b2 + button .t2.b1 -foreground $x -text .t2.b1 + button .t2.b2 -foreground $x -text .t2.b2 + button .t2.b3 -foreground $x -text .t2.b3 + button .t3.b1 -foreground $x -text .t3.b1 + button .t3.b2 -foreground $x -text .t3.b2 + button .t3.b3 -foreground $x -text .t3.b3 + button .t3.b4 -foreground $x -text .t3.b4 + set result {} + lappend result [testcolor purple] + destroy .t2 + lappend result [testcolor purple] + destroy .b + lappend result [testcolor purple] + destroy .t3 + lappend result [testcolor purple] + destroy .t + lappend result [testcolor purple] +} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} + +test color-4.1 {FreeColorObjProc} { + destroy .b + set x [format purple] + button .b -foreground $x -text .b1 + set y [format purple] + .b configure -foreground $y + set z [format purple] + .b configure -foreground $z + set result {} + lappend result [testcolor purple] + set x red + lappend result [testcolor purple] + set z 32 + lappend result [testcolor purple] + destroy .b + lappend result [testcolor purple] + set y bogus + set result +} {{{1 3}} {{1 2}} {{1 1}} {}} destroy .t + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/config.test b/tests/config.test new file mode 100644 index 0000000..8fdbbd7 --- /dev/null +++ b/tests/config.test @@ -0,0 +1,839 @@ +# This file is a Tcl script to test the procedures in tkConfig.c, +# which comprise the new new option configuration system. It is +# organized in the standard "white-box" fashion for Tcl tests. +# +# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: config.test,v 1.2 1999/04/16 01:51:36 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {[info command testobjconfig] != "testobjconfig"} { + puts "This application hasn't been compiled with the \"testobjconfig\"" + puts "command, so I can't run this test. Are you sure you're using" + puts "tktest instead of wish?" + ::tcltest::cleanupTests + return +} + +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 + } + } +} + +foreach i [winfo children .] { + destroy $i +} +killTables +wm geometry . {} +raise . + +test config-1.1 {Tk_CreateOptionTable - reference counts} { + eval destroy [winfo children .] + killTables + set x {} + testobjconfig alltypes .a + lappend x [testobjconfig info alltypes] + testobjconfig alltypes .b + lappend x [testobjconfig info alltypes] + eval destroy [winfo children .] + set x +} {{1 15 -boolean} {2 15 -boolean}} +test config-1.2 {Tk_CreateOptionTable - synonym initialization} { + eval destroy [winfo children .] + testobjconfig alltypes .a -synonym green + .a cget -color +} {green} +test config-1.3 {Tk_CreateOptionTable - option database initialization} { + eval destroy [winfo children .] + option clear + 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} { + eval destroy [winfo children .] + option clear + 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} { + eval destroy [winfo children .] + testobjconfig alltypes .a + .a cget -relief +} {raised} +test config-1.6 {Tk_CreateOptionTable - chained tables} { + eval destroy [winfo children .] + killTables + testobjconfig chain1 .a + testobjconfig chain2 .b + testobjconfig info chain2 +} {1 4 -three 2 2 -one} +test config-1.7 {Tk_CreateOptionTable - chained tables} { + eval destroy [winfo children .] + killTables + testobjconfig chain2 .b + testobjconfig chain1 .a + testobjconfig info chain2 +} {1 4 -three 2 2 -one} +test config-1.8 {Tk_CreateOptionTable - chained tables} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + killTables + testobjconfig chain1 .a + testobjconfig chain2 .b + testobjconfig chain2 .c + eval destroy [winfo children .] + set x {} + testobjconfig delete chain2 + 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}} + +# No tests for DestroyOptionHashTable; couldn't figure out how to test. + +test config-3.1 {Tk_InitOptions - priority of chained tables} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + option clear + option add *a.color blue + testobjconfig alltypes .a + list [.a cget -color] +} {blue} +test config-3.3 {Tk_InitOptions - initialize from database} { + eval destroy [winfo children .] + option clear + option add *a.justify bogus + testobjconfig alltypes .a + list [.a cget -justify] +} {left} +test config-3.4 {Tk_InitOptions - initialize from widget class} { + eval destroy [winfo children .] + testobjconfig alltypes .a + list [.a cget -color] +} {red} +test config-3.5 {Tk_InitOptions - no initial value} { + eval destroy [winfo children .] + testobjconfig alltypes .a + .a cget -anchor +} {} +test config-3.6 {Tk_InitOptions - bad initial value} { + eval destroy [winfo children .] + option clear + 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" + (database entry for "-color" in widget ".a") + invoked from within +"testobjconfig alltypes .a"}} +option clear +test config-3.7 {Tk_InitOptions - bad initial value} { + eval destroy [winfo children .] + list [catch {testobjconfig configerror} msg] $msg $errorInfo +} {1 {expected integer but got "bogus"} {expected integer but got "bogus" + (default value for "-int") + invoked from within +"testobjconfig configerror"}} +option clear + +test config-4.1 {DoObjConfig - boolean} { + 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} { + 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} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -boolean 0 + .foo cget -boolean +} {0} +test config-4.5 {DoObjConfig - integer} { + 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} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -integer 421 + .foo cget -integer +} {421} +test config-4.8 {DoObjConfig - double} { + 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} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -double 62.75 + .foo cget -double +} {62.75} +test config-4.11 {DoObjConfig - string} { + 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} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -string "this is a test" + .foo cget -string +} {this is a test} +test config-4.14 {DoObjConfig - string table} { + 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} { + 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} { + catch {destroy .foo} + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -stringtable "four" + .foo cget -stringtable +} {four} +test config-4.18 {DoObjConfig - color} { + 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} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -color purple + .foo cget -color +} {purple} +test config-4.21 {DoObjConfig - null color} { + 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} { + catch {destroy .foo} + 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} { + 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} { + catch {rename .foo {}} + 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} { + 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} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -font {Times 16} + .foo cget -font +} {Times 16} +test config-4.28 {DoObjConfig - bitmap} { + 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} { + catch {destroy .foo} + 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} { + catch {destroy .foo} + list [catch {testobjconfig alltypes .foo -bitmap foo} msg] $msg +} {1 {bitmap "foo" not defined}} +test config-4.31 {DoObjConfig - null bitmap} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -bitmap gray25 + .foo cget -bitmap +} {gray25} +test config-4.33 {DoObjConfig - border} { + 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} { + catch {destroy .foo} + list [catch {testobjconfig alltypes .foo -border xxx} msg] $msg +} {1 {unknown color name "xxx"}} +test config-4.35 {DoObjConfig - null border} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -border #123456 + .foo cget -border +} {#123456} +test config-4.37 {DoObjConfig - getting rid of old border} { + catch {destroy .foo} + 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} { + 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} { + 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} { + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -relief ridge + .foo cget -relief +} {ridge} +test config-4.42 {DoObjConfig - cursor} { + 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} { + catch {destroy .foo} + list [catch {testobjconfig alltypes .foo -cursor foo} msg] $msg +} {1 {bad cursor spec "foo"}} +test config-4.44 {DoObjConfig - null cursor} { + 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} { + catch {destroy .foo} + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -cursor watch + .foo cget -cursor +} {watch} +test config-4.47 {DoObjConfig - justify} { + 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} { + 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} { + catch {destroy .foo} + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -justify center + .foo cget -justify +} {center} +test config-4.51 {DoObjConfig - anchor} { + 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} { + 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} { + catch {destroy .foo} + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -anchor sw + .foo cget -anchor +} {sw} +test config-4.55 {DoObjConfig - pixel} { + 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} { + catch {destroy .foo} + list [catch {testobjconfig alltypes .foo -pixel foo} msg] $msg +} {1 {bad screen distance "foo"}} +test config-4.57 {DoObjConfig - new pixel} { + catch {destroy .foo} + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -pixel [winfo screenmmwidth .]m + .foo cget -pixel +} [winfo screenwidth .] +test config-4.59 {DoObjConfig - window} { + catch {destroy .foo} + catch {destroy .bar} + 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} { + catch {destroy .foo} + 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} { + catch {destroy .foo} + catch {destroy .bar} + 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} { + catch {destroy .foo} + catch {destroy .bar} + catch {destroy .blamph} + 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} { + catch {rename .foo {}} + testobjconfig internal .foo -window . + .foo cget -window +} {.} +test config-4.64 {DoObjConfig - releasing old values} { + # 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 + .foo configure -string {new string} -color brown \ + -font {Times 8} -bitmap gray75 -border pink -cursor watch + concat {} +} {} +test config-4.65 {DoObjConfig - releasing old values} { + # 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 + .foo configure -string {new string} -color brown \ + -font {Times 8} -bitmap gray75 -border pink -cursor watch + concat {} +} {} + +test config-5.1 {ObjectIsEmpty - object is already string} { + catch {destroy .foo} + testobjconfig alltypes .foo -color [format ""] + .foo cget -color +} {} +test config-5.2 {ObjectIsEmpty - object is already string} { + 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} { + catch {destroy .foo} + testobjconfig alltypes .foo -color [list] + .foo cget -color +} {} + +eval destroy [winfo children .] +testobjconfig chain2 .a +testobjconfig alltypes .b +test config-6.1 {GetOptionFromObj - cached answer} { + list [.a cget -three] [.a cget -three] +} {three three} +test config-6.2 {GetOptionFromObj - exact match} { + .a cget -one +} {one} +test config-6.3 {GetOptionFromObj - abbreviation} { + .a cget -fo +} {four} +test config-6.4 {GetOptionFromObj - ambiguous abbreviation} { + list [catch {.a cget -on} msg] $msg +} {1 {unknown option "-on"}} +test config-6.5 {GetOptionFromObj - duplicate options in different tables} { + .a cget -tw +} {two and a half} +test config-6.6 {GetOptionFromObj - synonym} { + .b cget -synonym +} {red} + +eval destroy [winfo children .] +testobjconfig alltypes .a +test config-7.1 {Tk_SetOptions - basics} { + .a configure -color green -rel sunken + list [.a cget -color] [.a cget -relief] +} {green sunken} +test config-7.2 {Tk_SetOptions - bogus option name} { + list [catch {.a configure -bogus} msg] $msg +} {1 {unknown option "-bogus"}} +test config-7.3 {Tk_SetOptions - synonym} { + .a configure -synonym blue + .a cget -color +} {blue} +test config-7.4 {Tk_SetOptions - missing value} { + 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} { + .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} { + list [catch {.a configure -color bogus} msg] $msg $errorInfo +} {1 {unknown color name "bogus"} {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} { + list [catch {.a configure -synonym bogus} msg] $msg $errorInfo +} {1 {unknown color name "bogus"} {unknown color name "bogus" + (processing "-synonym" option) + invoked from within +".a configure -synonym bogus"}} +test config-7.8 {Tk_SetOptions - returning mask} { + format %x [.a configure -color red -int 7 -relief raised -double 3.14159] +} {226} + +test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} {nonPortable} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + 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} { + eval destroy [winfo children .] + testobjconfig internal .a -window .a + list [catch {.a csave -window .a -color bogus}] [.a cget -window] +} {1 .a} + +# 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} { + catch {destroy .foo} + testobjconfig internal .foo + .foo configure -string "two words" + destroy .foo +} {} +test config-9.2 {Tk_FreeConfigOptions/FreeResources - color internal form} { + catch {destroy .foo} + testobjconfig internal .foo + .foo configure -color yellow + destroy .foo +} {} +test config-9.3 {Tk_FreeConfigOptions/FreeResources - color} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -color [format blue] + destroy .foo +} {} +test config-9.4 {Tk_FreeConfigOptions/FreeResources - font internal form} { + catch {destroy .foo} + testobjconfig internal .foo + .foo configure -font {Courier 20} + destroy .foo +} {} +test config-9.5 {Tk_FreeConfigOptions/FreeResources - font} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -font [format {Courier 24}] + destroy .foo +} {} +test config-9.6 {Tk_FreeConfigOptions/FreeResources - bitmap internal form} { + catch {destroy .foo} + testobjconfig internal .foo + .foo configure -bitmap gray75 + destroy .foo +} {} +test config-9.7 {Tk_FreeConfigOptions/FreeResources - bitmap} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -bitmap [format gray75] + destroy .foo +} {} +test config-9.8 {Tk_FreeConfigOptions/FreeResources - border internal form} { + catch {destroy .foo} + testobjconfig internal .foo + .foo configure -border orange + destroy .foo +} {} +test config-9.9 {Tk_FreeConfigOptions/FreeResources - border} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -border [format blue] + destroy .foo +} {} +test config-9.10 {Tk_FreeConfigOptions/FreeResources - cursor internal form} { + catch {destroy .foo} + testobjconfig internal .foo + .foo configure -cursor cross + destroy .foo +} {} +test config-9.11 {Tk_FreeConfigOptions/FreeResources - cursor} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -cursor [format watch] + destroy .foo +} {} +test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -integer [format 27] + destroy .foo +} {} + +test config-10.1 {Tk_GetOptionInfo - one item} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -relief groove + .foo configure -relief +} {-relief relief Relief raised groove} +test config-10.2 {Tk_GetOptionInfo - one item, synonym} { + catch {destroy .foo} + testobjconfig alltypes .foo + .foo configure -color black + .foo configure -synonym +} {-color color Color red black} +test config-10.3 {Tk_GetOptionInfo - all items} { + catch {destroy .foo} + 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} {-synonym -color}} +test config-10.4 {Tk_GetOptionInfo - chaining through tables} { + catch {destroy .foo} + 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}}} + +eval destroy [winfo children .] +testobjconfig alltypes .a +test config-11.1 {GetConfigList - synonym} { + lindex [.a configure] end +} {-synonym -color} +test config-11.2 {GetConfigList - null database names} { + .a configure -justify +} {-justify {} {} left left} +test config-11.3 {GetConfigList - null default and current value} { + .a configure -anchor +} {-anchor anchor Anchor {} {}} + +eval destroy [winfo children .] +testobjconfig internal .a +test config-12.1 {GetObjectForOption - boolean} { + .a configure -boolean 0 + .a cget -boolean +} {0} +test config-12.2 {GetObjectForOption - integer} { + .a configure -integer 1247 + .a cget -integer +} {1247} +test config-12.3 {GetObjectForOption - double} { + .a configure -double -88.82 + .a cget -double +} {-88.82} +test config-12.4 {GetObjectForOption - string} { + .a configure -string "test value" + .a cget -string +} {test value} +test config-12.5 {GetObjectForOption - stringTable} { + .a configure -stringtable "two" + .a cget -stringtable +} {two} +test config-12.6 {GetObjectForOption - color} { + .a configure -color "green" + .a cget -color +} {green} +test config-12.7 {GetObjectForOption - font} { + .a configure -font {Times 36} + .a cget -font +} {Times 36} +test config-12.8 {GetObjectForOption - bitmap} { + .a configure -bitmap "questhead" + .a cget -bitmap +} {questhead} +test config-12.9 {GetObjectForOption - border} { + .a configure -border #33217c + .a cget -border +} {#33217c} +test config-12.10 {GetObjectForOption - relief} { + .a configure -relief groove + .a cget -relief +} {groove} +test config-12.11 {GetObjectForOption - cursor} { + .a configure -cursor watch + .a cget -cursor +} {watch} +test config-12.12 {GetObjectForOption - justify} { + .a configure -justify right + .a cget -justify +} {right} +test config-12.13 {GetObjectForOption - anchor} { + .a configure -anchor e + .a cget -anchor +} {e} +test config-12.14 {GetObjectForOption - pixels} { + .a configure -pixel 193.2 + .a cget -pixel +} {193} +test config-12.15 {GetObjectForOption - window} { + .a configure -window .a + .a cget -window +} {.a} +test config-12.16 {GetObjectForOption - null values} { + .a configure -string {} -color {} -font {} -bitmap {} -border {} \ + -cursor {} -window {} + list [.a cget -string] [.a cget -color] [.a cget -font] \ + [.a cget -string] [.a cget -bitmap] [.a cget -border] \ + [.a cget -cursor] [.a cget -window] +} {{} {} {} {} {} {} {} {}} + +# cleanup +eval destroy [winfo children .] +killTables +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/cursor.test b/tests/cursor.test new file mode 100644 index 0000000..bb01561 --- /dev/null +++ b/tests/cursor.test @@ -0,0 +1,116 @@ +# This file is a Tcl script to test out the procedures in the file +# tkCursor.c. It is organized in the standard white-box fashion for +# Tcl tests. +# +# Copyright (c) 1998 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: cursor.test,v 1.2 1999/04/16 01:51:36 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {[info commands testcursor] != "testcursor"} { + puts "testcursor command not available; skipping tests" + ::tcltest::cleanupTests + return +} + +eval destroy [winfo children .] +wm geometry . {} +raise . + +test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} { + set x watch + lindex $x 0 + destroy .b1 + button .b1 -cursor $x + lindex $x 0 + testcursor watch +} {{1 0}} +test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} { + set x watch + destroy .b1 .b2 + 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} { + set x watch + destroy .b1 .b2 + button .b1 -cursor $x + set result {} + lappend result [testcursor watch] + button .b2 -cursor $x + pack .b1 .b2 -side top + lappend result [testcursor watch] +} {{{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"}} + +test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} { + set x arrow + destroy .b1 .b2 .b3 + button .b1 -cursor $x + button .b3 -cursor $x + button .b2 -cursor $x + set result {} + lappend result [testcursor arrow] + destroy .b1 + lappend result [testcursor arrow] + destroy .b2 + lappend result [testcursor arrow] + destroy .b3 + lappend result [testcursor arrow] +} {{{3 1}} {{2 1}} {{1 1}} {}} + +test cursor-4.1 {FreeCursorObjProc} { + destroy .b + set x [format arrow] + button .b -cursor $x + set y [format arrow] + .b configure -cursor $y + set z [format arrow] + .b configure -cursor $z + set result {} + lappend result [testcursor arrow] + set x red + lappend result [testcursor arrow] + set z 32 + lappend result [testcursor arrow] + destroy .b + lappend result [testcursor arrow] + set y bogus + set result +} {{{1 3}} {{1 2}} {{1 1}} {}} + +destroy .t + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/defs b/tests/defs deleted file mode 100644 index a7037ee..0000000 --- a/tests/defs +++ /dev/null @@ -1,372 +0,0 @@ -# This file contains support code for the Tcl test suite. It is -# normally sourced by the individual files in the test suite before -# they run their tests. This improved approach to testing was designed -# and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems. -# -# Copyright (c) 1994-1997 Sun Microsystems, Inc. -# Copyright (c) 1998 by Scriptics Corporation -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: defs,v 1.4 1999/04/16 01:25:55 stanton Exp $ - -if {![info exists VERBOSE]} { - set VERBOSE 0 -} -if {![info exists TESTS]} { - set TESTS {} -} - -tk appname tktest -wm title . tktest - -# Check configuration information that will determine which tests -# to run. To do this, create an array testConfig. Each element -# has a 0 or 1 value, and the following elements are defined: -# unixOnly - 1 means this is a UNIX platform, so it's OK -# to run tests that only work under UNIX. -# macOnly - 1 means this is a Mac platform, so it's OK -# to run tests that only work on Macs. -# pcOnly - 1 means this is a PC platform, so it's OK to -# run tests that only work on PCs. -# unixOrPc - 1 means this is a UNIX or PC platform. -# macOrPc - 1 means this is a Mac or PC platform. -# macOrUnix - 1 means this is a Mac or UNIX platform. -# nonPortable - 1 means this the tests are being running in -# the master Tcl/Tk development environment; -# Some tests are inherently non-portable because -# they depend on things like word length, file system -# configuration, window manager, etc. These tests -# are only run in the main Tcl development directory -# where the configuration is well known. The presence -# of the file "doAllTests" in this directory indicates -# that it is safe to run non-portable tests. -# fonts - 1 means that this platform uses fonts with -# well-know geometries, so it is safe to run -# tests that depend on particular font sizes. - -catch {unset testConfig} - -set testConfig(unixOnly) [expr {$tcl_platform(platform) == "unix"}] -set testConfig(macOnly) [expr {$tcl_platform(platform) == "macintosh"}] -set testConfig(pcOnly) [expr {$tcl_platform(platform) == "windows"}] - -set testConfig(unix) $testConfig(unixOnly) -set testConfig(mac) $testConfig(macOnly) -set testConfig(pc) $testConfig(pcOnly) - -set testConfig(unixOrPc) [expr {$testConfig(unixOnly) || $testConfig(pcOnly)}] -set testConfig(macOrPc) [expr {$testConfig(macOnly) || $testConfig(pcOnly)}] -set testConfig(macOrUnix) [expr {$testConfig(macOnly) || $testConfig(unixOnly)}] - -set testConfig(nonPortable) [expr {[file exists doAllTests] || [file exists DOALLT~1]}] - -set testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}] -set testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}] -set testConfig(win32s) [expr {$tcl_platform(os) == "Win32s"}] - -# The following config switches are used to mark tests that should work, -# but have been temporarily disabled on certain platforms because they don't. - -set testConfig(tempNotPc) [expr {!$testConfig(pc)}] -set testConfig(tempNotMac) [expr {!$testConfig(mac)}] -set testConfig(tempNotUnix) [expr {!$testConfig(unix)}] - -# The following config switches are used to mark tests that crash on -# certain platforms, so that they can be reactivated again when the -# underlying problem is fixed. - -set testConfig(pcCrash) [expr {!$testConfig(pc)}] -set testConfig(win32sCrash) [expr {!$testConfig(win32s)}] -set testConfig(macCrash) [expr {!$testConfig(mac)}] -set testConfig(unixCrash) [expr {!$testConfig(unix)}] - -set testConfig(fonts) 1 -catch {destroy .e} -entry .e -width 0 -font {Helvetica -12} -bd 1 -.e insert end "a.bcd" -if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} { - set testConfig(fonts) 0 -} -destroy .e .t -text .t -width 80 -height 20 -font {Times -14} -bd 1 -pack .t -.t insert end "This is\na dot." -update -set x [list [.t bbox 1.3] [.t bbox 2.5]] -destroy .t -if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} { - set testConfig(fonts) 0 -} - -if {$testConfig(nonPortable) == 0} { - puts stdout "(will skip non-portable tests)" -} -if {$testConfig(fonts) == 0} { - puts stdout "(will skip font-sensitive tests: this system has unexpected font geometries)" -} - -trace variable testConfig r safeFetch - -proc safeFetch {n1 n2 op} { - global testConfig - - if {($n2 != {}) && ([info exists testConfig($n2)] == 0)} { - set testConfig($n2) 0 - } -} - -# If there is no "memory" command (because memory debugging isn't -# enabled), generate a dummy command that does nothing. - -if {[info commands memory] == ""} { - proc memory args {} -} - -proc print_verbose {name description script code answer} { - puts stdout "\n" - puts stdout "==== $name $description" - puts stdout "==== Contents of test case:" - puts stdout "$script" - if {$code != 0} { - if {$code == 1} { - puts stdout "==== Test generated error:" - puts stdout $answer - } elseif {$code == 2} { - puts stdout "==== Test generated return exception; result was:" - puts stdout $answer - } elseif {$code == 3} { - puts stdout "==== Test generated break exception" - } elseif {$code == 4} { - puts stdout "==== Test generated continue exception" - } else { - puts stdout "==== Test generated exception $code; message was:" - puts stdout $answer - } - } else { - puts stdout "==== Result was:" - puts stdout "$answer" - } -} - -# test -- -# This procedure runs a test and prints an error message if the -# test fails. If VERBOSE has been set, it also prints a message -# even if the test succeeds. The test will be skipped if it -# doesn't match the TESTS variable, or if one of the elements -# of "constraints" turns out not to be true. -# -# Arguments: -# name - Name of test, in the form foo-1.2. -# description - Short textual description of the test, to -# help humans understand what it does. -# constraints - A list of one or more keywords, each of -# which must be the name of an element in -# the array "testConfig". If any of these -# elements is zero, the test is skipped. -# This argument may be omitted. -# script - Script to run to carry out the test. It must -# return a result that can be checked for -# correctness. -# answer - Expected result from script. - -proc test {name description script answer args} { - global VERBOSE TESTS testConfig - if {[string compare $TESTS ""] != 0} { - set ok 0 - foreach test $TESTS { - if {[string match $test $name]} { - set ok 1 - break - } - } - if {!$ok} { - return - } - } - set i [llength $args] - if {$i == 0} { - # Empty body - } elseif {$i == 1} { - # "constraints" argument exists; shuffle arguments down, then - # make sure that the constraints are satisfied. - - set constraints $script - set script $answer - set answer [lindex $args 0] - set doTest 0 - if {[string match {*[$\[]*} $constraints] != 0} { - # full expression, e.g. {$foo > [info tclversion]} - - catch {set doTest [uplevel #0 expr $constraints]} - } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} { - # something like {a || b} should be turned into - # $testConfig(a) || $testConfig(b). - - regsub -all {[.a-zA-Z0-9]+} $constraints {$testConfig(&)} c - catch {set doTest [eval expr $c]} - } else { - # just simple constraints such as {unixOnly fonts}. - - set doTest 1 - foreach constraint $constraints { - if {![info exists testConfig($constraint)] - || !$testConfig($constraint)} { - set doTest 0 - break - } - } - } - if {$doTest == 0} { - if {$VERBOSE} { - puts stdout "++++ $name SKIPPED: $constraints" - } - return - } - } else { - error "wrong # args: must be \"test name description ?constraints? script answer\"" - } - memory tag $name - set code [catch {uplevel $script} result] - if {$code != 0} { - print_verbose $name $description $script $code $result - } elseif {[string compare $result $answer] == 0} { - if {$VERBOSE} { - if {$VERBOSE > 0} { - print_verbose $name $description $script $code $result - } - if {$VERBOSE != -2} { - puts stdout "++++ $name PASSED" - } - } - } else { - print_verbose $name $description $script $code $result - puts stdout "---- Result should have been:" - puts stdout "$answer" - puts stdout "---- $name FAILED" - } - if {[string compare $::tcl_platform(platform) macintosh] == 0} { - # Force the text to be drawn even if the tests are not updating. - update idletasks - } -} - -proc dotests {file args} { - global TESTS - set savedTests $TESTS - set TESTS $args - source $file - set TESTS $savedTests -} - -# If the main window isn't already mapped (e.g. because the tests are -# being run automatically) , specify a precise size for it so that the -# user won't have to position it manually. - -if {![winfo ismapped .]} { - wm geometry . +0+0 - update -} - -# The following code can be used to perform tests involving a second -# process running in the background. - -# Locate tktest executable - -set tktest [info nameofexecutable] -if {$tktest == "{}"} { - set tktest {} - puts stdout "Unable to find tktest executable, skipping multiple process tests." -} - -# Create background process - -proc setupbg args { - global tktest fd bgData - if {$tktest == ""} { - error "you're not running tktest so setupbg should not have been called" - } - if {[info exists fd] && ($fd != "")} { - cleanupbg - } - set fd [open "|[list $tktest -geometry +0+0 -name tktest] $args" r+] - puts $fd "puts foo; flush stdout" - flush $fd - if {[gets $fd data] < 0} { - error "unexpected EOF from \"$tktest\"" - } - if {[string compare $data foo]} { - error "unexpected output from background process \"$data\"" - } - fileevent $fd readable bgReady -} - -# Send a command to the background process, catching errors and -# flushing I/O channels -proc dobg {command} { - global fd bgData bgDone - puts $fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout" - flush $fd - set bgDone 0 - set bgData {} - tkwait variable bgDone - set bgData -} - -# Data arrived from background process. Check for special marker -# indicating end of data for this command, and make data available -# to dobg procedure. -proc bgReady {} { - global fd bgData bgDone - set x [gets $fd] - if {[eof $fd]} { - fileevent $fd readable {} - set bgDone 1 - } elseif {$x == "**DONE**"} { - set bgDone 1 - } else { - append bgData $x - } -} - -# Exit the background process, and close the pipes -proc cleanupbg {} { - global fd - catch { - puts $fd "exit" - close $fd - } - set fd "" -} - -# Clean up focus after using generate event, which -# can leave the window manager with the wrong impression -# about who thinks they have the focus. (BW) - -proc fixfocus {} { - catch {destroy .focus} - toplevel .focus - wm geometry .focus +0+0 - entry .focus.e - .focus.e insert 0 "fixfocus" - pack .focus.e - update - focus -force .focus.e - destroy .focus -} - -proc makeFile {contents name} { - set fd [open $name w] - fconfigure $fd -translation lf - if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} { - puts -nonewline $fd $contents - } else { - puts $fd $contents - } - close $fd -} - -proc removeFile {name} { - file delete -- $name -} diff --git a/tests/defs.tcl b/tests/defs.tcl new file mode 100644 index 0000000..40e147d --- /dev/null +++ b/tests/defs.tcl @@ -0,0 +1,990 @@ +# defs.tcl -- +# +# This file contains support code for the Tcl/Tk test suite.It is +# It is normally sourced by the individual files in the test suite +# before they run their tests. This improved approach to testing +# was designed and initially implemented by Mary Ann May-Pumphrey +# of Sun Microsystems. +# +# Copyright (c) 1990-1994 The Regents of the University of California. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: defs.tcl,v 1.2 1999/04/16 01:51:36 stanton Exp $ + +# Initialize wish shell +if {[info exists tk_version]} { + tk appname tktest + wm title . tktest +} else { + # Ensure that we have a minimal auto_path so we don't pick up extra junk. + set auto_path [list [info library]] +} + +# create the "tcltest" namespace for all testing variables and procedures +namespace eval tcltest { + set procList [list test cleanupTests dotests saveState restoreState \ + normalizeMsg makeFile removeFile makeDirectory removeDirectory \ + viewFile bytestring set_iso8859_1_locale restore_locale \ + safeFetch] + if {[info exists tk_version]} { + lappend procList setupbg dobg bgReady cleanupbg fixfocus + } + foreach proc $procList { + namespace export $proc + } + + # ::tcltest::verbose defaults to "b" + variable verbose "b" + + # match defaults to the empty list + variable match {} + + # skip defaults to the empty list + variable skip {} + + # Tests should not rely on the current working directory. + # Files that are part of the test suite should be accessed relative to + # ::tcltest::testsDir. + + set originalDir [pwd] + set tDir [file join $originalDir [file dirname [info script]]] + cd $tDir + variable testsDir [pwd] + cd $originalDir + + # Count the number of files tested (0 if all.tcl wasn't called). + # The all.tcl file will set testSingleFile to false, so stats will + # not be printed until all.tcl calls the cleanupTests proc. + # The currentFailure var stores the boolean value of whether the + # current test file has had any failures. The failFiles list + # stores the names of test files that had failures. + + variable numTestFiles 0 + variable testSingleFile true + variable currentFailure false + variable failFiles {} + + # Tests should remove all files they create. The test suite will + # check the current working dir for files created by the tests. + # ::tcltest::filesMade keeps track of such files created using the + # ::tcltest::makeFile and ::tcltest::makeDirectory procedures. + # ::tcltest::filesExisted stores the names of pre-existing files. + + variable filesMade {} + variable filesExisted {} + + # ::tcltest::numTests will store test files as indices and the list + # of files (that should not have been) left behind by the test files. + array set ::tcltest::createdNewFiles {} + + # initialize ::tcltest::numTests array to keep track fo the number of + # tests that pass, fial, and are skipped. + array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0] + + # initialize ::tcltest::skippedBecause array to keep track of + # constraints that kept tests from running + array set ::tcltest::skippedBecause {} +} + +# If there is no "memory" command (because memory debugging isn't +# enabled), generate a dummy command that does nothing. + +if {[info commands memory] == ""} { + proc memory args {} +} + +# ::tcltest::initConfig -- +# +# Check configuration information that will determine which tests +# to run. To do this, create an array ::tcltest::testConfig. Each +# element has a 0 or 1 value. If the element is "true" then tests +# with that constraint will be run, otherwise tests with that constraint +# will be skipped. See the README file for the list of built-in +# constraints defined in this procedure. +# +# Arguments: +# none +# +# Results: +# The ::tcltest::testConfig array is reset to have an index for +# each built-in test constraint. + +proc ::tcltest::initConfig {} { + + global tcl_platform tcl_interactive tk_version + + catch {unset ::tcltest::testConfig} + + # The following trace procedure makes it so that we can safely refer to + # non-existent members of the ::tcltest::testConfig array without causing an + # error. Instead, reading a non-existent member will return 0. This is + # necessary because tests are allowed to use constraint "X" without ensuring + # that ::tcltest::testConfig("X") is defined. + + trace variable ::tcltest::testConfig r ::tcltest::safeFetch + + proc ::tcltest::safeFetch {n1 n2 op} { + if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} { + set ::tcltest::testConfig($n2) 0 + } + } + + set ::tcltest::testConfig(unixOnly) \ + [expr {$tcl_platform(platform) == "unix"}] + set ::tcltest::testConfig(macOnly) \ + [expr {$tcl_platform(platform) == "macintosh"}] + set ::tcltest::testConfig(pcOnly) \ + [expr {$tcl_platform(platform) == "windows"}] + + set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly) + set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly) + set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly) + + set ::tcltest::testConfig(unixOrPc) \ + [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}] + set ::tcltest::testConfig(macOrPc) \ + [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(pc)}] + set ::tcltest::testConfig(macOrUnix) \ + [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(unix)}] + + set ::tcltest::testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}] + set ::tcltest::testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}] + + # The following config switches are used to mark tests that should work, + # but have been temporarily disabled on certain platforms because they don't + # and we haven't gotten around to fixing the underlying problem. + + set ::tcltest::testConfig(tempNotPc) [expr {!$::tcltest::testConfig(pc)}] + set ::tcltest::testConfig(tempNotMac) [expr {!$::tcltest::testConfig(mac)}] + set ::tcltest::testConfig(tempNotUnix) [expr {!$::tcltest::testConfig(unix)}] + + # The following config switches are used to mark tests that crash on + # certain platforms, so that they can be reactivated again when the + # underlying problem is fixed. + + set ::tcltest::testConfig(pcCrash) [expr {!$::tcltest::testConfig(pc)}] + set ::tcltest::testConfig(macCrash) [expr {!$::tcltest::testConfig(mac)}] + set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}] + + # Set the "fonts" constraint for wish apps + if {[info exists tk_version]} { + set ::tcltest::testConfig(fonts) 1 + catch {destroy .e} + entry .e -width 0 -font {Helvetica -12} -bd 1 + .e insert end "a.bcd" + if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} { + set ::tcltest::testConfig(fonts) 0 + } + destroy .e + catch {destroy .t} + text .t -width 80 -height 20 -font {Times -14} -bd 1 + pack .t + .t insert end "This is\na dot." + update + set x [list [.t bbox 1.3] [.t bbox 2.5]] + destroy .t + if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} { + set ::tcltest::testConfig(fonts) 0 + } + } + + # Skip empty tests + set ::tcltest::testConfig(emptyTest) 0 + + # By default, tests that expost known bugs are skipped. + set ::tcltest::testConfig(knownBug) 0 + + # By default, non-portable tests are skipped. + set ::tcltest::testConfig(nonPortable) 0 + + # Some tests require user interaction. + set ::tcltest::testConfig(userInteraction) 0 + + # Some tests must be skipped if the interpreter is not in interactive mode + set ::tcltest::testConfig(interactive) $tcl_interactive + + # Some tests must be skipped if you are running as root on Unix. + # Other tests can only be run if you are running as root on Unix. + set ::tcltest::testConfig(root) 0 + set ::tcltest::testConfig(notRoot) 1 + set user {} + if {$tcl_platform(platform) == "unix"} { + catch {set user [exec whoami]} + if {$user == ""} { + catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} + } + if {($user == "root") || ($user == "")} { + set ::tcltest::testConfig(root) 1 + set ::tcltest::testConfig(notRoot) 0 + } + } + + # Set nonBlockFiles constraint: 1 means this platform supports + # setting files into nonblocking mode. + if {[catch {set f [open defs r]}]} { + set ::tcltest::testConfig(nonBlockFiles) 1 + } else { + if {[catch {fconfigure $f -blocking off}] == 0} { + set ::tcltest::testConfig(nonBlockFiles) 1 + } else { + set ::tcltest::testConfig(nonBlockFiles) 0 + } + close $f + } + + # Set asyncPipeClose constraint: 1 means this platform supports + # async flush and async close on a pipe. + # + # Test for SCO Unix - cannot run async flushing tests because a + # potential problem with select is apparently interfering. + # (Mark Diekhans). + if {$tcl_platform(platform) == "unix"} { + if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} { + set ::tcltest::testConfig(asyncPipeClose) 0 + } else { + set ::tcltest::testConfig(asyncPipeClose) 1 + } + } else { + set ::tcltest::testConfig(asyncPipeClose) 1 + } + + # Test to see if we have a broken version of sprintf with respect + # to the "e" format of floating-point numbers. + set ::tcltest::testConfig(eformat) 1 + if {[string compare "[format %g 5e-5]" "5e-05"] != 0} { + set ::tcltest::testConfig(eformat) 0 + } + + # Test to see if execed commands such as cat, echo, rm and so forth are + # present on this machine. + set ::tcltest::testConfig(unixExecs) 1 + if {$tcl_platform(platform) == "macintosh"} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ($tcl_platform(platform) == "windows")} { + if {[catch {exec cat defs}] == 1} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec echo hello}] == 1)} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec sh -c echo hello}] == 1)} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec wc defs}] == 1)} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {$::tcltest::testConfig(unixExecs) == 1} { + exec echo hello > removeMe + if {[catch {exec rm removeMe}] == 1} { + set ::tcltest::testConfig(unixExecs) 0 + } + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec sleep 1}] == 1)} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec fgrep unixExecs defs}] == 1)} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec ps}] == 1)} { + set ::tcltest::testConfig(unixExecs) 0 + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec echo abc > removeMe}] == 0) && \ + ([catch {exec chmod 644 removeMe}] == 1) && \ + ([catch {exec rm removeMe}] == 0)} { + set ::tcltest::testConfig(unixExecs) 0 + } else { + catch {exec rm -f removeMe} + } + if {($::tcltest::testConfig(unixExecs) == 1) && \ + ([catch {exec mkdir removeMe}] == 1)} { + set ::tcltest::testConfig(unixExecs) 0 + } else { + catch {exec rm -r removeMe} + } + } +} + +::tcltest::initConfig + + +# ::tcltest::processCmdLineArgs -- +# +# Use command line args to set the verbose, skip, and +# match variables. This procedure must be run after +# constraints are initialized, because some constraints can be +# overridden. +# +# Arguments: +# none +# +# Results: +# ::tcltest::verbose is set to <value> + +proc ::tcltest::processCmdLineArgs {} { + global argv + + # The "argv" var doesn't exist in some cases, so use {} + # The "argv" var doesn't exist in some cases. + if {(![info exists argv]) || ([llength $argv] < 2)} { + set flagArray {} + } else { + set flagArray $argv + } + + if {[catch {array set flag $flagArray}]} { + puts stderr "Error: odd number of command line args specified:" + puts stderr " $argv" + exit + } + + # Allow for 1-char abbreviations, where applicable (e.g., -match == -m). + # Note that -verbose cannot be abbreviated to -v in wish because it + # conflicts with the wish option -visual. + foreach arg {-verbose -match -skip -constraints} { + set abbrev [string range $arg 0 1] + if {([info exists flag($abbrev)]) && \ + ([lsearch -exact $flagArray $arg] < \ + [lsearch -exact $flagArray $abbrev])} { + set flag($arg) $flag($abbrev) + } + } + + # Set ::tcltest::workingDir to [pwd]. + # Save the names of files that already exist in ::tcltest::workingDir. + set ::tcltest::workingDir [pwd] + foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { + lappend ::tcltest::filesExisted [file tail $file] + } + + # Set ::tcltest::verbose to the arg of the -verbose flag, if given + if {[info exists flag(-verbose)]} { + set ::tcltest::verbose $flag(-verbose) + } + + # Set ::tcltest::match to the arg of the -match flag, if given + if {[info exists flag(-match)]} { + set ::tcltest::match $flag(-match) + } + + # Set ::tcltest::skip to the arg of the -skip flag, if given + if {[info exists flag(-skip)]} { + set ::tcltest::skip $flag(-skip) + } + + # Use the -constraints flag, if given, to turn on constraints that are + # turned off by default: userInteractive knownBug nonPortable. This + # code fragment must be run after constraints are initialized. + if {[info exists flag(-constraints)]} { + foreach elt $flag(-constraints) { + set ::tcltest::testConfig($elt) 1 + } + } +} + +::tcltest::processCmdLineArgs + + +# ::tcltest::cleanupTests -- +# +# Remove files and dirs created using the makeFile and makeDirectory +# commands since the last time this proc was invoked. +# +# Print the names of the files created without the makeFile command +# since the tests were invoked. +# +# Print the number tests (total, passed, failed, and skipped) since the +# tests were invoked. +# + +proc ::tcltest::cleanupTests {{calledFromAllFile 0}} { + set tail [file tail [info script]] + + # Remove files and directories created by the :tcltest::makeFile and + # ::tcltest::makeDirectory procedures. + # Record the names of files in ::tcltest::workingDir that were not + # pre-existing, and associate them with the test file that created them. + if {!$calledFromAllFile} { + + foreach file $::tcltest::filesMade { + if {[file exists $file]} { + catch {file delete -force $file} + } + } + set currentFiles {} + foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { + lappend currentFiles [file tail $file] + } + set newFiles {} + foreach file $currentFiles { + if {[lsearch -exact $::tcltest::filesExisted $file] == -1} { + lappend newFiles $file + } + } + set ::tcltest::filesExisted $currentFiles + if {[llength $newFiles] > 0} { + set ::tcltest::createdNewFiles($tail) $newFiles + } + } + + if {$calledFromAllFile || $::tcltest::testSingleFile} { + # print stats + puts -nonewline stdout "$tail:" + foreach index [list "Total" "Passed" "Skipped" "Failed"] { + puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)" + } + puts stdout "" + + # print number test files sourced + # print names of files that ran tests which failed + if {$calledFromAllFile} { + puts stdout "Sourced $::tcltest::numTestFiles Test Files." + set ::tcltest::numTestFiles 0 + if {[llength $::tcltest::failFiles] > 0} { + puts stdout "Files with failing tests: $::tcltest::failFiles" + set ::tcltest::failFiles {} + } + } + + # if any tests were skipped, print the constraints that kept them + # from running. + set constraintList [array names ::tcltest::skippedBecause] + if {[llength $constraintList] > 0} { + puts stdout "Number of tests skipped for each constraint:" + foreach constraint [lsort $constraintList] { + puts stdout \ + "\t$::tcltest::skippedBecause($constraint)\t$constraint" + unset ::tcltest::skippedBecause($constraint) + } + } + + # report the names of test files in ::tcltest::createdNewFiles, and + # reset the array to be empty. + set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]] + if {[llength $testFilesThatTurded] > 0} { + puts stdout "Warning: test files left files behind:" + foreach testFile $testFilesThatTurded { + puts "\t$testFile:\t$::tcltest::createdNewFiles($testFile)" + unset ::tcltest::createdNewFiles($testFile) + } + } + + # reset filesMade, filesExisted, and numTests + set ::tcltest::filesMade {} + foreach index [list "Total" "Passed" "Skipped" "Failed"] { + set ::tcltest::numTests($index) 0 + } + + # exit only if running Tk in non-interactive mode + global tk_version tcl_interactive + if {[info exists tk_version] && !$tcl_interactive} { + exit + } + } else { + # if we're deferring stat-reporting until all files are sourced, + # then add current file to failFile list if any tests in this file + # failed + incr ::tcltest::numTestFiles + if {($::tcltest::currentFailure) && \ + ([lsearch -exact $::tcltest::failFiles $tail] == -1)} { + lappend ::tcltest::failFiles $tail + } + set ::tcltest::currentFailure false + } +} + + +# test -- +# +# This procedure runs a test and prints an error message if the test fails. +# If ::tcltest::verbose has been set, it also prints a message even if the +# test succeeds. The test will be skipped if it doesn't match the +# ::tcltest::match variable, if it matches an element in +# ::tcltest::skip, or if one of the elements of "constraints" turns +# out not to be true. +# +# Arguments: +# name - Name of test, in the form foo-1.2. +# description - Short textual description of the test, to +# help humans understand what it does. +# constraints - A list of one or more keywords, each of +# which must be the name of an element in +# the array "::tcltest::testConfig". If any of these +# elements is zero, the test is skipped. +# This argument may be omitted. +# script - Script to run to carry out the test. It must +# return a result that can be checked for +# correctness. +# expectedAnswer - Expected result from script. + +proc ::tcltest::test {name description script expectedAnswer args} { + incr ::tcltest::numTests(Total) + + # skip the test if it's name matches an element of skip + foreach pattern $::tcltest::skip { + if {[string match $pattern $name]} { + incr ::tcltest::numTests(Skipped) + return + } + } + # skip the test if it's name doesn't match any element of match + if {[llength $::tcltest::match] > 0} { + set ok 0 + foreach pattern $::tcltest::match { + if {[string match $pattern $name]} { + set ok 1 + break + } + } + if {!$ok} { + incr ::tcltest::numTests(Skipped) + return + } + } + set i [llength $args] + if {$i == 0} { + set constraints {} + } elseif {$i == 1} { + # "constraints" argument exists; shuffle arguments down, then + # make sure that the constraints are satisfied. + + set constraints $script + set script $expectedAnswer + set expectedAnswer [lindex $args 0] + set doTest 0 + if {[string match {*[$\[]*} $constraints] != 0} { + # full expression, e.g. {$foo > [info tclversion]} + + catch {set doTest [uplevel #0 expr $constraints]} + } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} { + # something like {a || b} should be turned into + # $::tcltest::testConfig(a) || $::tcltest::testConfig(b). + + regsub -all {[.a-zA-Z0-9]+} $constraints \ + {$::tcltest::testConfig(&)} c + catch {set doTest [eval expr $c]} + } else { + # just simple constraints such as {unixOnly fonts}. + + set doTest 1 + foreach constraint $constraints { + if {![info exists ::tcltest::testConfig($constraint)] + || !$::tcltest::testConfig($constraint)} { + set doTest 0 + # store the constraint that kept the test from running + set constraints $constraint + break + } + } + } + if {$doTest == 0} { + incr ::tcltest::numTests(Skipped) + if {[string first s $::tcltest::verbose] != -1} { + puts stdout "++++ $name SKIPPED: $constraints" + } + # add the constraint to the list of constraints the kept tests + # from running + if {[info exists ::tcltest::skippedBecause($constraints)]} { + incr ::tcltest::skippedBecause($constraints) + } else { + set ::tcltest::skippedBecause($constraints) 1 + } + return + } + } else { + error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\"" + } + memory tag $name + set code [catch {uplevel $script} actualAnswer] + if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} { + incr ::tcltest::numTests(Failed) + set ::tcltest::currentFailure true + if {[string first b $::tcltest::verbose] == -1} { + set script "" + } + puts stdout "\n==== $name $description FAILED" + if {$script != ""} { + puts stdout "==== Contents of test case:" + puts stdout $script + } + if {$code != 0} { + if {$code == 1} { + puts stdout "==== Test generated error:" + puts stdout $actualAnswer + } elseif {$code == 2} { + puts stdout "==== Test generated return exception; result was:" + puts stdout $actualAnswer + } elseif {$code == 3} { + puts stdout "==== Test generated break exception" + } elseif {$code == 4} { + puts stdout "==== Test generated continue exception" + } else { + puts stdout "==== Test generated exception $code; message was:" + puts stdout $actualAnswer + } + } else { + puts stdout "---- Result was:\n$actualAnswer" + } + puts stdout "---- Result should have been:\n$expectedAnswer" + puts stdout "==== $name FAILED\n" + } else { + incr ::tcltest::numTests(Passed) + if {[string first p $::tcltest::verbose] != -1} { + puts stdout "++++ $name PASSED" + } + } +} + +# ::tcltest::dotests -- +# +# takes two arguments--the name of the test file (such +# as "parse.test"), and a pattern selecting the tests you want to +# execute. It sets ::tcltest::matching to the second argument, calls +# "source" on the file specified in the first argument, and restores +# ::tcltest::matching to its pre-call value at the end. +# +# Arguments: +# file name of tests file to source +# args pattern selecting the tests you want to execute +# +# Results: +# none + +proc ::tcltest::dotests {file args} { + set savedTests $::tcltest::match + set ::tcltest::match $args + source $file + set ::tcltest::match $savedTests +} + +proc ::tcltest::openfiles {} { + if {[catch {testchannel open} result]} { + return {} + } + return $result +} + +proc ::tcltest::leakfiles {old} { + if {[catch {testchannel open} new]} { + return {} + } + set leak {} + foreach p $new { + if {[lsearch $old $p] < 0} { + lappend leak $p + } + } + return $leak +} + +set ::tcltest::saveState {} + +proc ::tcltest::saveState {} { + uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]} +} + +proc ::tcltest::restoreState {} { + foreach p [info procs] { + if {[lsearch [lindex $::tcltest::saveState 0] $p] < 0} { + rename $p {} + } + } + foreach p [uplevel #0 {info vars}] { + if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} { + uplevel #0 "unset $p" + } + } +} + +proc ::tcltest::normalizeMsg {msg} { + regsub "\n$" [string tolower $msg] "" msg + regsub -all "\n\n" $msg "\n" msg + regsub -all "\n\}" $msg "\}" msg + return $msg +} + +# makeFile -- +# +# Create a new file with the name <name>, and write <contents> to it. +# +# If this file hasn't been created via makeFile since the last time +# cleanupTests was called, add it to the $filesMade list, so it will +# be removed by the next call to cleanupTests. +# +proc ::tcltest::makeFile {contents name} { + set fd [open $name w] + fconfigure $fd -translation lf + if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} { + puts -nonewline $fd $contents + } else { + puts $fd $contents + } + close $fd + + set fullName [file join [pwd] $name] + if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} { + lappend ::tcltest::filesMade $fullName + } +} + +proc ::tcltest::removeFile {name} { + file delete $name +} + +# makeDirectory -- +# +# Create a new dir with the name <name>. +# +# If this dir hasn't been created via makeDirectory since the last time +# cleanupTests was called, add it to the $directoriesMade list, so it will +# be removed by the next call to cleanupTests. +# +proc ::tcltest::makeDirectory {name} { + file mkdir $name + + set fullName [file join [pwd] $name] + if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} { + lappend ::tcltest::filesMade $fullName + } +} + +proc ::tcltest::removeDirectory {name} { + file delete -force $name +} + +proc ::tcltest::viewFile {name} { + global tcl_platform + if {($tcl_platform(platform) == "macintosh") || \ + ($::tcltest::testConfig(unixExecs) == 0)} { + set f [open $name] + set data [read -nonewline $f] + close $f + return $data + } else { + exec cat $name + } +} + +# +# Construct a string that consists of the requested sequence of bytes, +# as opposed to a string of properly formed UTF-8 characters. +# This allows the tester to +# 1. Create denormalized or improperly formed strings to pass to C procedures +# that are supposed to accept strings with embedded NULL bytes. +# 2. Confirm that a string result has a certain pattern of bytes, for instance +# to confirm that "\xe0\0" in a Tcl script is stored internally in +# UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80". +# +# Generally, it's a bad idea to examine the bytes in a Tcl string or to +# construct improperly formed strings in this manner, because it involves +# exposing that Tcl uses UTF-8 internally. + +proc ::tcltest::bytestring {string} { + encoding convertfrom identity $string +} + +# Locate tcltest executable + +if {![info exists tk_version]} { + set tcltest [info nameofexecutable] + + if {$tcltest == "{}"} { + set tcltest {} + } +} + +set ::tcltest::testConfig(stdio) 0 +catch { + catch {file delete -force tmp} + set f [open tmp w] + puts $f { + exit + } + close $f + + set f [open "|[list $tcltest tmp]" r] + close $f + + set ::tcltest::testConfig(stdio) 1 +} +catch {file delete -force tmp} + +# Deliberately call the socket with the wrong number of arguments. The error +# message you get will indicate whether sockets are available on this system. +catch {socket} msg +set ::tcltest::testConfig(socket) \ + [expr {$msg != "sockets are not available on this system"}] + +# +# Internationalization / ISO support procs -- dl +# +if {[info commands testlocale]==""} { + # No testlocale command, no tests... + # (it could be that we are a sub interp and we could just load + # the Tcltest package but that would interfere with tests + # that tests packages/loading in slaves...) + set ::tcltest::testConfig(hasIsoLocale) 0 +} else { + proc ::tcltest::set_iso8859_1_locale {} { + set ::tcltest::previousLocale [testlocale ctype] + testlocale ctype $::tcltest::isoLocale + } + + proc ::tcltest::restore_locale {} { + testlocale ctype $::tcltest::previousLocale + } + + if {![info exists ::tcltest::isoLocale]} { + set ::tcltest::isoLocale fr + switch $tcl_platform(platform) { + "unix" { + # Try some 'known' values for some platforms: + switch -exact -- $tcl_platform(os) { + "FreeBSD" { + set ::tcltest::isoLocale fr_FR.ISO_8859-1 + } + HP-UX { + set ::tcltest::isoLocale fr_FR.iso88591 + } + Linux - + IRIX { + set ::tcltest::isoLocale fr + } + default { + # Works on SunOS 4 and Solaris, and maybe others... + # define it to something else on your system + #if you want to test those. + set ::tcltest::isoLocale iso_8859_1 + } + } + } + "windows" { + set ::tcltest::isoLocale French + } + } + } + + set ::tcltest::testConfig(hasIsoLocale) \ + [string length [::tcltest::set_iso8859_1_locale]] + ::tcltest::restore_locale +} + +# +# procedures that are Tk specific +# +if {[info exists tk_version]} { + # If the main window isn't already mapped (e.g. because the tests are + # being run automatically) , specify a precise size for it so that the + # user won't have to position it manually. + + if {![winfo ismapped .]} { + wm geometry . +0+0 + update + } + + # The following code can be used to perform tests involving a second + # process running in the background. + + # Locate the tktest executable + + set ::tcltest::tktest [info nameofexecutable] + if {$::tcltest::tktest == "{}"} { + set ::tcltest::tktest {} + puts stdout \ + "Unable to find tktest executable, skipping multiple process tests." + } + + # Create background process + + proc ::tcltest::setupbg args { + if {$::tcltest::tktest == ""} { + error "you're not running tktest so setupbg should not have been called" + } + if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} { + cleanupbg + } + + # The following code segment cannot be run on Windows in Tk8.1b2 + # This bug is logged as a pipe bug (bugID 1495). + + global tcl_platform + if {$tcl_platform(platform) != "windows"} { + set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+] + puts $::tcltest::fd "puts foo; flush stdout" + flush $::tcltest::fd + if {[gets $::tcltest::fd data] < 0} { + error "unexpected EOF from \"$::tcltest::tktest\"" + } + if {[string compare $data foo]} { + error "unexpected output from background process \"$data\"" + } + fileevent $::tcltest::fd readable bgReady + } + } + + # Send a command to the background process, catching errors and + # flushing I/O channels + proc ::tcltest::dobg {command} { + puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout" + flush $::tcltest::fd + set ::tcltest::bgDone 0 + set ::tcltest::bgData {} + tkwait variable ::tcltest::bgDone + set ::tcltest::bgData + } + + # Data arrived from background process. Check for special marker + # indicating end of data for this command, and make data available + # to dobg procedure. + proc ::tcltest::bgReady {} { + set x [gets $::tcltest::fd] + if {[eof $::tcltest::fd]} { + fileevent $::tcltest::fd readable {} + set ::tcltest::bgDone 1 + } elseif {$x == "**DONE**"} { + set ::tcltest::bgDone 1 + } else { + append ::tcltest::bgData $x + } + } + + # Exit the background process, and close the pipes + proc ::tcltest::cleanupbg {} { + catch { + puts $::tcltest::fd "exit" + close $::tcltest::fd + } + set ::tcltest::fd "" + } + + # Clean up focus after using generate event, which + # can leave the window manager with the wrong impression + # about who thinks they have the focus. (BW) + + proc ::tcltest::fixfocus {} { + catch {destroy .focus} + toplevel .focus + wm geometry .focus +0+0 + entry .focus.e + .focus.e insert 0 "fixfocus" + pack .focus.e + update + focus -force .focus.e + destroy .focus + } +} + +# Need to catch the import because it fails if defs.tcl is sourced +# more than once. +catch {namespace import ::tcltest::*} +return diff --git a/tests/entry.test b/tests/entry.test index 551404c..107df62 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -3,23 +3,23 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: entry.test,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: entry.test,v 1.3 1999/04/16 01:51:37 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\"" puts "image, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -51,6 +51,7 @@ 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 @@ -74,25 +75,25 @@ foreach test { {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} {-insertontime 100 100 3.2 {expected integer but got "3.2"}} {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}} + {-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 normal normal bogus {bad state value "bogus": must be normal or disabled}} + {-state normal normal bogus {bad state "bogus": must be disabled or normal}} {-takefocus "any string" "any string" {} {}} {-textvariable i i {} {}} {-width 402 402 3p {expected integer but got "3p"}} {-xscrollcommand {Some command} {Some command} {} {}} } { set name [lindex $test 0] - test entry-1.1 {configuration options} { + test entry-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 entry-1.2 {configuration options} { + test entry-1.$i {configuration options} { list [catch {.e configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } @@ -128,6 +129,7 @@ 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 @@ -145,66 +147,106 @@ 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} {fonts} { +test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} { + # Tcl_UtfAtIndex(): no utf chars + .e delete 0 end - .e insert 0 "abcdefghijklmnop" - list [.e bbox 0] [.e bbox 1] [.e bbox end] -} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+15*$cx] 5 $cx $cy"] -test entry-3.7 {EntryWidgetCmd procedure, "cget" widget command} { + .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 + .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 + .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 + .e bbox end +} "5 5 0 $cy" +test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} { + .e delete 0 end + .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.8 {EntryWidgetCmd procedure, "cget" widget command} { +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.9 {EntryWidgetCmd procedure, "cget" widget command} { +test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} { list [catch {.e cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} -test entry-3.10 {EntryWidgetCmd procedure, "cget" widget command} { +test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} { .e configure -bd 4 .e cget -bd } {4} -test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} { +test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} { llength [.e configure] } {28} -test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} { +test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} { list [catch {.e configure -foo} msg] $msg } {1 {unknown option "-foo"}} -test entry-3.13 {EntryWidgetCmd procedure, "configure" widget command} { +test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} { .e configure -bd 4 .e configure -bg #ffffff lindex [.e configure -bd] 4 } {4} -test entry-3.14 {EntryWidgetCmd procedure, "delete" widget command} { +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.15 {EntryWidgetCmd procedure, "delete" widget command} { +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.16 {EntryWidgetCmd procedure, "delete" widget command} { +test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} { list [catch {.e delete foo} msg] $msg } {1 {bad entry index "foo"}} -test entry-3.17 {EntryWidgetCmd procedure, "delete" widget command} { +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.18 {EntryWidgetCmd procedure, "delete" widget command} { +test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e delete 2 4 .e get } {014567890} -test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} { +test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e delete 6 .e get } {0123457890} -test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} { +test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} { + # UTF + set x {} + .e delete 0 end + .e insert end "01234\u4e4e67890" + .e delete 6 + lappend x [.e get] + .e delete 0 end + .e insert end "012345\u4e4e7890" + .e delete 6 + lappend x [.e get] + .e delete 0 end + .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 .e insert end "01234567890" .e delete 6 5 .e get } {01234567890} -test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} { +test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state disabled @@ -212,49 +254,55 @@ test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} { .e configure -state normal .e get } {01234567890} -test entry-3.22 {EntryWidgetCmd procedure, "get" widget command} { +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.23 {EntryWidgetCmd procedure, "icursor" widget command} { +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.24 {EntryWidgetCmd procedure, "icursor" widget command} { +test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} { list [catch {.e icursor foo} msg] $msg } {1 {bad entry index "foo"}} -test entry-3.25 {EntryWidgetCmd procedure, "icursor" widget command} { +test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} { .e delete 0 end .e insert end "01234567890" .e icursor 4 .e index insert } {4} -test entry-3.26 {EntryWidgetCmd procedure, "index" widget command} { +test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e in} msg] $msg -} {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}} -test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} { +} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, 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.28 {EntryWidgetCmd procedure, "index" widget command} { +test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index foo} msg] $msg } {1 {bad entry index "foo"}} -test entry-3.29 {EntryWidgetCmd procedure, "index" widget command} { +test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index 0} msg] $msg } {0 0} -test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} { +test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} { + # UTF + .e delete 0 end + .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.31 {EntryWidgetCmd procedure, "insert" widget command} { +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.32 {EntryWidgetCmd procedure, "insert" widget command} { +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.33 {EntryWidgetCmd procedure, "insert" widget command} { +test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} { .e delete 0 end .e insert end "01234567890" .e insert 3 xxx .e get } {012xxx34567890} -test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} { +test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state disabled @@ -262,24 +310,24 @@ test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} { .e configure -state normal .e get } {01234567890} -test entry-3.35 {EntryWidgetCmd procedure, "insert" widget command} { +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.36 {EntryWidgetCmd procedure, "scan" widget command} { +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.37 {EntryWidgetCmd procedure, "scan" widget command} { +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.38 {EntryWidgetCmd procedure, "scan" widget command} { +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.39 {EntryWidgetCmd procedure, "scan" widget command} { +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. -test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { +test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { .e delete 0 end update .e insert end "This is quite a long string, in fact a " @@ -288,16 +336,16 @@ test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { .e scan dragto 28 .e index @0 } {2} -test entry-3.41 {EntryWidgetCmd procedure, "select" widget command} { +test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} { list [catch {.e select} msg] $msg } {1 {wrong # args: should be ".e select option ?index?"}} -test entry-3.42 {EntryWidgetCmd procedure, "select" widget command} { +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.43 {EntryWidgetCmd procedure, "select clear" widget command} { +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.44 {EntryWidgetCmd procedure, "select clear" widget command} { +test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 @@ -306,17 +354,17 @@ test entry-3.44 {EntryWidgetCmd procedure, "select clear" widget command} { .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.45 {EntryWidgetCmd procedure, "selection present" widget command} { +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.46 {EntryWidgetCmd procedure, "selection present" widget command} { +test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 .e select to 6 .e selection present } {1} -test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} { +test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 @@ -325,7 +373,7 @@ test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} { .e selection present } {1} .e configure -exportselection true -test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} { +test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 @@ -333,13 +381,13 @@ test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e selection present } {0} -test entry-3.49 {EntryWidgetCmd procedure, "selection adjust" widget command} { +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.50 {EntryWidgetCmd procedure, "selection adjust" widget command} { +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.51 {EntryWidgetCmd procedure, "selection adjust" widget command} { +test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 @@ -348,7 +396,7 @@ test entry-3.51 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e select adjust 4 selection get } {123} -test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} { +test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 @@ -357,16 +405,16 @@ test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e select adjust 2 selection get } {234} -test entry-3.53 {EntryWidgetCmd procedure, "selection from" widget command} { +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.54 {EntryWidgetCmd procedure, "selection range" widget command} { +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.55 {EntryWidgetCmd procedure, "selection range" widget command} { +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.56 {EntryWidgetCmd procedure, "selection range" widget command} { +test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 1 @@ -374,7 +422,7 @@ test entry-3.56 {EntryWidgetCmd procedure, "selection range" widget command} { .e select range 4 4 list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in entry}} -test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} { +test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 @@ -385,78 +433,92 @@ test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} { .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.58 {EntryWidgetCmd procedure, "selection to" widget command} { +test entry-3.64 {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.59 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 5 .e xview } {0.0537634 0.268817} -test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview gorp} msg] $msg } {1 {bad entry index "gorp"}} -test entry-3.61 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 0 .e icursor 10 .e xview insert .e xview } {0.107527 0.322581} -test entry-3.62 {EntryWidgetCmd procedure, "xview" widget command} { +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.63 {EntryWidgetCmd procedure, "xview" widget command} { +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.64 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} { .e xview moveto 0.5 .e xview } {0.505376 0.72043} -test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} { +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.66 {EntryWidgetCmd procedure, "xview" widget command} { +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.67 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} { .e xview moveto 0 .e xview scroll 1 pages .e xview } {0.193548 0.408602} -test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} { .e xview moveto .9 update .e xview scroll -2 p .e xview } {0.397849 0.612903} -test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 30 update .e xview scroll 2 units .e index @0 } {32} -test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 30 update .e xview scroll -1 units .e index @0 } {29} -test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} { +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.72 {EntryWidgetCmd procedure, "xview" widget command} { +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.73 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 0 update .e xview -4 .e index @0 } {0} -test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 300 .e index @0 } {73} -test entry-3.75 {EntryWidgetCmd procedure} { +.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.319149} {0.117021 0.351064} {0.117021 0.351064} + + set x {} + .e xview moveto .1 + lappend x [.e xview] + .e xview moveto .11 + lappend x [.e xview] + .e xview moveto .12 + lappend x [.e xview] +} {{0.0957447 0.308511} {0.106383 0.319149} {0.117021 0.329787}} +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, or xview}} @@ -662,7 +724,7 @@ test entry-6.9 {EntryComputeGeometry procedure} {fonts} { update list [winfo reqwidth .e] [winfo reqheight .e] } {25 39} -test entry-6.10 {EntryComputeGeometry procedure} {fonts} { +test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} { catch {destroy .e} entry .e -bd 1 -relief raised -width 0 -show . .e insert 0 12345 @@ -674,6 +736,21 @@ test entry-6.10 {EntryComputeGeometry procedure} {fonts} { .e configure -show "" lappend x [winfo reqwidth .e] } {23 53 43} +test entry-6.11 {EntryComputeGeometry procedure} {pcOnly} { + catch {destroy .e} + entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12} + .e insert 0 12345 + pack .e + update + set x [winfo reqwidth .e] + .e configure -show X + lappend x [winfo reqwidth .e] + .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]]] catch {destroy .e} entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll @@ -1089,52 +1166,62 @@ test entry-13.9 {GetEntryIndex procedure} { list [.e index sel.first] [.e index sel.last] } {1 6} selection clear .e -test entry-13.10 {GetEntryIndex procedure} {pc} { - .e index sel.first -} {1} -test entry-13.11 {GetEntryIndex procedure} {!pc} { +test entry-13.10 {GetEntryIndex procedure} {unixOnly} { + # 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 entry}} -test entry-13.12 {GetEntryIndex procedure} {pc} { - list [catch {.e index sbogus} msg] $msg -} {1 {bad entry index "sbogus"}} -test entry-13.13 {GetEntryIndex procedure} {!pc} { +test entry-13.11 {GetEntryIndex procedure} {macOrPc} { + # 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} {unixOnly} { list [catch {.e index sbogus} msg] $msg } {1 {selection isn't in entry}} -test entry-13.14 {GetEntryIndex procedure} { +test entry-13.13 {GetEntryIndex procedure} {macOrPc} { + list [catch {.e index sbogus} msg] $msg +} {1 {bad entry index "sbogus"}} +test entry-13.14 {GetEntryIndex procedure} {macOrPc} { + 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.15 {GetEntryIndex procedure} {fonts} { +test entry-13.16 {GetEntryIndex procedure} {fonts} { .e index @4 } {4} -test entry-13.16 {GetEntryIndex procedure} {fonts} { +test entry-13.17 {GetEntryIndex procedure} {fonts} { .e index @11 } {4} -test entry-13.17 {GetEntryIndex procedure} {fonts} { +test entry-13.18 {GetEntryIndex procedure} {fonts} { .e index @12 } {5} -test entry-13.18 {GetEntryIndex procedure} {fonts} { +test entry-13.19 {GetEntryIndex procedure} {fonts} { .e index @[expr [winfo width .e] - 6] } {8} -test entry-13.19 {GetEntryIndex procedure} {fonts} { +test entry-13.20 {GetEntryIndex procedure} {fonts} { .e index @[expr [winfo width .e] - 5] } {9} -test entry-13.20 {GetEntryIndex procedure} { +test entry-13.21 {GetEntryIndex procedure} { .e index @1000 } {9} -test entry-13.21 {GetEntryIndex procedure} { +test entry-13.22 {GetEntryIndex procedure} { list [catch {.e index 1xyz} msg] $msg } {1 {bad entry index "1xyz"}} -test entry-13.22 {GetEntryIndex procedure} { +test entry-13.23 {GetEntryIndex procedure} { .e index -10 } {0} -test entry-13.23 {GetEntryIndex procedure} { +test entry-13.24 {GetEntryIndex procedure} { .e index 12 } {12} -test entry-13.24 {GetEntryIndex procedure} { +test entry-13.25 {GetEntryIndex procedure} { .e index 49 } {21} -test entry-13.25 {GetEntryIndex procedure} {fonts} { +test entry-13.26 {GetEntryIndex procedure} {fonts} { catch {destroy .e} entry .e -show . .e insert 0 XXXYZZY @@ -1199,14 +1286,20 @@ test entry-16.1 {EntryVisibleRange procedure} {fonts} { .e insert 0 ............................. .e xview } {0 0.827586} -test entry-16.2 {EntryVisibleRange procedure} {fonts} { +test entry-15.2 {EntryVisibleRange procedure} {unixOnly fonts} { .e configure -show X .e delete 0 end .e insert 0 ............................. .e xview } {0 0.275862} +test entry-15.3 {EntryVisibleRange procedure} {pcOnly} { + .e configure -show . + .e delete 0 end + .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX + .e xview +} {0 0.827586} .e configure -show "" -test entry-16.3 {EntryVisibleRange procedure} { +test entry-15.4 {EntryVisibleRange procedure} { .e delete 0 end .e xview } {0 1} @@ -1265,5 +1358,21 @@ test entry-18.1 {Entry widget vs hiding} { # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, # and EntryTextVarProc. - option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/event.test b/tests/event.test index 0812f71..b5bfe6a 100644 --- a/tests/event.test +++ b/tests/event.test @@ -3,14 +3,13 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: event.test,v 1.2 1998/09/14 18:23:46 stanton Exp $ +# RCS: @(#) $Id: event.test,v 1.3 1999/04/16 01:51:37 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -39,3 +38,20 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} { destroy .b set x } {destroy} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/filebox.test b/tests/filebox.test index 02e9295..e4bc512 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -3,15 +3,24 @@ # for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: filebox.test,v 1.5 1998/12/07 23:29:00 hershey Exp $ +# RCS: @(#) $Id: filebox.test,v 1.6 1999/04/16 01:51:37 stanton Exp $ # +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + set tk_strictMotif_old $tk_strictMotif +# Some tests require user interaction on non-unix platform + +set ::tcltest::testConfig(nonUnixUserInteraction) \ + [expr {$::tcltest::testConfig(userInteraction) || \ + $::tcltest::testConfig(unixOnly)}] + #---------------------------------------------------------------------- # # Procedures needed by this test file @@ -90,17 +99,18 @@ proc SendButtonPress {parent btn type} { # #---------------------------------------------------------------------- -if {[string compare test [info procs test]] == 1} { - source defs -} - if {$tcl_platform(platform) == "unix"} { set modes "0 1" } else { set modes 1 } -set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent or -title}} +set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} + +set tmpFile "filebox.tmp" +makeFile { + # this file can be empty! +} $tmpFile foreach mode $modes { @@ -118,11 +128,11 @@ foreach mode $modes { # foreach command "tk_getOpenFile tk_getSaveFile" { - test filebox-1.1 "$command command" { list [catch {$command -foo} msg] $msg } $unknownOptionsMsg + catch {$command -foo 1} msg regsub -all , $msg "" options regsub \"-foo\" $options "" options @@ -156,10 +166,6 @@ foreach mode $modes { set isNative 0 } - if {$isNative && ![info exists INTERACTIVE]} { - continue - } - set parent . set verylongstring longstring: @@ -174,52 +180,48 @@ foreach mode $modes { # set verylongstring $verylongstring$verylongstring set color #404040 - test filebox-2.1 "$command command" { + test filebox-2.1 "$command command" {nonUnixUserInteraction} { ToPressButton $parent cancel $command -title "Press Cancel ($verylongstring)" -parent $parent } "" - if {$command == "tk_getSaveFile"} { set fileName "12x 455" set fileDir [pwd] set pathName [file join [pwd] $fileName] } else { - set thisFile [info script] - set fileName [file tail $thisFile] - - # this file should be in the current working dir + set fileName $tmpFile set fileDir [pwd] set pathName [file join $fileDir $fileName] } - test filebox-2.2 "$command command" { + test filebox-2.2 "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Press Ok" \ -parent $parent -initialfile $fileName -initialdir $fileDir] } $pathName - test filebox-2.3 "$command command" { + test filebox-2.3 "$command command" {nonUnixUserInteraction} { ToEnterFileByKey $parent $fileName $fileDir set choice [$command -title "Enter \"$fileName\" and press Ok" \ -parent $parent -initialdir $fileDir] } $pathName - test filebox-2.4 "$command command" { + test filebox-2.4 "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Enter \"$fileName\" and press Ok" \ -parent $parent -initialdir . \ -initialfile $fileName] } $pathName - test filebox-2.5 "$command command" { + test filebox-2.5 "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Enter \"$fileName\" and press Ok" \ -parent $parent -initialdir /badpath \ -initialfile $fileName] } $pathName - test filebox-2.6 "$command command" { + test filebox-2.6 "$command command" {nonUnixUserInteraction} { toplevel .t1; toplevel .t2 ToPressButton .t1 ok set choice {} @@ -264,7 +266,7 @@ foreach mode $modes { } foreach x [lsort -integer [array names filters]] { - test filebox-3.$x "$command command" { + test filebox-3.$x "$command command" {nonUnixUserInteraction} { ToPressButton $parent ok set choice [$command -title "Press Ok" -filetypes $filters($x)\ -parent $parent -initialfile $fileName -initialdir $fileDir] @@ -288,10 +290,19 @@ foreach mode $modes { set tk_strictMotif $tk_strictMotif_old -if {$isNative && ![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test." - return -} +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/focus.test b/tests/focus.test index a8c3f3b..e8f850a 100644 --- a/tests/focus.test +++ b/tests/focus.test @@ -3,18 +3,13 @@ # standard fashion for Tcl tests. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: focus.test,v 1.4 1998/12/08 04:05:34 hershey Exp $ - -if {$tcl_platform(platform) != "unix"} { - return -} +# RCS: @(#) $Id: focus.test,v 1.5 1999/04/16 01:51:37 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } eval destroy [winfo children .] @@ -47,7 +42,7 @@ proc focusSetupAlt {} { } # Make sure the window manager knows who has focus -fixfocus +catch {fixfocus} # The following procedure ensures that there is no input focus # in this application. It does it by arranging for another @@ -65,8 +60,8 @@ proc focusClear {} { } focusSetup -set altDisplay [info exists env(TK_ALT_DISPLAY)] -if $altDisplay { +set ::tcltest::testConfig(altDisplay) [info exists env(TK_ALT_DISPLAY)] +if {$::tcltest::testConfig(altDisplay)} { focusSetupAlt } update @@ -81,37 +76,35 @@ bind all <KeyPress> { append focusInfo "press %W %K" } -test focus-1.1 {Tk_FocusCmd procedure} { +test focus-1.1 {Tk_FocusCmd procedure} {unixOnly} { focusClear focus } {} -if $altDisplay { - test focus-1.2 {Tk_FocusCmd procedure} { - focus .alt.b - focus - } {} -} -test focus-1.3 {Tk_FocusCmd procedure} { +test focus-1.2 {Tk_FocusCmd procedure} {unixOnly altDisplay} { + focus .alt.b + focus +} {} +test focus-1.3 {Tk_FocusCmd procedure} {unixOnly} { focusClear focus .t.b3 focus } {} -test focus-1.4 {Tk_FocusCmd procedure} { +test focus-1.4 {Tk_FocusCmd procedure} {unixOnly} { list [catch {focus ""} msg] $msg } {0 {}} -test focus-1.5 {Tk_FocusCmd procedure} { +test focus-1.5 {Tk_FocusCmd procedure} {unixOnly} { focusClear focus -force .t focus .t.b3 focus } {.t.b3} -test focus-1.6 {Tk_FocusCmd procedure} { +test focus-1.6 {Tk_FocusCmd procedure} {unixOnly} { list [catch {focus .gorp} msg] $msg } {1 {bad window path name ".gorp"}} -test focus-1.7 {Tk_FocusCmd procedure} { +test focus-1.7 {Tk_FocusCmd procedure} {unixOnly} { 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} { +test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {unixOnly} { toplevel .t2 wm geom .t2 +10+10 frame .t2.f -width 200 -height 100 -bd 2 -relief raised @@ -130,91 +123,88 @@ test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} { destroy .t2 set x } {.t2.f2 .t2 .t2} -test focus-1.9 {Tk_FocusCmd procedure, -displayof option} { +test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { list [catch {focus -displayof} msg] $msg } {1 {wrong # args: should be "focus -displayof window"}} -test focus-1.10 {Tk_FocusCmd procedure, -displayof option} { +test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { 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} { +test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { list [catch {focus -displayof .lousy} msg] $msg } {1 {bad window path name ".lousy"}} -test focus-1.12 {Tk_FocusCmd procedure, -displayof option} { +test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { focusClear focus .t focus -displayof .t.b3 } {} -test focus-1.13 {Tk_FocusCmd procedure, -displayof option} { +test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { focusClear focus -force .t focus -displayof .t.b3 } {.t} -if $altDisplay { - test focus-1.14 {Tk_FocusCmd procedure, -displayof option} { - focus -force .alt.c - focus -displayof .alt - } {.alt.c} -} -test focus-1.15 {Tk_FocusCmd procedure, -force option} { +test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unixOnly altDisplay} { + focus -force .alt.c + focus -displayof .alt +} {.alt.c} +test focus-1.15 {Tk_FocusCmd procedure, -force option} {unixOnly} { list [catch {focus -force} msg] $msg } {1 {wrong # args: should be "focus -force window"}} -test focus-1.16 {Tk_FocusCmd procedure, -force option} { +test focus-1.16 {Tk_FocusCmd procedure, -force option} {unixOnly} { 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} { +test focus-1.17 {Tk_FocusCmd procedure, -force option} {unixOnly} { list [catch {focus -force foo} msg] $msg } {1 {bad window path name "foo"}} -test focus-1.18 {Tk_FocusCmd procedure, -force option} { +test focus-1.18 {Tk_FocusCmd procedure, -force option} {unixOnly} { list [catch {focus -force ""} msg] $msg } {0 {}} -test focus-1.19 {Tk_FocusCmd procedure, -force option} { +test focus-1.19 {Tk_FocusCmd procedure, -force option} {unixOnly} { 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} { +test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { list [catch {focus -lastfor} msg] $msg } {1 {wrong # args: should be "focus -lastfor window"}} -test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} { +test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { 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} { +test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { list [catch {focus -lastfor who_knows?} msg] $msg } {1 {bad window path name "who_knows?"}} -test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} { +test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { focus .b focus .t.b1 list [focus -lastfor .] [focus -lastfor .t.b3] } {.b .t.b1} -test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} { +test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { destroy .t focusSetup update focus -lastfor .t.b2 } {.t} -test focus-1.25 {Tk_FocusCmd procedure} { +test focus-1.25 {Tk_FocusCmd procedure} {unixOnly} { list [catch {focus -unknown} msg] $msg } {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}} -if {[string compare testwrapper [info commands testwrapper]] != 0} { - puts "This application hasn't been compiled with the testwrapper command," - puts "therefore I am skipping all of these tests." - cleanupbg - return -} +# Some tests require the testwrapper command -test focus-2.1 {TkFocusFilterEvent procedure} {nonPortable} { +set ::tcltest::testConfig(testwrapper) \ + [expr {[info commands testwrapper] != {}}] + +test focus-2.1 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { focus -force .b destroy .t focusSetup update set focusInfo {} - event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor -sendevent 0x54217567 + event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \ + -sendevent 0x54217567 list $focusInfo } {{}} -test focus-2.2 {TkFocusFilterEvent procedure} {nonPortable} { +test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { focus -force .b destroy .t focusSetup @@ -224,7 +214,7 @@ test focus-2.2 {TkFocusFilterEvent procedure} {nonPortable} { list $focusInfo [focus] } {{in .t NotifyAncestor } .b} -test focus-2.3 {TkFocusFilterEvent procedure} {nonPortable} { +test focus-2.3 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { focus -force .b destroy .t focusSetup @@ -237,7 +227,8 @@ test focus-2.3 {TkFocusFilterEvent procedure} {nonPortable} { out . NotifyNonlinearVirtual in .t NotifyNonlinear } .t} -test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} {nonPortable} { +test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ + {unixOnly nonPortable testwrapper} { set result {} focus .t.b1 # Important to end with NotifyAncestor, which is an @@ -267,7 +258,8 @@ in .t.b1 NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear }} -test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} {nonPortable} { +test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \ + {unixOnly nonPortable testwrapper} { focusSetup focus .t.b1 update @@ -277,7 +269,8 @@ test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} {nonPor in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } .t.b1} -test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} { +test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ + {unixOnly testwrapper} { focus .t.b1 focus . update @@ -287,7 +280,8 @@ test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} { event gen . <KeyPress-x> list $x $focusInfo } {.t.b1 {press .t.b1 x}} -test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} { +test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \ + {unixOnly testwrapper} { set result {} foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot @@ -299,17 +293,20 @@ test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} { } set result } {{} .t.b1 {} {} .t.b1 .t.b1 {}} -test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} { +test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \ + {unixOnly testwrapper} { focus -force .t.b1 event gen .t.b1 <FocusOut> -detail NotifyAncestor focus } {.t.b1} -test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} { +test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \ + {unixOnly testwrapper} { focus .t.b1 event gen [testwrapper .] <FocusOut> -detail NotifyAncestor focus } {} -test focus-2.10 {TkFocusFilterEvent procedure, Enter events} { +test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \ + {unixOnly testwrapper} { set result {} focus .t.b1 focusClear @@ -323,14 +320,16 @@ test focus-2.10 {TkFocusFilterEvent procedure, Enter events} { } set result } {.t.b1 {} .t.b1 .t.b1 .t.b1} -test focus-2.11 {TkFocusFilterEvent procedure, Enter events} { +test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \ + {unixOnly testwrapper} { focusClear set focusInfo {} event gen [testwrapper .t] <Enter> -detail NotifyAncestor update set focusInfo } {} -test focus-2.12 {TkFocusFilterEvent procedure, Enter events} { +test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \ + {unixOnly testwrapper} { focus -force .b update set focusInfo {} @@ -338,7 +337,8 @@ test focus-2.12 {TkFocusFilterEvent procedure, Enter events} { update set focusInfo } {} -test focus-2.13 {TkFocusFilterEvent procedure, Enter events} { +test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \ + {unixOnly testwrapper} { focus .t.b1 focusClear event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 @@ -348,7 +348,7 @@ test focus-2.13 {TkFocusFilterEvent procedure, Enter events} { } {in .t NotifyVirtual in .t.b1 NotifyAncestor } -test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} { +test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unixOnly testwrapper} { focusClear catch {destroy .t2} toplevel .t2 @@ -359,7 +359,8 @@ test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when update destroy .t2 } {} -test focus-2.15 {TkFocusFilterEvent procedure, Leave events} { +test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \ + {unixOnly testwrapper} { set result {} focus .t.b1 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear @@ -373,7 +374,8 @@ test focus-2.15 {TkFocusFilterEvent procedure, Leave events} { } set result } {{} .t.b1 {} {} {}} -test focus-2.16 {TkFocusFilterEvent procedure, Leave events} { +test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \ + {unixOnly testwrapper} { set result {} focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 @@ -385,7 +387,8 @@ test focus-2.16 {TkFocusFilterEvent procedure, Leave events} { } {out .t.b1 NotifyAncestor out .t NotifyVirtual } -test focus-2.17 {TkFocusFilterEvent procedure, Leave events} { +test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ + {unixOnly testwrapper} { set result {} focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 @@ -399,7 +402,8 @@ test focus-2.17 {TkFocusFilterEvent procedure, Leave events} { out .t NotifyVirtual } {}} -test focus-3.1 {SetFocus procedure, create record on focus} { +test focus-3.1 {SetFocus procedure, create record on focus} \ + {unixOnly testwrapper} { toplevel .t2 -width 250 -height 100 wm geometry .t2 +0+0 update @@ -411,7 +415,8 @@ catch {destroy .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} { +test focus-3.2 {SetFocus procedure, making window exist} \ + {unixOnly testwrapper} { update button .b2 -text "Another button" focus .b2 @@ -421,12 +426,14 @@ catch {destroy .b2} update # 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} { +test focus-3.3 {SetFocus procedure, delaying claim of X focus} \ + {unixOnly testwrapper} { focusSetup focus -force .t.b2 update } {} -test focus-3.4 {SetFocus procedure, delaying claim of X focus} { +test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ + {unixOnly testwrapper} { focusSetup wm withdraw .t focus -force .t.b2 @@ -439,7 +446,8 @@ test focus-3.4 {SetFocus procedure, delaying claim of X focus} { wm deiconify .t } {} catch {destroy .t2} -test focus-3.5 {SetFocus procedure, generating events} { +test focus-3.5 {SetFocus procedure, generating events} \ + {unixOnly testwrapper} { focusSetup focusClear set focusInfo {} @@ -449,7 +457,8 @@ test focus-3.5 {SetFocus procedure, generating events} { } {in .t NotifyVirtual in .t.b2 NotifyAncestor } -test focus-3.6 {SetFocus procedure, generating events} { +test focus-3.6 {SetFocus procedure, generating events} \ + {unixOnly testwrapper} { focusSetup focus -force .b update @@ -462,7 +471,8 @@ out . NotifyNonlinearVirtual in .t NotifyNonlinearVirtual in .t.b2 NotifyNonlinear } -test focus-3.7 {SetFocus procedure, generating events} {nonPortable} { +test focus-3.7 {SetFocus procedure, generating events} \ + {unixOnly nonPortable testwrapper} { # Non-portable because some platforms generate extra events. focusSetup @@ -473,7 +483,7 @@ test focus-3.7 {SetFocus procedure, generating events} {nonPortable} { set focusInfo } {} -test focus-4.1 {TkFocusDeadWindow procedure} { +test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { focusSetup update focus -force .b @@ -481,7 +491,7 @@ test focus-4.1 {TkFocusDeadWindow procedure} { destroy .t focus } {.b} -test focus-4.2 {TkFocusDeadWindow procedure} { +test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { focusSetup update focus -force .t.b2 @@ -495,7 +505,7 @@ test focus-4.2 {TkFocusDeadWindow procedure} { # Non-portable due to wm-specific redirection of input focus when # windows are deleted: -test focus-4.3 {TkFocusDeadWindow procedure} {nonPortable} { +test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} { focusSetup update focus .t @@ -504,7 +514,7 @@ test focus-4.3 {TkFocusDeadWindow procedure} {nonPortable} { update focus } {} -test focus-4.4 {TkFocusDeadWindow procedure} { +test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { focusSetup focus -force .t.b2 update @@ -515,7 +525,21 @@ test focus-4.4 {TkFocusDeadWindow procedure} { # 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. -test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} { +# If send is disabled because of inadequate security, don't run any +# of these tests at all. + +setupbg +set app [dobg {tk appname}] +set ::tcltest::testConfig(secureServer) 1 +if {[catch {send $app set a 0} msg] == 1} { + if [string match "X server insecure *" $msg] { + set ::tcltest::testConfig(secureServer) 0 + } +} +cleanupbg +setupbg +test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ + {unixOnly testwrapper secureServer} { focusSetup focus -force .t update @@ -525,7 +549,7 @@ test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} { focus .t.b2 update lappend result [focus] -} {.t .t {}} +} {.t {} {}} catch {destroy .t} bind all <FocusIn> {} @@ -534,7 +558,8 @@ bind all <KeyPress> {} cleanupbg fixfocus -test focus-6.1 {miscellaneous - embedded application in same process} {unixOnly} { +test focus-6.1 {miscellaneous - embedded application in same process} \ + {unixOnly testwrapper} { eval interp delete [interp slaves] catch {destroy .t} toplevel .t @@ -583,7 +608,8 @@ test focus-6.1 {miscellaneous - embedded application in same process} {unixOnly} 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} {unixOnly} { +test focus-6.2 {miscellaneous - embedded application in different process} \ + {unixOnly testwrapper} { eval interp delete [interp slaves] catch {destroy .t} setupbg @@ -635,3 +661,20 @@ test focus-6.2 {miscellaneous - embedded application in different process} {unix eval destroy [winfo children .] bind all <FocusIn> {} bind all <FocusOut> {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/focusTcl.test b/tests/focusTcl.test index 14c1d3d..0d223cf 100644 --- a/tests/focusTcl.test +++ b/tests/focusTcl.test @@ -4,14 +4,13 @@ # standard fashion for Tcl tests. # # Copyright (c) 1995 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: focusTcl.test,v 1.2 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: focusTcl.test,v 1.3 1999/04/16 01:51:37 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } eval destroy [winfo children .] @@ -277,3 +276,20 @@ test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} { bind Frame <Key> {} . configure -takefocus 0 -highlightthickness 0 option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/font.test b/tests/font.test index 909085b..264dee5 100644 --- a/tests/font.test +++ b/tests/font.test @@ -1,16 +1,21 @@ # This file is a Tcl script to test out Tk's "font" command # plus the procedures in tkFont.c. It is organized in the -# standard fashion for Tcl tests. +# standard white-box fashion for Tcl tests. # -# Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1996-1998 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: font.test,v 1.3 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: font.test,v 1.4 1999/04/16 01:51:37 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} -if {[string compare test [info procs test]] != 0} { - source defs +if {[info commands testfont] != "testfont"} { + puts "testfont command not available; skipping tests" + ::tcltest::cleanupTests + return } catch {destroy .b} @@ -20,7 +25,7 @@ update idletasks proc setup {} { catch {destroy .b.f} - catch {font delete xyz} + catch {eval font delete [font names]} label .b.f pack .b.f update @@ -56,243 +61,357 @@ case $tcl_platform(platform) { } set times [font actual {times 0} -family] -test font-1.1 {font command: general} { +test font-1.1 {TkFontPkgInit} { + catch {interp delete foo} + interp create foo + foo eval { + load {} Tk + wm geometry . +0+0 + update + } + interp delete foo +} {} + +test font-2.1 {TkFontPkgFree} { + catch {interp delete foo} + interp create foo + set x {} + + # 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 + } + 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 . + } + lappend x [foo eval {catch {font families} msg; set msg}] + + 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} { list [catch {font} msg] $msg } {1 {wrong # args: should be "font option ?arg?"}} -test font-1.2 {font command: actual: arguments} { +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} { + # (skip < 0) list [catch {font actual xyz -displayof} msg] $msg } {1 {value for "-displayof" missing}} -test font-1.3 {font command: actual: arguments} { +test font-4.2 {font command: actual: arguments} { + # (objc < 3) list [catch {font actual} msg] $msg } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}} -test font-1.4 {font command: actual: arguments} { +test font-4.3 {font command: actual: arguments} { + # (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?"}} -test font-1.5 {font command: actual: arguments} { - list [catch {font actual {}} msg] $msg -} {1 {font "" doesn't exist}} -test font-1.6 {font command: actual: displayof specified, so skip to next} { +test font-4.4 {font command: actual: displayof specified, so skip to next} { catch {font actual xyz -displayof . -size} } {0} -test font-1.7 {font command: actual: displayof specified, so skip to next} { +test font-4.5 {font command: actual: displayof specified, so skip to next} { lindex [font actual xyz -displayof .] 0 } {-family} -test font-1.8 {font command: actual} {unix || mac} { +test font-4.6 {font command: actual: arguments} { + # (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?"}} +test font-4.7 {font command: actual: arguments} { + # (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} { + # not (objc > 3) so objPtr = NULL + lindex [font actual {-family times}] 0 +} {-family} +test font-4.9 {font command: actual} {macOrUnix} { + # (objc > 3) so objPtr = objv[3 + skip] string tolower [font actual {-family times} -family] } {times} -test font-1.9 {font command: actual} {pcOnly} { +test font-4.10 {font command: actual} {pcOnly} { + # (objc > 3) so objPtr = objv[3 + skip] font actual {-family times} -family } {Times New Roman} -test font-1.10 {font command: actual} { - lindex [font actual {-family times}] 0 -} {-family} -test font-1.11 {font command: bad option} { +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}} -test font-2.1 {font command: configure} { +test font-5.1 {font command: configure} { + # (objc < 3) list [catch {font configure} msg] $msg } {1 {wrong # args: should be "font configure fontname ?options?"}} -test font-2.2 {font command: configure: non-existent font} { +test font-5.2 {font command: configure: non-existent font} { + # (namedHashPtr == NULL) list [catch {font configure xyz} msg] $msg } {1 {named font "xyz" doesn't exist}} -test font-2.3 {font command: configure: "deleted" font} { +test font-5.3 {font command: configure: "deleted" font} { + # (nfPtr->deletePending != 0) setup font create xyz .b.f configure -font xyz font delete xyz list [catch {font configure xyz} msg] $msg } {1 {named font "xyz" doesn't exist}} -test font-2.4 {font command: configure: get all options} { +test font-5.4 {font command: configure: get all options} { + # (objc == 3) so objPtr = NULL setup font create xyz -family xyz lindex [font configure xyz] 1 } xyz -test font-2.5 {font command: configure: get one option} { +test font-5.5 {font command: configure: get one option} { + # (objc == 4) so objPtr = objv[3] setup font create xyz -family xyz font configure xyz -family } xyz -test font-2.6 {font command: configure: update existing font} { +test font-5.6 {font command: configure: update existing font} { + # else result = ConfigAttributesObj() setup font create xyz font configure xyz -family xyz update font configure xyz -family } xyz -test font-2.7 {font command: configure: bad option} { +test font-5.7 {font command: configure: bad option} { setup font create xyz list [catch {font configure xyz -style} msg] $msg } {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}} -test font-3.1 {font command: create: make up name} { - font delete [font create] - font delete [font create -family xyz] -} {} -test font-3.2 {font command: create: already exists} { +test font-6.1 {font command: create: make up name} { + # (objc < 3) so name = NULL setup - font create xyz - list [catch {font create xyz} msg] $msg -} {1 {font "xyz" already exists}} -test font-3.3 {font command: create: error recreating "deleted" font} { + font create + font names +} {font1} +test font-6.2 {font command: create: name specified} { + # not (objc < 3) setup font create xyz - .b.f configure -font xyz - font delete xyz - list [catch {font create xyz -xyz times} msg] $msg -} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}} -test font-3.4 {font command: create: recreate "deleted" font} { + font names +} {xyz} +test font-6.3 {font command: create: name not really specified} { + # (name[0] == '-') so name = NULL setup - font create xyz - .b.f configure -font xyz - font delete xyz - font actual xyz - font create xyz -family times - update - font configure xyz -family -} {times} -test font-3.5 {font command: create: bad option creating new font} { + font create -family xyz + font names +} {font1} +test font-6.4 {font command: create: generate name} { + # (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} { + # 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-3.6 {font command: create: totally new font} { +test font-6.6 {font command: create: bad option creating new font} { + # name was not specified so skip = 2 setup - font create xyz -family xyz - font configure xyz -family -} {xyz} + 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} { + # (CreateNamedFont() != TCL_OK) + setup + font create xyz + list [catch {font create xyz} msg] $msg +} {1 {named font "xyz" already exists}} -test font-4.1 {font command: delete: arguments} { +test font-7.1 {font command: delete: arguments} { + # (objc < 3) list [catch {font delete} msg] $msg } {1 {wrong # args: should be "font delete fontname ?fontname ...?"}} -test font-4.2 {font command: delete: loop test} { +test font-7.2 {font command: delete: loop test} { + # for (i = 2; i < objc; i++) + setup + set x {} font create a -underline 1 font create b -underline 1 font create c -underline 1 - font delete a b c - list [font actual a -underline] [font actual b -underline] [font actual c -underline] -} {0 0 0} -test font-4.3 {font command: delete: non-existent} { + font create d -underline 1 + font create e -underline 1 + lappend x [lsort [font names]] + font delete a e c b + lappend x [lsort [font names]] +} {{a b c d e} d} +test font-7.3 {font command: delete: loop test} { + # (namedHashPtr == NULL) in middle of loop + setup + set x {} + font create a -underline 1 + font create b -underline 1 + font create c -underline 1 + font create d -underline 1 + font create e -underline 1 + lappend x [lsort [font names]] + catch {font delete a d q c e b} + lappend x [lsort [font names]] +} {{a b c d e} {b c e}} +test font-7.4 {font command: delete: non-existent} { + # (namedHashPtr == NULL) setup list [catch {font delete xyz} msg] $msg } {1 {named font "xyz" doesn't exist}} -test font-4.4 {font command: delete: mark for later deletion} { +test font-7.5 {font command: delete: mark for later deletion} { + # (nfPtr->refCount != 0) setup font create xyz .b.f configure -font xyz font delete xyz font actual xyz - list [catch {font configure xyz} msg] $msg -} {1 {named font "xyz" doesn't exist}} -test font-4.5 {font command: delete: actually delete} { + 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} { + # not (nfPtr->refCount != 0) setup font create xyz -underline 1 font delete xyz - font actual xyz -underline -} {0} + catch {font config xyz} +} {1} +setup -test font-5.1 {font command: families: arguments} { +test font-8.1 {font command: families: arguments} { + # (skip < 0) list [catch {font families -displayof} msg] $msg } {1 {value for "-displayof" missing}} -test font-5.2 {font command: families: arguments} { +test font-8.2 {font command: families: arguments} { + # (objc - skip != 2) when skip == 0 list [catch {font families xyz} msg] $msg } {1 {wrong # args: should be "font families ?-displayof window?"}} -test font-5.3 {font command: families} { - font families - set x {} -} {} +test font-8.3 {font command: families: arguments} { + # (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} { + # TkpGetFontFamilies() + regexp -nocase times [font families] +} {1} -test font-6.1 {font command: measure: arguments} { +test font-9.1 {font command: measure: arguments} { + # (skip < 0) list [catch {font measure xyz -displayof} msg] $msg } {1 {value for "-displayof" missing}} -test font-6.2 {font command: measure: arguments} { +test font-9.2 {font command: measure: arguments} { + # (objc - skip != 4) list [catch {font measure} msg] $msg } {1 {wrong # args: should be "font measure font ?-displayof window? text"}} -test font-6.3 {font command: measure: arguments} { +test font-9.3 {font command: measure: arguments} { + # (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-6.4 {font command: measure: arguments} { - list [catch {font measure {} abc} msg] $msg -} {1 {font "" doesn't exist}} -test font-6.5 {font command: measure} { +test font-9.4 {font command: measure: arguments} { + # (tkfont == NULL) + list [catch {font measure "\{xyz" abc} msg] $msg +} [list 1 "font \"{xyz\" doesn't exist"] +test font-9.5 {font command: measure} { + # Tk_TextWidth() expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7 } {1} -test font-7.1 {font command: metrics: arguments} { +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} { + # (skip < 0) list [catch {font metrics xyz -displayof} msg] $msg } {1 {value for "-displayof" missing}} -test font-7.2 {font command: metrics: arguments} { +test font-10.3 {font command: metrics: arguments} { + # (objc < 3) list [catch {font metrics} msg] $msg } {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}} -test font-7.3 {font command: metrics: get all metrics} { +test font-10.4 {font command: metrics: arguments} { + # (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} { + # (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} { + # (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) catch {unset a} array set a [font metrics {-family xyz}] set x [lsort [array names a]] unset a set x } {-ascent -descent -fixed -linespace} -test font-7.4 {font command: metrics: get ascent} { - catch {expr [font metrics $fixed -ascent]} -} {0} -test font-7.5 {font command: metrics: get descent} { - catch {expr [font metrics {-family xyz} -descent]} -} {0} -test font-7.6 {font command: metrics: get linespace} { - catch {expr [font metrics {-family fixed} -linespace]} -} {0} -test font-7.7 {font command: metrics: get fixed} { - catch {expr [font metrics {-family fixed} -fixed]} -} {0} -test font-7.8 {font command: metrics: get ascent} { - catch {expr [font metrics {-family xyz} -ascent]} -} {0} -test font-7.9 {font command: metrics: get descent} { - catch {expr [font metrics {-family xyz} -descent]} -} {0} -test font-7.10 {font command: metrics: get linespace} { - catch {expr [font metrics {-family fixed} -linespace]} -} {0} -test font-7.11 {font command: metrics: get fixed} { - catch {expr [font metrics {-family fixed} -fixed]} -} {0} -test font-7.12 {font command: metrics: bad metric} { - list [catch {font metrics {-family fixed} -xyz} msg] $msg +test font-10.8 {font command: metrics: bad metric} { + # (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 -ascent + font metrics $fixed -descent + font metrics $fixed -linespace + font metrics $fixed -fixed +} {1} -test font-8.1 {font command: names: arguments} { +test font-11.1 {font command: names: arguments} { + # (objc != 2) list [catch {font names xyz} msg] $msg } {1 {wrong # args: should be "font names"}} -test font-8.2 {font command: names} { +test font-11.2 {font command: names: loop test: no passes} { + setup + font names +} {} +test font-11.3 {font command: names: loop test: one pass} { + setup + font create + font names +} {font1} +test font-11.4 {font command: names: loop test: multiple passes} { setup font create xyz font create abc - set x [lsort [font names]] - font delete abc - font delete xyz - set x -} {abc xyz} -test font-8.3 {font command: names} { + font create def + lsort [font names] +} {abc def xyz} +test font-11.5 {font command: names: skip deletePending fonts} { + # (nfPtr->deletePending == 0) setup + set x {} font create xyz font create abc - set x [lsort [font names]] + lappend x [lsort [font names]] .b.f config -font xyz font delete xyz lappend x [font names] - font delete abc - set x -} {abc xyz abc} +} {{abc xyz} abc} -test font-9.1 {font command: unknown option} { - list [catch {font xyz} msg] $msg -} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}} - -test font-10.1 {UpdateDependantFonts procedure: no users} { +test font-12.1 {UpdateDependantFonts procedure: no users} { + # (nfPtr->refCount == 0) setup font create xyz font configure xyz -family times } {} -test font-10.2 {UpdateDependantFonts procedure: pings the widgets} { +test font-12.2 {UpdateDependantFonts procedure: pings the widgets} { setup font create xyz -family times -size 20 .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0 @@ -306,56 +425,155 @@ test font-10.2 {UpdateDependantFonts procedure: pings the widgets} { expr {$a1==$b1 && $a2==$b2} } {1} -test font-11.1 {Tk_GetFont procedure: bump ref count} { +test font-13.1 {CreateNamedFont: new named font} { + # not (new == 0) + setup + set x {} + lappend x [font names] + font create xyz + lappend x [font names] +} {{} xyz} +test font-13.2 {CreateNamedFont: named font already exists} { + # (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} { + # (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} { + # not (nfPtr->deletePending == 0) + setup + font create xyz -family times + .b.f configure -font xyz + font delete xyz + font create xyz -family courier + font configure xyz -family +} {courier} + +test font-14.1 {Tk_GetFont procedure} { +} {} + +test font-15.1 {Tk_AllocFontFromObj - converting internal reps} { + 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} { + set x {Times 16} + destroy .b1 .b2 + 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} { + set x {Times 16} + destroy .b1 .b2 + button .b1 -font $x + set result {} + 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} { + # (new == 0) setup .b.f config -font {-family fixed} lindex [font actual {-family fixed}] 0 } {-family} -test font-11.2 {Tk_GetFont procedure: bump ref count of named font, too} { +test font-15.5 {Tk_AllocFontFromObj procedure: get named font} { + # (namedHashPtr != NULL) setup - font create xyz - .b.f config -font xyz - lindex [font actual xyz] 0 -} {-family} -test font-11.3 {Tk_GetFont procedure: get named font} { + font create xyz + .b.f config -font xyz +} {} +test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} { + # not (namedHashPtr != NULL) setup - font create xyz - .b.f config -font xyz + .b.f config -font {times 20} } {} -test font-11.4 {Tk_GetFont procedure: get native font} {unixOnly} { +test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} { + # not (fontPtr == NULL) setup .b.f config -font fixed } {} -test font-11.5 {Tk_GetFont procedure: get native font} {pcOnly} { +test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} { + # not (fontPtr == NULL) setup .b.f config -font oemfixed } {} -test font-11.6 {Tk_GetFont procedure: get native font} {macOnly} { +test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} { + # not (fontPtr == NULL) setup .b.f config -font application } {} -test font-11.7 {Tk_GetFont procedure: get attribute font} { +test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} { + # (fontPtr == NULL) list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg } {1 {expected integer but got "yyy"}} -test font-11.8 {Tk_GetFont procedure: get attribute font} { +test font-15.11 {Tk_AllocFontFromObj procedure: no match} { + # (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} { + # not (ParseFontNameObj() != TCL_OK) lindex [font actual {plan 9}] 0 } {-family} -test font-11.9 {Tk_GetFont procedure: no match} { - list [catch {font actual {}} msg] $msg -} {1 {font "" doesn't exist}} +test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} { + # 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} { + # (fontPtr->underlineHeight == 0) because size was < 10 + setup + .b.f config -text "underline" -font "times -8 underline" + update +} {} -test font-12.1 {Tk_NameOfFont procedure} { +test font-16.1 {Tk_NameOfFont procedure} { setup - .b.f config -font {-family fixed} + .b.f config -font -family\ fixed .b.f cget -font } {-family fixed} -test font-13.1 {Tk_FreeFont procedure: one ref} { +test font-17.1 {Tk_FreeFontFromObj - reference counts} { + set x {Courier 12} + destroy .b1 .b2 .b3 + 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}] + destroy .b2 + 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} { + # (fontPtr->refCount == 0) setup .b.f config -font {-family fixed} destroy .b.f } {} -test font-13.2 {Tk_FreeFont procedure: multiple ref} { +test font-17.3 {Tk_FreeFont procedure: multiple ref} { + # not (fontPtr->refCount == 0) setup .b.f config -font {-family fixed} button .b.b -font {-family fixed} @@ -364,14 +582,16 @@ test font-13.2 {Tk_FreeFont procedure: multiple ref} { destroy .b.b set x } {-family fixed} -test font-13.3 {Tk_FreeFont procedure: named font} { +test font-17.4 {Tk_FreeFont procedure: named font} { + # (fontPtr->namedHashPtr != NULL) setup font create xyz .b.f config -font xyz destroy .b.f font names } {xyz} -test font-13.4 {Tk_FreeFont procedure: named font} { +test font-17.5 {Tk_FreeFont procedure: named font} { + # not (fontPtr->refCount == 0) setup font create xyz -underline 1 .b.f config -font xyz @@ -380,9 +600,9 @@ test font-13.4 {Tk_FreeFont procedure: named font} { destroy .b.f list [font actual xyz -underline] $x } {0 1} -test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} { +test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} { setup - font create xyz + font create xyz .b.f config -font xyz button .b.b -font xyz font delete xyz @@ -391,12 +611,32 @@ test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} { list [lindex [font actual xyz] 0] [lindex $x 0] } {-family -family} -test font-14.1 {Tk_FontId} { +test font-18.1 {FreeFontObjProc} { + destroy .b1 + set x [format {Courier 12}] + button .b1 -font $x + set y [format {Courier 12}] + .b1 configure -font $y + set z [format {Courier 12}] + .b1 configure -font $z + set result {} + lappend result [testfont counts {Courier 12}] + set x red + lappend result [testfont counts {Courier 12}] + set z 32 + lappend result [testfont counts {Courier 12}] + destroy .b1 + lappend result [testfont counts {Courier 12}] + set y bogus + set result +} {{{1 3}} {{1 2}} {{1 1}} {}} + +test font-19.1 {Tk_FontId} { .b.f config -font "times 20" update } {} -test font-15.1 {Tk_FontMetrics procedure} { +test font-20.1 {Tk_GetFontMetrics procedure} { button .b.w1 -text abc entry .b.w2 -text abcd update @@ -414,7 +654,7 @@ proc psfontname {name} { set start [string first "gsave" $post] return [string range $post [expr $start+7] end] } -test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} { +test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} { set x [font actual {{itc avant garde} 10} -family] if {[string match *avant*garde $x]} { psfontname "{itc avant garde} 10" @@ -422,25 +662,25 @@ test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} { set x {AvantGarde-Book} } } {AvantGarde-Book} -test font-16.2 {Tk_PostscriptFontName procedure: native} {pcOnly} { +test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} { psfontname "arial 10" } {Helvetica} -test font-16.3 {Tk_PostscriptFontName procedure: native} {pcOnly} { +test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} { psfontname "{times new roman} 10" } {Times-Roman} -test font-16.4 {Tk_PostscriptFontName procedure: native} {pcOnly} { +test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} { psfontname "{courier new} 10" } {Courier} -test font-16.5 {Tk_PostscriptFontName procedure: native} {macOnly} { +test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} { psfontname "geneva 10" } {Helvetica} -test font-16.6 {Tk_PostscriptFontName procedure: native} {macOnly} { +test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} { psfontname "{new york} 10" } {Times-Roman} -test font-16.7 {Tk_PostscriptFontName procedure: native} {macOnly} { +test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} { psfontname "monaco 10" } {Courier} -test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { +test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { set x [font actual {{lucida bright} 10} -family] if {[string match lucida*bright $x]} { psfontname "{lucida bright} 10" @@ -448,7 +688,7 @@ test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { set x {LucidaBright} } } {LucidaBright} -test font-16.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { +test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { psfontname "{new century schoolbook} 10" } {NewCenturySchlbk-Roman} set i 10 @@ -464,7 +704,7 @@ foreach p { {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic} {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats} } { - test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} { + test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} { set family [lindex $p 0] set x {} set i 1 @@ -490,7 +730,7 @@ foreach p { {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic} {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic} } { - test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} { + test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} { set family [lindex $p 0] set x {} foreach slant {roman italic} { @@ -511,7 +751,7 @@ foreach p { {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic} {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic} } { - test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} { + test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} { set family [lindex $p 0] set x {} foreach slant {roman italic} { @@ -524,7 +764,11 @@ foreach p { } [lrange $p 1 end] } -test font-17.1 {Tk_UnderlineChars procedure} { +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 @@ -533,39 +777,39 @@ test font-17.1 {Tk_UnderlineChars procedure} { } {} setup -test font-18.1 {Tk_ComputeTextLayout: empty string} { +test font-24.1 {Tk_ComputeTextLayout: empty string} { .b.l config -text "" } {} -test font-18.2 {Tk_ComputeTextLayout: simple string} { +test font-24.2 {Tk_ComputeTextLayout: simple string} { .b.l config -text "000" getsize } "[expr $ax*3] $ay" -test font-18.3 {Tk_ComputeTextLayout: find special chars} { +test font-24.3 {Tk_ComputeTextLayout: find special chars} { .b.l config -text "000\n000" getsize } "[expr $ax*3] [expr $ay*2]" -test font-18.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} { +test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} { .b.l config -text "000\n000" getsize } "[expr $ax*3] [expr $ay*2]" -test font-18.5 {Tk_ComputeTextLayout: break line} { +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-18.6 {Tk_ComputeTextLayout: normal ended on special char} { +test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} { .b.l config -text "000\n000" } {} -test font-18.7 {Tk_ComputeTextLayout: special char was \n} { +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-18.8 {Tk_ComputeTextLayout: special char was \t} { +test font-24.8 {Tk_ComputeTextLayout: special char was \t} { .b.l config -text "000\t00" getsize } "[expr $ax*10] $ay" -test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} { +test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} { set x {} .b.l config -text "000\t000" lappend x [getsize] @@ -574,7 +818,7 @@ test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} { .b.l config -wrap 0 set x } "{[expr $ax*11] $ay} {[expr $ax*11] $ay}" -test font-18.10 {Tk_ComputeTextLayout: tab caused break} { +test font-24.10 {Tk_ComputeTextLayout: tab caused break} { set x {} .b.l config -text "000\t" lappend x [getsize] @@ -583,7 +827,7 @@ test font-18.10 {Tk_ComputeTextLayout: tab caused break} { .b.l config -wrap 0 set x } "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}" -test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} { +test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} { set x {} .b.l config -text "000 000" -wrap [expr $ax*5] lappend x [getsize] @@ -592,7 +836,7 @@ test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} { .b.l config -wrap 0 set x } "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}" -test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} { +test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} { set x {} .b.l config -text "000 0000" -wrap [expr $ax*5] lappend x [getsize] @@ -601,14 +845,14 @@ test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} { .b.l config -wrap 0 set x } "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}" -test font-18.13 {Tk_ComputeTextLayout: many lines -> realloc line array} { +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-18.14 {Tk_ComputeTextLayout: text ended with \n} { +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-18.15 {Tk_ComputeTextLayout: justification} { +test font-24.15 {Tk_ComputeTextLayout: justification} { csetup "000\n00000" set x {} .b.c itemconfig text -just left @@ -621,52 +865,52 @@ test font-18.15 {Tk_ComputeTextLayout: justification} { set x } {2 1 0} -test font-19.1 {Tk_FreeTextLayout procedure} { +test font-25.1 {Tk_FreeTextLayout procedure} { setup .b.f config -text foo .b.f config -text boo } {} -test font-20.1 {Tk_DrawTextLayout procedure: auto-detect last char} { +test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} { .b.f config -text foo } {} -test font-20.2 {Tk_DrawTextLayout procedure: multiple chunks} { +test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} { csetup "000\t00\n000" } {} -test font-20.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} { +test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} { csetup "000\t00" .b.c select from text 3 .b.c select to text 5 } {} -test font-20.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} { +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-20.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} { +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-20.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} { +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-21.1 {Tk_UnderlineTextLayout procedure: no underline chosen} { +test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} { .b.f config -text "foo" -under -1 } {} -test font-21.2 {Tk_UnderlineTextLayout procedure: underline not visible} { +test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} { .b.f config -text "000 00000" -wrap [expr $ax*7] -under 10 } {} -test font-21.3 {Tk_UnderlineTextLayout procedure: underline is visible} { +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-22.1 {Tk_PointToChar procedure: above all lines} { +test font-28.1 {Tk_PointToChar procedure: above all lines} { csetup "000" .b.c index text @-1,0 } {0} -test font-22.2 {Tk_PointToChar procedure: no chars} { +test font-28.2 {Tk_PointToChar procedure: no chars} { # After fixing the following bug: # # In canvas text item, it was impossible to click to position the @@ -678,103 +922,103 @@ test font-22.2 {Tk_PointToChar procedure: no chars} { csetup "" .b.c index text @100,100 } {0} -test font-22.3 {Tk_PointToChar procedure: loop test} { +test font-28.3 {Tk_PointToChar procedure: loop test} { csetup "000\n000\n000\n000" .b.c index text @10000,0 } {3} -test font-22.4 {Tk_PointToChar procedure: intersect line} { +test font-28.4 {Tk_PointToChar procedure: intersect line} { csetup "000\n000\n000" .b.c index text @0,$ay } {4} -test font-22.5 {Tk_PointToChar procedure: to the left of all chunks} { +test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} { .b.c index text @-100,$ay } {4} -test font-22.6 {Tk_PointToChar procedure: past any possible chunk} { +test font-28.6 {Tk_PointToChar procedure: past any possible chunk} { .b.c index text @100000,$ay } {7} -test font-22.7 {Tk_PointToChar procedure: which chunk on this line} { +test font-28.7 {Tk_PointToChar procedure: which chunk on this line} { csetup "000\n000\t000\t000\n000" .b.c index text @[expr $ax*2],$ay } {6} -test font-22.8 {Tk_PointToChar procedure: which chunk on this line} { +test font-28.8 {Tk_PointToChar procedure: which chunk on this line} { csetup "000\n000\t000\t000\n000" .b.c index text @[expr $ax*10],$ay } {10} -test font-22.9 {Tk_PointToChar procedure: in special chunk} { +test font-28.9 {Tk_PointToChar procedure: in special chunk} { csetup "000\n000\t000\t000\n000" .b.c index text @[expr $ax*6],$ay } {7} -test font-22.10 {Tk_PointToChar procedure: past all chars in chunk} { +test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} { 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-22.11 {Tk_PointToChar procedure: below all chunks} { +test font-28.11 {Tk_PointToChar procedure: below all chunks} { csetup "000 0000000" .b.c index text @0,1000000 } {11} -test font-23.1 {Tk_CharBBox procedure: index < 0} { +test font-29.1 {Tk_CharBBox procedure: index < 0} { .b.f config -text "000" -underline -1 } {} -test font-23.2 {Tk_CharBBox procedure: loop} { +test font-29.2 {Tk_CharBBox procedure: loop} { .b.f config -text "000\t000\t000\t000" -underline 9 } {} -test font-23.3 {Tk_CharBBox procedure: special char} { +test font-29.3 {Tk_CharBBox procedure: special char} { .b.f config -text "000\t000\t000" -underline 7 } {} -test font-23.4 {Tk_CharBBox procedure: normal char} { +test font-29.4 {Tk_CharBBox procedure: normal char} { .b.f config -text "000" -underline 1 } {} -test font-23.5 {Tk_CharBBox procedure: right edge of bbox truncated} { +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-23.6 {Tk_CharBBox procedure: bbox pegged to right edge} { +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-24.1 {Tk_TextLayoutToPoint procedure: loop once} { +test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} { csetup "000\n000\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x 0 -y 0 set x } {0} -test font-24.2 {Tk_TextLayoutToPoint procedure: loop multiple} { +test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} { csetup "000\n000\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x $ax -y $ay set x } {5} -test font-24.3 {Tk_TextLayoutToPoint procedure: loop to end} { +test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} { csetup "000\n0\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x [expr $ax*2] -y $ay set x } {} -test font-24.4 {Tk_TextLayoutToPoint procedure: hit a special char (tab)} { +test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} { csetup "000\t000\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x [expr $ax*6] -y 0 set x } {3} -test font-24.5 {Tk_TextLayoutToPoint procedure: ignore newline} { +test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} { csetup "000\n0\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x [expr $ax*2] -y $ay set x } {} -test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} { +test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} { csetup "000\n000 000000000" .b.c itemconfig text -width [expr $ax*10] set x {} @@ -784,42 +1028,42 @@ test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} { set x } {} .b.c itemconfig text -justify center -test font-24.7 {Tk_TextLayoutToPoint procedure: on left side} { +test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} { csetup "0\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x 0 -y 0 set x } {} -test font-24.8 {Tk_TextLayoutToPoint procedure: on right side} { +test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} { csetup "0\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x [expr $ax*2] -y 0 set x } {} -test font-24.9 {Tk_TextLayoutToPoint procedure: inside line} { +test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} { csetup "0\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x $ax -y 0 set x } {0} -test font-24.10 {Tk_TextLayoutToPoint procedure: above line} { +test font-30.10 {Tk_DistanceToTextLayout procedure: above line} { csetup "0\n000" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x 0 -y 0 set x } {} -test font-24.11 {Tk_TextLayoutToPoint procedure: below line} { +test font-30.11 {Tk_DistanceToTextLayout procedure: below line} { csetup "000\n0" set x {} event generate .b.c <Leave> event generate .b.c <Enter> -x 0 -y $ay set x } {} -test font-24.12 {Tk_TextLayoutToPoint procedure: in line} { +test font-30.12 {Tk_DistanceToTextLayout procedure: in line} { csetup "0\n000" set x {} event generate .b.c <Leave> @@ -827,7 +1071,7 @@ test font-24.12 {Tk_TextLayoutToPoint procedure: in line} { set x } {3} .b.c itemconfig text -justify left -test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} { +test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} { csetup "000" set x {} event generate .b.c <Leave> @@ -835,27 +1079,27 @@ test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} { set x } {1} -test font-25.1 {Tk_TextLayoutToArea procedure: loop once} { +test font-31.1 {Tk_IntersectTextLayout procedure: loop once} { csetup "000\n000\n000" .b.c find overlapping 0 0 0 0 } [.b.c find withtag text] -test font-25.2 {Tk_TextLayoutToArea procedure: loop multiple} { +test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} { csetup "000\t000\t000" .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0 } [.b.c find withtag text] -test font-25.3 {Tk_TextLayoutToArea procedure: loop to end} { +test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} { csetup "0\n000" .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0 } {} -test font-25.4 {Tk_TextLayoutToArea procedure: hit a special char (tab)} { +test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} { csetup "000\t000" .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0 } [.b.c find withtag text] -test font-25.5 {Tk_TextLayoutToArea procedure: ignore newlines} { +test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} { csetup "000\n0\n000" .b.c find overlapping $ax $ay $ax $ay } {} -test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} { +test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} { 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] @@ -863,7 +1107,7 @@ test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} { set x } {} -test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} { +test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} { # If there were a whole bunch of returns or tabs in a row, then the # temporary buffer could overflow and write on the stack. @@ -910,29 +1154,19 @@ test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} { (end) } -test font-27.1 {Tk_TextWidth procedure} { - font measure [.b.l cget -font] "000" -} [expr $ax*3] - -test font-28.1 {SetupFontMetrics procedure} { - setup - .b.f config -font $fixed +test font-33.1 {Tk_TextWidth procedure} { } {} -test font-29.1 {TkInitFontAttributes procedure} { +test font-33.2 {ConfigAttributesObj procedure: arguments} { + # (Tcl_GetIndexFromObj() != TCL_OK) setup - font create xyz - font config xyz -} {-family {} -size 0 -weight normal -slant roman -underline 0 -overstrike 0} - -test font-30.1 {ConfigAttributes procedure: arguments} { + list [catch {font create xyz -xyz} msg] $msg +} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}} +test font-34.1 {ConfigAttributesObj procedure: arguments} { + # (objc & 1) setup list [catch {font create xyz -family} msg] $msg -} {1 {missing value for "-family" option}} -test font-30.2 {ConfigAttributes procedure: arguments} { - setup - list [catch {font create xyz -xyz xyz} msg] $msg -} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}} +} {1 {value for "-family" option missing}} set i 3 foreach p { {family xyz times} @@ -943,7 +1177,7 @@ foreach p { {overstrike 0 1} } { set opt [lindex $p 0] - test font-30.$i "ConfigAttributes procedure: $opt" { + test font-34.$i "ConfigAttributesObj procedure: $opt" { setup set x {} font create xyz -$opt [lindex $p 1] @@ -955,27 +1189,37 @@ foreach p { } foreach p { {size xyz {1 {expected integer but got "xyz"}}} - {weight xyz {1 {bad -weight value "xyz": must be normal, bold}}} - {slant xyz {1 {bad -slant value "xyz": must be roman, italic}}} + {weight xyz {1 {bad -weight value "xyz": must be normal, or bold}}} + {slant xyz {1 {bad -slant value "xyz": must be roman, or italic}}} {underline xyz {1 {expected boolean value but got "xyz"}}} {overstrike xyz {1 {expected boolean value but got "xyz"}}} } { - test font-30.$i "ConfigAttributes procedure: [lindex $p 0]" { + test font-34.$i "ConfigAttributesObj procedure: [lindex $p 0]" { setup list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg } [lindex $p 2] incr i } -test font-31.1 {GetAttributeInfo procedure: error} { - list [catch {font actual xyz -style} msg] $msg -} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}} -test font-31.2 {GetAttributeInfo procedure: all attributes} { +test font-35.1 {GetAttributeInfoObj procedure: one attribute} { + # (objPtr != NULL) + setup + font create xyz -family xyz + font config xyz -family +} {xyz} +test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} { + # (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 create xyz -family xyz font config xyz } {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0} -set i 3 +set i 4 foreach p { {family xyz xyz} {size 20 20} @@ -993,100 +1237,153 @@ foreach p { } # In tests below, one field is set to "xyz" so that font name doesn't -# look like a native X font, so that ParseFontName or TkParseXLFD will +# look like a native X font, so that ParseFontNameObj or TkParseXLFD will # be called. setup -test font-32.1 {ParseFontName procedure: begins with -} { +test font-38.1 {ParseFontNameObj procedure: begins with -} { lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1 } $times -test font-32.2 {ParseFontName procedure: begins with -*} { +test font-38.2 {ParseFontNameObj procedure: begins with -*} { lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1 } $times -test font-32.3 {ParseFontName procedure: begins with -, doesn't look like list} { +test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} { lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1 } $times -test font-32.4 {ParseFontName procedure: begins with -, looks like list} { +test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} { lindex [font actual {-family times}] 1 } $times -test font-32.5 {ParseFontName procedure: begins with *} { +test font-38.5 {ParseFontNameObj procedure: begins with *} { lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1 } $times -test font-32.6 {ParseFontName procedure: begins with *} { +test font-38.6 {ParseFontNameObj procedure: begins with *} { font actual *-times-xyz -family } $times -test font-32.7 {ParseFontName procedure: arguments} { - list [catch {font actual {}} msg] $msg +test font-38.7 {ParseFontNameObj procedure: arguments} { + list [catch {font actual "\{xyz"} msg] $msg +} [list 1 "font \"{xyz\" doesn't exist"] +test font-38.8 {ParseFontNameObj procedure: arguments} { + list [catch {font actual ""} msg] $msg } {1 {font "" doesn't exist}} -test font-32.8 {ParseFontName procedure: arguments} { +test font-38.9 {ParseFontNameObj procedure: arguments} { list [catch {font actual {times 20 xyz xyz}} msg] $msg } {1 {unknown font style "xyz"}} -test font-32.9 {ParseFontName procedure: arguments} { +test font-38.10 {ParseFontNameObj procedure: arguments} { list [catch {font actual {times xyz xyz}} msg] $msg } {1 {expected integer but got "xyz"}} -test font-32.10 {ParseFontName procedure: stylelist loop} {macOnly} { +test font-38.11 {ParseFontNameObj procedure: stylelist loop} {macOnly} { lrange [font actual {times 12 bold italic overstrike underline}] 4 end } {-weight bold -slant italic -underline 1 -overstrike 0} -test font-32.11 {ParseFontName procedure: stylelist loop} {unixOrPc} { +test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} { lrange [font actual {times 12 bold italic overstrike underline}] 4 end } {-weight bold -slant italic -underline 1 -overstrike 1} -test font-32.12 {ParseFontName procedure: stylelist error} { +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-33.1 {TkParseXLFD procedure: initial dash} { +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} { font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family } $times -test font-33.2 {TkParseXLFD procedure: no initial dash} { +test font-40.2 {TkFontParseXLFD procedure: no initial dash} { font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family } $times -test font-33.3 {TkParseXLFD procedure: not enough fields} { +test font-40.3 {TkFontParseXLFD procedure: not enough fields} { font actual -xyz-times-*-*-* -family } $times -test font-33.4 {TkParseXLFD procedure: all fields unspecified} { +test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} { lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0 } {-family} -test font-33.5 {TkParseXLFD procedure: all fields specified} { +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-33.6 {TkParseXLFD procedure: arguments} { +test font-41.1 {TkParseXLFD procedure: arguments} { # XLFD with bad pointsize: fallback to some system font. font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-* set x {} } {} -test font-33.7 {TkParseXLFD procedure: arguments} { +test font-42.1 {TkFontParseXLFD procedure: arguments} { # XLFD with bad pixelsize: fallback to some system font. font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-* set x {} } {} -test font-33.8 {TkParseXLFD procedure: pixelsize specified} { +test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} { font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace set x {} } {} -test font-33.9 {TkParseXLFD procedure: weird pixelsize specified} { +test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} { font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace set x {} } {} -test font-33.10 {TkParseXLFD procedure: pointsize specified} { +test font-42.4 {TkFontParseXLFD procedure: pointsize specified} { font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace set x {} } {} -test font-33.11 {TkParseXLFD procedure: weird pointsize specified} { +test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} { font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace set x {} } {} -test font-34.1 {FieldSpecified procedure: specified vs. non-specified} { +test font-43.1 {FieldSpecified procedure: specified vs. non-specified} { font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-* font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-* font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-* lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1 } $times -test font-35.1 {NewChunk procedure: test realloc} { - .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t" -} {} +set oldscale [tk scaling] +tk scaling 0.5 +test font-44.1 {TkFontGetPixels: size < 0} { + font actual {times -12} -size +} {24} +test font-44.2 {TkFontGetPixels: size >= 0} { + font actual {times 12} -size +} {12} + +test font-45.1 {TkFontGetPoints: size >= 0} { + font actual {times 12} -size +} {12} +test font-45.2 {TkFontGetPoints: size < 0} { + font actual {times -12} -size +} {24} + +tk scaling $oldscale + +test font-46.1 {TkFontGetAliasList: no match} { + font actual {snarky 10} -family +} [font actual {-size 10} -family] +test font-46.2 {TkFontGetAliasList: match} {macOnly} { + # Result could be either "Times" or "New York" + font actual {{times new roman} 10} -family +} [font actual {times 10} -family] +test font-46.3 {TkFontGetAliasList: match} {pcOnly} { + font actual {times 10} -family +} {Times New Roman} +test font-46.4 {TkFontGetAliasList: match} {unixOnly} { + font actual {{times new roman} 10} -family +} [font actual {times 10} -family] + +setup destroy .b + +# cleanup +::tcltest::cleanupTests return + + + + + + + + + + + + + diff --git a/tests/frame.test b/tests/frame.test index 7e3d8da..370f674 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -4,14 +4,13 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: frame.test,v 1.2 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: frame.test,v 1.3 1999/04/16 01:51:37 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -615,3 +614,20 @@ test frame-11.2 {TkInstallFrameMenu - frame renamed} { catch {destroy .f} rename eatColors {} rename colorsFree {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/geometry.test b/tests/geometry.test index 0785ab1..615ccc7 100644 --- a/tests/geometry.test +++ b/tests/geometry.test @@ -4,14 +4,13 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: geometry.test,v 1.2 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: geometry.test,v 1.3 1999/04/16 01:51:37 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -247,5 +246,22 @@ test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { update winfo ismapped .t.quit } {1} + catch {destroy .t} -concat + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/get.test b/tests/get.test new file mode 100644 index 0000000..bf6dc44 --- /dev/null +++ b/tests/get.test @@ -0,0 +1,97 @@ +# This file is a Tcl script to test out the procedures in the file +# tkGet.c. It is organized in the standard fashion for Tcl +# white-box tests. +# +# Copyright (c) 1998 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: get.test,v 1.2 1999/04/16 01:51:38 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +eval destroy [winfo children .] +wm geometry . {} +raise . + +button .b +test get-1.1 {Tk_GetAnchorFromObj} { + .b configure -anchor n + .b cget -anchor +} {n} +test get-1.2 {Tk_GetAnchorFromObj} { + .b configure -anchor ne + .b cget -anchor +} {ne} +test get-1.3 {Tk_GetAnchorFromObj} { + .b configure -anchor e + .b cget -anchor +} {e} +test get-1.4 {Tk_GetAnchorFromObj} { + .b configure -anchor se + .b cget -anchor +} {se} +test get-1.5 {Tk_GetAnchorFromObj} { + .b configure -anchor s + .b cget -anchor +} {s} +test get-1.6 {Tk_GetAnchorFromObj} { + .b configure -anchor sw + .b cget -anchor +} {sw} +test get-1.7 {Tk_GetAnchorFromObj} { + .b configure -anchor w + .b cget -anchor +} {w} +test get-1.8 {Tk_GetAnchorFromObj} { + .b configure -anchor nw + .b cget -anchor +} {nw} +test get-1.9 {Tk_GetAnchorFromObj} { + .b configure -anchor n + .b cget -anchor +} {n} +test get-1.10 {Tk_GetAnchorFromObj} { + .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}} + +catch {destroy .b} +button .b +test get-2.1 {Tk_GetJustifyFromObj} { + .b configure -justify left + .b cget -justify +} {left} +test get-2.2 {Tk_GetJustifyFromObj} { + .b configure -justify right + .b cget -justify +} {right} +test get-2.3 {Tk_GetJustifyFromObj} { + .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 +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/grid.test b/tests/grid.test index 85464d7..ed0a455 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -3,14 +3,13 @@ # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: grid.test,v 1.3 1999/01/06 21:10:46 stanton Exp $ +# RCS: @(#) $Id: grid.test,v 1.4 1999/04/16 01:51:38 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source ../tests/defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} # helper routine to return "." to a sane state after a test # The variable GRID_VERBOSE can be used to "look" at the result @@ -319,7 +318,7 @@ test grid-6.8 {location (weights)} { } {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}} grid_reset 6.8 -test grid-6.9 {location: check updates pending} { +test grid-6.9 {location: check updates pending} {nonPortable} { set a "" foreach i {0 1 2} { frame .$i -width 120 -height 75 -bg red @@ -989,23 +988,26 @@ test grid-14.2 {structure notify} { } {{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} { - global A - catch {unset A} - bind . <Configure> {incr A(%W)} - set A(.) 0 - foreach i {0 1 2} { - frame .$i -width 100 -height 75 - set A(.$i) 0 - } - grid .0 .1 .2 - update - bind <Configure> .1 {destroy .0} - .2 configure -bd 10 - update - bind . <Configure> {} - array get A -} {.2 2 .0 1 . 1 .1 1} +test grid-14.3 {map notify: bug 1648} {nonPortable} { + # This test is nonPortable because the number of times + # A(.) will be incremented is unspecified--the behavior + # is different accross window managers. + global A + catch {unset A} + bind . <Configure> {incr A(%W)} + set A(.) 0 + foreach i {0 1 2} { + frame .$i -width 100 -height 75 + set A(.$i) 0 + } + grid .0 .1 .2 + update + bind <Configure> .1 {destroy .0} + .2 configure -bd 10 + update + bind . <Configure> {} + array get A +} {.2 2 .0 1 . 2 .1 1} grid_reset 14.3 test grid-15.1 {lost slave} { @@ -1212,3 +1214,20 @@ test grid-17.1 {forget and pending idle handlers} { destroy .t set result ok } ok + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/id.test b/tests/id.test index b1c2ea9..8c12a50 100644 --- a/tests/id.test +++ b/tests/id.test @@ -3,19 +3,19 @@ # the standard fashion for Tcl tests. # # Copyright (c) 1995 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: id.test,v 1.3 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: id.test,v 1.4 1999/04/16 01:51:38 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[string compare testwrapper [info commands testwrapper]] != 0} { puts "This application hasn't been compiled with the testwrapper command," puts "therefore I am skipping all of these tests." + ::tcltest::cleanupTests return } @@ -100,3 +100,20 @@ test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly} { 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 +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/image.test b/tests/image.test index 468865d..e3f7841 100644 --- a/tests/image.test +++ b/tests/image.test @@ -4,23 +4,23 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: image.test,v 1.2 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: image.test,v 1.3 1999/04/16 01:51:38 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -355,3 +355,20 @@ test image-13.1 {image command vs hidden commands} { destroy .c eval image delete [image names] + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/imgBmap.test b/tests/imgBmap.test index 337a136..ffdafeb 100644 --- a/tests/imgBmap.test +++ b/tests/imgBmap.test @@ -4,14 +4,13 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: imgBmap.test,v 1.2 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: imgBmap.test,v 1.3 1999/04/16 01:51:38 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -472,3 +471,20 @@ removeFile foo.bm removeFile foo2.bm destroy .c eval image delete [image names] + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/imgPPM.test b/tests/imgPPM.test index f9ffc9e..00abf33 100644 --- a/tests/imgPPM.test +++ b/tests/imgPPM.test @@ -3,14 +3,13 @@ # 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. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: imgPPM.test,v 1.2 1998/09/14 18:23:47 stanton Exp $ +# RCS: @(#) $Id: imgPPM.test,v 1.3 1999/04/16 01:51:38 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -154,3 +153,20 @@ test imgPPM-3.13 {ReadPPMFileHeader procedure, file ends too soon} { removeFile test.ppm removeFile test2.ppm eval image delete [image names] + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test index d3a9dcc..0ee4489 100644 --- a/tests/imgPhoto.test +++ b/tests/imgPhoto.test @@ -4,16 +4,15 @@ # # Copyright (c) 1994 The Australian National University # Copyright (c) 1994-1997 Sun Microsystems, Inc. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # # Author: Paul Mackerras (paulus@cs.anu.edu.au) # -# RCS: @(#) $Id: imgPhoto.test,v 1.3 1998/12/07 23:29:00 hershey Exp $ +# RCS: @(#) $Id: imgPhoto.test,v 1.4 1999/04/16 01:51:38 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -28,13 +27,20 @@ canvas .c pack .c update +# temporarily copy the README fiel from testsDir to tmpDir +if {![file exists README]} { + set newREADME [file join $::tcltest::workingDir README] + file copy [file join $::tcltest::testsDir README] $newREADME + set removeREADME 1 +} + # find the teapot.ppm file for use in these tests # first look in $tk_library/demos/images/teapot.ppm # then look in <this file>/../../library/demos/images/teapot.ppm # skip this file if you can't find the teapot.ppm file. set teapotPhotoFile [file join $tk_library demos images teapot.ppm] if {![file exists $teapotPhotoFile]} { - set newLib [file dirname [file dirname [info script]]] + set newLib [file dirname $::tcltest::testsDir] set teapotPhotoFile \ [file join $newLib library demos images teapot.ppm] if {![file exists $teapotPhotoFile]} { @@ -432,3 +438,23 @@ test imgPhoto-13.1 {check separation of images in different interpreters} { destroy .c eval image delete [image names] + +# cleanup +if {[info exists removeREADME]} { + catch {file delete -force $newREADME} +} +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/listbox.test b/tests/listbox.test index c2b1447..3c124df 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -3,14 +3,14 @@ # # Copyright (c) 1993-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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: listbox.test,v 1.2 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: listbox.test,v 1.3 1999/04/16 01:51:38 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} foreach i [winfo children .] { destroy $i @@ -1656,3 +1656,19 @@ catch {destroy .e} catch {destroy .partial} option clear +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/macEmbed.test b/tests/macEmbed.test index 90b7161..67a77a0 100644 --- a/tests/macEmbed.test +++ b/tests/macEmbed.test @@ -3,18 +3,13 @@ # tests. # # Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: macEmbed.test,v 1.3 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: macEmbed.test,v 1.4 1999/04/16 01:51:38 stanton Exp $ -if {$tcl_platform(platform) != "macintosh"} { - return -} - -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } eval destroy [winfo children .] @@ -22,11 +17,11 @@ wm geometry . {} raise . -test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} { +test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} { catch {destroy .t} list [catch {toplevel .t -use xyz} msg] $msg } {1 {expected integer but got "xyz"}} -test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} { +test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} { catch {destroy .t} list [catch {toplevel .t -use 47} msg] $msg } {1 {The window ID 47 does not correspond to a valid Tk Window.}} @@ -34,10 +29,11 @@ test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} { if {[string compare testembed [info commands testembed]] != 0} { puts "This application hasn't been compiled with the testembed command," puts "therefore I am skipping all of these tests." + ::tcltest::cleanupTests return } -test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} { +test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} { eval destroy [winfo child .] frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 @@ -46,7 +42,7 @@ test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} { toplevel .t -use $w list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w] } {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0} -test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} { +test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly} { eval destroy [winfo child .] frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 @@ -61,7 +57,7 @@ test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} { # Can't think of any way to test the procedures TkpMakeWindow, # TkpMakeContainer, or EmbedErrorProc. -test macEmbed-2.1 {EmbeddedEventProc procedure} { +test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -74,7 +70,7 @@ test macEmbed-2.1 {EmbeddedEventProc procedure} { update testembed } {} -test macEmbed-2.2 {EmbeddedEventProc procedure} { +test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -85,7 +81,7 @@ test macEmbed-2.2 {EmbeddedEventProc procedure} { destroy .f1 testembed } {} -test macEmbed-2.3 {EmbeddedEventProc procedure} { +test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -98,7 +94,7 @@ test macEmbed-2.3 {EmbeddedEventProc procedure} { list [testembed] [winfo children .] } {{} {}} -test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} { +test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -110,7 +106,8 @@ test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} { wm withdraw .t1 list $x [testembed] } {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}} -test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} { +test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \ + {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -123,7 +120,8 @@ test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} { update wm geometry .t1 } {200x200+0+0} -test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} { +test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \ + {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -136,7 +134,7 @@ test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} { update wm geometry .t1 } {300x100+0+0} -test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} { +test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -148,7 +146,7 @@ test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} { update list [winfo width .t1] [winfo height .t1] [wm geometry .t2] } {300 80 300x80+0+0} -test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} { +test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -163,7 +161,7 @@ test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} { update set x } {mapped} -test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} { +test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -179,7 +177,7 @@ test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} { list $x [winfo exists .f1] } {dead 0} -test macEmbed-4.1 {EmbedStructureProc procedure, configure events} { +test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -192,7 +190,7 @@ test macEmbed-4.1 {EmbedStructureProc procedure, configure events} { update winfo geometry .t1 } {180x100+0+0} -test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} { +test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -208,7 +206,7 @@ test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} { # Can't think up any tests for TkpGetOtherWindow procedure. -test unixEmbed-5.1 {TkpClaimFocus procedure} {tempNotMac} { +test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} { catch {interp delete child} foreach w [winfo child .] { catch {destroy $w} @@ -233,7 +231,7 @@ test unixEmbed-5.1 {TkpClaimFocus procedure} {tempNotMac} { } {{{} .} .f1} catch {interp delete child} -test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} { +test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -250,7 +248,7 @@ test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} { } set x } {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}} -test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} { +test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -265,7 +263,7 @@ test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} { lappend x [testembed] } {{{XXX .f1 XXX .t1}} {}} -test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} { +test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -277,7 +275,7 @@ test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} { update wm geometry .t1 } {150x80+0+0} -test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} { +test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} { foreach w [winfo child .] { catch {destroy $w} } @@ -295,3 +293,20 @@ test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} { foreach w [winfo child .] { catch {destroy $w} } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/macFont.test b/tests/macFont.test index 8c6d0ae..7bec629 100644 --- a/tests/macFont.test +++ b/tests/macFont.test @@ -7,28 +7,30 @@ # but there are no results that can be checked. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: macFont.test,v 1.2 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: macFont.test,v 1.3 1999/04/16 01:51:38 stanton Exp $ -if {$tcl_platform(platform)!="macintosh"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {[string compare test [info procs test]] != 0} { - source defs +if {$tcl_platform(platform)!="macintosh"} { + puts "skipping: Mac only tests..." + ::tcltest::cleanupTests + return } catch {destroy .b} toplevel .b update idletasks -set courier {Courier 10} +set courier {Courier 12} set cx [font measure $courier 0] -label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9" +set fixed {Monaco 12} +label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font $fixed pack .b.l canvas .b.c -closeenough 0 @@ -43,125 +45,226 @@ proc getsize {} { return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" } -test macfont-1.1 {TkpGetNativeFont procedure: not native} { +set ::tcltest::testConfig(gothic) 0 +set gothic {gothic 12} +set mx [font measure $gothic \u4e4e] +if {[font actual $gothic -family] != [font actual system -family]} { + set ::tcltest::testConfig(gothic) 1 +} + +test macFont-1.1 {TkpFontPkgInit} { +} {} + +test macfont-2.1 {TkpGetNativeFont: not native} { list [catch {font measure {} xyz} msg] $msg } {1 {font "" doesn't exist}} -test macfont-1.2 {TkpGetNativeFont procedure: native} { +test macFont-2.2 {TkpGetNativeFont: native} { font measure system "0" font measure application "0" set x {} } {} -test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} { +test macFont-3.1 {TkpGetFontFromAttributes: no family} { font actual {-underline 1} -family } [font actual system -family] -test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} { +test macFont-3.2 {TkpGetFontFromAttributes: long family name} { set x "12345678901234567890123456789012345678901234567890" set x "$x$x$x$x$x$x" font actual "-family $x" -family } [font actual system -family] -test macfont-2.3 {TkpGetFontFromAttributes procedure: family} { +test macFont-3.3 {TkpGetFontFromAttributes: family} { font actual {-family Courier} -family } {Courier} -test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} { +test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} { set x {} lappend x [font actual {-family "Times"} -family] lappend x [font actual {-family "Times New Roman"} -family] } {Times Times} -test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} { +test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} { set x {} lappend x [font actual {-family "Courier"} -family] lappend x [font actual {-family "Courier New"} -family] } {Courier Courier} -test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} { +test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} { set x {} lappend x [font actual {-family "Geneva"} -family] lappend x [font actual {-family "Helvetica"} -family] lappend x [font actual {-family "Arial"} -family] } {Geneva Helvetica Helvetica} -test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.7 {TkpGetFontFromAttributes: try aliases} { + font actual {arial 10} -family +} {Helvetica} +test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} { + font actual {{ms sans serif} 10} -family +} {Chicago} +test macFont-3.9 {TkpGetFontFromAttributes: styles} { font actual {-weight normal} -weight } {normal} -test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.10 {TkpGetFontFromAttributes: styles} { font actual {-weight bold} -weight } {bold} -test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.11 {TkpGetFontFromAttributes: styles} { font actual {-slant roman} -slant } {roman} -test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.12 {TkpGetFontFromAttributes: styles} { font actual {-slant italic} -slant } {italic} -test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.13 {TkpGetFontFromAttributes: styles} { font actual {-underline false} -underline } {0} -test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.14 {TkpGetFontFromAttributes: styles} { font actual {-underline true} -underline } {1} -test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.15 {TkpGetFontFromAttributes: styles} { font actual {-overstrike false} -overstrike } {0} -test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} { +test macFont-3.16 {TkpGetFontFromAttributes: styles} { font actual {-overstrike true} -overstrike } {0} -test macfont-3.1 {TkpDeleteFont procedure} { +test macFont-4.1 {TkpDeleteFont} { font actual {-family xyz} set x {} } {} -test macfont-4.1 {TkpGetFontFamilies procedure} { - font families - set x {} -} {} +test macFont-5.1 {TkpGetFontFamilies} { + expr {[lsearch [font families] Geneva] > 0} +} {1} + +test macFont-6.1 {TkpGetSubFonts} {gothic} { + .b.l config -text "abc\u4e4e" + update + set x [testfont subfonts $fixed] +} "Monaco [font actual $gothic -family]" -test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} { +test macFont-7.1 {Tk_MeasureChars: unbounded right margin} { .b.l config -wrap 0 -text "000000" getsize } "[expr $ax*6] $ay" -test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} { +test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} { .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" getsize } "[expr $ax*256] $ay" -test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} { +test macFont-7.3 {Tk_MeasureChars: all chars did fit} { .b.l config -wrap [expr $ax*10] -text "00000000" getsize } "[expr $ax*8] $ay" -test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} { +test macFont-7.4 {Tk_MeasureChars: not all chars fit} { .b.l config -wrap [expr $ax*6] -text "00000000" getsize } "[expr $ax*6] [expr $ay*2]" -test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} { +test macFont-7.5 {Tk_MeasureChars: already saw space in line} { .b.l config -wrap [expr $ax*12] -text "000000 0000000" getsize } "[expr $ax*7] [expr $ay*2]" -test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} { +test macFont-7.6 {Tk_MeasureChars: internal spaces significant} { .b.l config -wrap [expr $ax*12] -text "000 00 00000" getsize } "[expr $ax*7] [expr $ay*2]" -test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} { +test macFont-7.7 {Tk_MeasureChars: include last partial char} { .b.c dchars $t 0 end .b.c insert $t 0 "0000" .b.c index $t @[expr int($ax*2.5)],1 } {2} -test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} { +test macFont-7.8 {Tk_MeasureChars: at least one char on line} { .b.l config -text "000000" -wrap 1 getsize } "$ax [expr $ay*6]" -test macfont-5.9 {Tk_MeasureChars procedure: whole words} { +test macFont-7.9 {Tk_MeasureChars: whole words} { .b.l config -wrap [expr $ax*8] -text "000000 0000" getsize } "[expr $ax*6] [expr $ay*2]" -test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} { +test macFont-7.10 {Tk_MeasureChars: make first part of word fit} { .b.l config -wrap [expr $ax*12] -text "0000000000000000" getsize } "[expr $ax*12] [expr $ay*2]" +test macFont-7.11 {Tk_MeasureChars: numBytes == 0} { + font measure system {} +} {0} +test macFont-7.12 {Tk_MeasureChars: maxLength < 0} { + font measure $courier abcd +} "[expr $cx*4]" +test macFont-7.13 {Tk_MeasureChars: loop on each char} { + font measure $courier abcd +} "[expr $cx*4]" +test macFont-7.14 {Tk_MeasureChars: p == end} { + font measure $courier abcd +} "[expr $cx*4]" +test macFont-7.15 {Tk_MeasureChars: p > end} { + font measure $courier abc\xc2 +} "[expr $cx*4]" +test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} { + font measure $courier abc\u4e4edef +} [expr $cx*6+$mx] +test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic} { + font measure $courier \u4e4edef +} [expr $mx+$cx*3] +test macFont-7.18 {Tk_MeasureChars: final measure} {gothic} { + font measure $courier \u4e4edef +} [expr $mx+$cx*3] +test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic} { + font measure $courier \u4e4e +} [expr $mx] +test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} { + .b.l config -wrap [expr $ax*8] -text "000" + getsize +} "[expr $ax*3] $ay" +test macFont-7.21 {Tk_MeasureChars: loop on each char} { + .b.l config -wrap [expr $ax*8] -text "000" + getsize +} "[expr $ax*3] $ay" +test macFont-7.22 {Tk_MeasureChars: p == end} { + .b.l config -wrap [expr $ax*8] -text "000" + getsize +} "[expr $ax*3] $ay" +test macFont-7.23 {Tk_MeasureChars: p > end} { + .b.l config -wrap [expr $ax*8] -text "00\xc2" + getsize +} "[expr $ax*3] $ay" +test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} { + .b.l config -wrap [expr $ax*8] -text "00\u4e4e00" + getsize +} "[expr $ax*4+$mx] $ay" +test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic} { + .b.l config -wrap [expr $ax*8] -text "\u4e4e00" + getsize +} "[expr $mx+$ax*2] $ay" +test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic} { + .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00" + getsize +} "[expr $ax*8+$mx*2] $ay" +test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic} { + .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00" + getsize +} "[expr $ax*5] [expr $ay*3]" +test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic} { + # even some of the "0"s would fit after \u4e4d, they should all wrap to next line. + .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00" + getsize +} "[expr $ax*6+$mx] [expr $ay*3]" +test macFont-7.29 {Tk_MeasureChars: final measure} {gothic} { + .b.l config -wrap [expr $ax*8] -text "\u4e4e00" + getsize +} "[expr $mx+$ax*2] $ay" +test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic} { + .b.l config -wrap [expr $ax*8] -text "\u4e4e" + getsize +} "$mx $ay" +test macFont-7.31 {Tk_MeasureChars: rest == NULL} { + .b.l config -wrap [expr $ax*1000] -text 0000 + getsize +} "[expr $ax*4] $ay" +test macFont-7.32 {Tk_MeasureChars: rest != NULL} { + .b.l config -wrap [expr $ax*6] -text "00000000" + getsize +} "[expr $ax*6] [expr $ay*2]" -test macfont-6.1 {Tk_DrawChars procedure} { +test macFont-8.1 {Tk_DrawChars procedure} { .b.l config -text "a" update } {} -test macfont-7.1 {AllocMacFont procedure: use old font} { +test macFont-9.1 {AllocMacFont: use old font} { font create xyz button .c -font xyz font configure xyz -family times @@ -169,14 +272,31 @@ test macfont-7.1 {AllocMacFont procedure: use old font} { destroy .c font delete xyz } {} -test macfont-7.2 {AllocMacFont procedure: extract info from style} { +test macFont-9.2 {AllocMacFont: extract info from style} { font actual {Monaco 9 bold italic underline overstrike} } {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0} -test macfont-7.3 {AllocMacFont procedure: extract text metrics} { +test macFont-9.3 {AllocMacFont: extract text metrics} { font metric {Geneva 10} -fixed } {0} -test macfont-7.4 {AllocMacFont procedure: extract text metrics} { +test macFont-9.4 {AllocMacFont: extract text metrics} { font metric "Monaco 9" -fixed } {1} destroy .b + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/macMenu.test b/tests/macMenu.test index 3882b0d..b76b7e6 100644 --- a/tests/macMenu.test +++ b/tests/macMenu.test @@ -4,13 +4,18 @@ # system. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: macMenu.test,v 1.2 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: macMenu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {$tcl_platform(platform) != "macintosh"} { + puts "skipping: Mac only tests..." + ::tcltest::cleanupTests return } @@ -18,13 +23,10 @@ if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - proc deleteWindows {} { foreach i [winfo children .] { catch [destroy $i] @@ -1561,5 +1563,20 @@ test macMenu-44.2 {DrawMenuEntryBackground} { test macMenu-45.1 {TkpMenuInit - called at boot time} {} {} +# cleanup deleteWindows +::tcltest::cleanupTests +return + + + + + + + + + + + + diff --git a/tests/macWinMenu.test b/tests/macWinMenu.test index e19fdff..2aad508 100644 --- a/tests/macWinMenu.test +++ b/tests/macWinMenu.test @@ -3,26 +3,27 @@ # the common implementation of Macintosh and Windows menus. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: macWinMenu.test,v 1.2 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: macWinMenu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ -if {$tcl_platform(platform) == "unix"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} +# Some tests require user interaction on non-unix platform +set ::tcltest::testConfig(nonUnixUserInteraction) \ + [expr {$::tcltest::testConfig(userInteraction) || \ + $::tcltest::testConfig(unixOnly)}] proc deleteWindows {} { foreach i [winfo children .] { @@ -34,33 +35,26 @@ deleteWindows wm geometry . {} raise . -if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test." -} - -test macWinMenu-1.1 {PreprocessMenu} { +test macWinMenu-1.1 {PreprocessMenu} {macOrPc nonUnixUserInteraction} { catch {destroy .m1} menu .m1 -postcommand "destroy .m1" .m1 add command -label "macWinMenu-1.1: Hit Escape" list [catch {.m1 post 40 40} msg] $msg } {0 {}} -if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} { - test macWinMenu-1.2 {PreprocessMenu} { - catch {destroy .m1} - catch {destroy .m2} - set foo1 foo - set foo2 foo - menu .m1 -postcommand "set foo1 .m1" - .m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape" - menu .m2 -postcommand "set foo2 .m2" - update idletasks - list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}] - } {0 .m2 .m1 .m2 {} 0 0} -} -test macWinMenu-1.3 {PreprocessMenu} { +test macWinMenu-1.2 {PreprocessMenu} {macOrPc nonUnixUserInteraction} { + catch {destroy .m1} + catch {destroy .m2} + set foo1 foo + set foo2 foo + menu .m1 -postcommand "set foo1 .m1" + .m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape" + menu .m2 -postcommand "set foo2 .m2" + update idletasks + list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] \ + [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}] +} {0 .m2 .m1 .m2 {} 0 0} + +test macWinMenu-1.3 {PreprocessMenu} {macOrPc nonUnixUserInteraction} { catch {destroy .l1} catch {destroy .m1} catch {destroy .m2} @@ -76,7 +70,7 @@ test macWinMenu-1.3 {PreprocessMenu} { update idletasks list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3] } {0 {} {}} -test macWinMenu-1.4 {PreprocessMenu} { +test macWinMenu-1.4 {PreprocessMenu} {macOrPc} { catch {destroy .l1} catch {destroy .m1} catch {destroy .m2} @@ -95,7 +89,7 @@ test macWinMenu-1.4 {PreprocessMenu} { update idletasks list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3 .m4] } {0 {} {}} -test macWinMenu-1.5 {PreprocessMenu} { +test macWinMenu-1.5 {PreprocessMenu} {macOrPc} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -104,14 +98,28 @@ test macWinMenu-1.5 {PreprocessMenu} { list [catch {.m1 post 40 40} msg] $msg [destroy .m1 .m2] } {1 {invalid command name "glorp"} {}} -if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} { - test macWinMenu-2.1 {TkPreprocessMenu} { - catch {destroy .m1} - set foo test - menu .m1 -postcommand "set foo 2.1" - .m1 add command -label "macWinMenu-2.1: Hit Escape" - list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo] - } {0 2.1 2.1 {} {}} -} +test macWinMenu-2.1 {TkPreprocessMenu} {macOrPc nonUnixUserInteraction} { + catch {destroy .m1} + set foo test + menu .m1 -postcommand "set foo 2.1" + .m1 add command -label "macWinMenu-2.1: Hit Escape" + list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo] +} {0 2.1 2.1 {} {}} +# cleanup deleteWindows +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/macscrollbar.test b/tests/macscrollbar.test index c13198a..4abf137 100644 --- a/tests/macscrollbar.test +++ b/tests/macscrollbar.test @@ -4,17 +4,20 @@ # Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: macscrollbar.test,v 1.2 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: macscrollbar.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ -# Only run this test on the Macintosh -if {$tcl_platform(platform) != "macintosh"} return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} -if {[info procs test] != "test"} { - source defs +# Only run this test on the Macintosh +if {$tcl_platform(platform) != "macintosh"} { + puts "skipping: Mac only tests..." + ::tcltest::cleanupTests + return } foreach i [winfo children .] { @@ -98,4 +101,20 @@ test macscroll-1.7 {TkpDisplayScrollbar procedure} { foreach i [winfo children .] { destroy $i } -concat {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/main.test b/tests/main.test index 5db6ed5..0422223 100644 --- a/tests/main.test +++ b/tests/main.test @@ -5,14 +5,13 @@ # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: main.test,v 1.4 1999/02/04 21:03:28 stanton Exp $ +# RCS: @(#) $Id: main.test,v 1.5 1999/04/16 01:51:39 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } test main-1.1 {StdinProc} {unixOnly} { @@ -22,7 +21,7 @@ test main-1.1 {StdinProc} {unixOnly} { close stdin; exit } close $fd - if {[catch {exec $tktest <script} msg]} { + if {[catch {exec $::tcltest::tktest <script} msg]} { set error 1 } else { set error 0 @@ -31,7 +30,20 @@ test main-1.1 {StdinProc} {unixOnly} { list $error $msg } {0 {}} -# -# Clean up. -# +# cleanup catch {removeFile script} +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/menu.test b/tests/menu.test index a4399b5..7b8ba02 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -2,32 +2,27 @@ # organized in the standard fashion for Tcl tests. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: menu.test,v 1.2 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: menu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - -if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test." - set testConfig(menuInteractive) 0 -} else { - set testConfig(menuInteractive) 1 -} +# Some tests require user interaction on non-unix platform +set ::tcltest::testConfig(nonUnixUserInteraction) \ + [expr {$::tcltest::testConfig(userInteraction) || \ + $::tcltest::testConfig(unixOnly)}] proc deleteWindows {} { foreach i [winfo children .] { @@ -164,16 +159,16 @@ test menu-1.14 {Tk_MenuCmd procedure} { catch {destroy .m1} menu .m1 set i 1 -foreach test { +foreach configTest { {-activebackground #012345 #012345 non-existent {unknown color name "non-existent"}} - {-activeborderwidth 1.3 1 badValue {bad screen distance "badValue"}} + {-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 badValue {bad screen distance "badValue"}} + {-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"}} @@ -182,23 +177,27 @@ foreach test { {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 type "1.5": must be flat, groove, raised, ridge, solid, or sunken}} + {-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 $test 0] - test menu-2.$i {configuration options} { - .m1 configure $name [lindex $test 1] + 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 - } [lindex $test 2] + } $result incr i - if {[lindex $test 3] != ""} { - test menu-2.$i {configuration options} { - list [catch {.m1 configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] + 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 @@ -221,7 +220,7 @@ menu .m2 .m1 add radiobutton -label "radiobutton" -variable radio image create photo image1 -file [file join $tk_library demos images earth.gif] -foreach test { +foreach configTest { {-activebackground {{#012345 {{unknown option "-activebackground"} #012345 #012345 @@ -240,7 +239,7 @@ foreach test { } {-activeforeground {{#ff0000 - {{unknown option "-activeforeground"} + {{unknown option "-activeforeground"} #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000 } } @@ -256,7 +255,7 @@ foreach test { } {-accelerator {{"Ctrl+S" - {{unknown option "-accelerator"} + {{unknown option "-accelerator"} "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"} "Ctrl+S" "Ctrl+S" } @@ -279,8 +278,8 @@ foreach test { } {-bitmap {{questhead - {{unknown option "-bitmap"} questhead questhead - {unknown option "-bitmap"} questhead questhead + {{unknown option "-bitmap"} questhead questhead + {unknown option "-bitmap"} questhead questhead } } {badValue @@ -295,22 +294,23 @@ foreach test { } {-columnbreak {{1 - {{unknown option "-columnbreak"} 1 1 {unknown option "-columnbreak"} 1 1} + {{unknown option "-columnbreak"} 1 1 + {unknown option "-columnbreak"} 1 1} }} } {-command {{beep - {{unknown option "-command"} beep beep - {unknown option "-command"} beep beep + {{unknown option "-command"} beep beep + {unknown option "-command"} beep beep } }} } {-font {{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - {{unknown option "-font"} + {{unknown option "-font"} -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - {unknown option "-font"} + {unknown option "-font"} -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* } @@ -327,8 +327,8 @@ foreach test { } {-foreground {{#110022 - {{unknown option "-foreground"} #110022 #110022 - {unknown option "-foreground"} #110022 #110022 + {{unknown option "-foreground"} #110022 #110022 + {unknown option "-foreground"} #110022 #110022 } } {non-existent @@ -343,8 +343,8 @@ foreach test { } {-image {{image1 - {{unknown option "-image"} image1 image1 - {unknown option "-image"} image1 image1 + {{unknown option "-image"} image1 image1 + {unknown option "-image"} image1 image1 } } {bogus @@ -368,58 +368,58 @@ foreach test { } {-indicatoron {{1 - {{unknown option "-indicatoron"} - {unknown option "-indicatoron"} - {unknown option "-indicatoron"} - {unknown option "-indicatoron"} 1 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 + {{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"} + {{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"} + {unknown option "-offvalue"} {unknown option "-offvalue"} - {unknown option "-offvalue"} off - {unknown option "-offvalue"} + {unknown option "-offvalue"} } }} } {-onvalue {{on - {{unknown option "-onvalue"} - {unknown option "-onvalue"} - {unknown option "-onvalue"} - {unknown option "-onvalue"} + {{unknown option "-onvalue"} + {unknown option "-onvalue"} + {unknown option "-onvalue"} + {unknown option "-onvalue"} on - {unknown option "-onvalue"} + {unknown option "-onvalue"} } }} } {-selectcolor {{#110022 - {{unknown option "-selectcolor"} - {unknown option "-selectcolor"} - {unknown option "-selectcolor"} - {unknown option "-selectcolor"} + {{unknown option "-selectcolor"} + {unknown option "-selectcolor"} + {unknown option "-selectcolor"} + {unknown option "-selectcolor"} #110022 #110022 } @@ -463,8 +463,7 @@ foreach test { } {-state {{normal - {normal normal normal - {unknown option "-state"} normal normal + {normal normal normal {unknown option "-state"} normal normal } }} } @@ -506,13 +505,13 @@ foreach test { }} } } { - set name [lindex $test 0] - foreach attempt [lindex $test 1] { + 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} - test menu-2.$i [list entry configuration options $name $item $value] { + test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] { set result [catch {.m1 entryconfigure $item $name $value} msg] if {$result == 1} { set msg @@ -534,7 +533,7 @@ test menu-3.1 {MenuWidgetCmd procedure} { 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} {menuInteractive} { +test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {nonUnixUserInteraction } { catch {destroy .m1} menu .m1 -postcommand "destroy .m1" .m1 add command -label "menu-3.2: Hit Escape" @@ -551,21 +550,21 @@ test menu-3.4 {MenuWidgetCmd procedure, "activate" option} { 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} { +test menu-3.5 {MenuWidgetCmd procedure, "activate" option} { catch {destroy .m1} 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} { +test menu-3.6 {MenuWidgetCmd procedure, "activate" option} { catch {destroy .m1} 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} { +test menu-3.7 {MenuWidgetCmd procedure, "activate" option} { catch {destroy .m1} menu .m1 .m1 add command -label "test" @@ -805,7 +804,7 @@ test menu-3.49 {MenuWidgetCmd procedure, "post" option} { 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} {menuInteractive} { +test menu-3.50 {MenuWidgetCmd procedure, "post" option} {nonUnixUserInteraction } { catch {destroy .m1} menu .m1 .m1 add command -label "menu-3.53: hit Escape" -command "puts hello" @@ -821,7 +820,7 @@ test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} { 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} {menuInteractive} { +test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -890,7 +889,7 @@ test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} { 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} {menuInteractive} { +test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } { catch {destroy .m1} menu .m1 .m1 add command -label "menu-3.68 - hit Escape" @@ -913,19 +912,27 @@ test menu-3.67 {MenuWidgetCmd procedure, bad option} { 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, or yposition} {}} -test menu-4.1 {TkInvokeMenu} { +test menu-4.1 {TkInvokeMenu: disabled} { + catch {destroy .m1} + 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.2 {TkInvokeMenu} { +test menu-4.3 {TkInvokeMenu: checkbutton -on} { catch {destroy .m1} 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.3 {TkInvokeMenu} { +test menu-4.4 {TkInvokeMenu: checkbutton -off} { catch {destroy .m1} catch {unset foo} menu .m1 @@ -933,7 +940,14 @@ test menu-4.3 {TkInvokeMenu} { .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.4 {TkInvokeMenu} { +test menu-4.5 {TkInvokeMenu: checkbutton array element} { + catch {destroy .m1} + 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} catch {unset foo} menu .m1 @@ -942,7 +956,7 @@ test menu-4.4 {TkInvokeMenu} { .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.5 {TkInvokeMenu} { +test menu-4.7 {TkInvokeMenu: radiobutton} { catch {destroy .m1} catch {unset foo} menu .m1 @@ -951,7 +965,7 @@ test menu-4.5 {TkInvokeMenu} { .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.6 {TkInvokeMenu} { +test menu-4.8 {TkInvokeMenu: radiobutton} { catch {destroy .m1} catch {unset foo} menu .m1 @@ -960,20 +974,29 @@ test menu-4.6 {TkInvokeMenu} { .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.7 {TkInvokeMenu} { +test menu-4.9 {TkInvokeMenu: radiobutton array element} { + catch {destroy .m1} + 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} 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.8 {TkInvokeMenu} { +test menu-4.11 {TkInvokeMenu} { catch {destroy .m1} menu .m1 .m1 add cascade -label "test" -menu .m1.m2 list [catch {.m1 invoke 1} msg] $msg [destroy .m1] } {0 {} {}} -test menu-4.9 {TkInvokeMenu} { +test menu-4.12 {TkInvokeMenu} { catch {destroy .m1} menu .m1 .m1 add command -label "test" -command ".m1 delete 1" @@ -1431,44 +1454,60 @@ test menu-9.9 {ConfigureMenu} { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test menu-10.1 {ConfigureMenuEntry} { +test menu-10.1 {PostProcessEntry: array variable} { + catch {destroy .m1} + 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} + 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 {}} + +test menu-11.1 {ConfigureMenuEntry} { catch {destroy .m1} 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-10.2 {ConfigureMenuEntry} { +test menu-11.2 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1] } {0 {} {} {}} -test menu-10.3 {ConfigureMenuEntry} { +test menu-11.3 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1] } {0 {} test {}} -test menu-10.4 {ConfigureMenuEntry} { +test menu-11.4 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1] } {0 {} S {}} -test menu-10.5 {ConfigureMenuEntry} { +test menu-11.5 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1] } {0 {} test {}} -test menu-10.6 {ConfigureMenuEntry} { +test menu-11.6 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1] } {0 {} {}} -test menu-10.7 {ConfigureMenuEntry} { +test menu-11.7 {ConfigureMenuEntry} { catch {destroy .m1} catch {destroy .m2} menu .m2 @@ -1476,31 +1515,31 @@ test menu-10.7 {ConfigureMenuEntry} { .m1 add cascade list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2] } {0 {} {}} -test menu-10.8 {ConfigureMenuEntry} { +test menu-11.8 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add cascade list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] } {0 {} {}} -test menu-10.9 {ConfigureMenuEntry} { +test menu-11.9 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m3 list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] } {0 {} {}} -test menu-10.10 {ConfigureMenuEntry} { +test menu-11.10 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add cascade list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] } {0 {} {}} -test menu-10.11 {ConfigureMenuEntry} { +test menu-11.11 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m2 list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] } {0 {} {}} -test menu-10.12 {ConfigureMenuEntry} { +test menu-11.12 {ConfigureMenuEntry} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -1517,7 +1556,7 @@ test menu-10.12 {ConfigureMenuEntry} { .m5 add cascade list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5] } {0 {} {}} -test menu-10.13 {ConfigureMenuEntry} { +test menu-11.13 {ConfigureMenuEntry} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -1531,29 +1570,29 @@ test menu-10.13 {ConfigureMenuEntry} { .m4 add cascade -menu .m1 list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4] } {0 {} {}} -test menu-10.14 {ConfigureMenuEntry} { +test menu-11.14 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add checkbutton list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1] } {0 {} test {}} -test menu-10.15 {ConfigureMenuEntry} { +test menu-11.15 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1] } {0 {} test {}} -test menu-10.16 {ConfigureMenuEntry} { +test menu-11.16 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1] } {0 {} {}} -test menu-10.17 {ConfigureMenuEntry} { +test menu-11.17 {ConfigureMenuEntry} { catch {destroy .m1} menu .m1 .m1 add checkbutton list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1] } {0 {} test {}} -test menu-10.18 {ConfigureMenuEntry} { +test menu-11.18 {ConfigureMenuEntry} { catch {destroy .m1} catch {image delete image1} menu .m1 @@ -1561,7 +1600,7 @@ test menu-10.18 {ConfigureMenuEntry} { image create test image1 list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1] } {0 {} {} {}} -test menu-10.19 {ConfigureMenuEntry} { +test menu-11.19 {ConfigureMenuEntry} { catch {destroy .m1} catch {image delete image1} catch {image delete image2} @@ -1571,7 +1610,7 @@ test menu-10.19 {ConfigureMenuEntry} { .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-10.20 {ConfigureMenuEntry} { +test menu-11.20 {ConfigureMenuEntry} { catch {destroy .m1} catch {image delete image1} catch {image delete image2} @@ -1581,7 +1620,7 @@ test menu-10.20 {ConfigureMenuEntry} { .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-10.21 {ConfigureMenuEntry} { +test menu-11.21 {ConfigureMenuEntry} { catch {destroy .m1} catch {image delete image1} catch {image delete image2} @@ -1594,7 +1633,7 @@ test menu-10.21 {ConfigureMenuEntry} { list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3] } {0 {} {} {} {} {}} -test menu-11.1 {ConfigureMenuCloneEntries} { +test menu-12.1 {ConfigureMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -1606,7 +1645,7 @@ test menu-11.1 {ConfigureMenuCloneEntries} { .m1 add command -label "test2" list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1] } {{1 {unknown option "-gork"}} {}} -test menu-11.2 {ConfigureMenuCloneEntries} { +test menu-12.2 {ConfigureMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -1618,7 +1657,7 @@ test menu-11.2 {ConfigureMenuCloneEntries} { menu .m4 list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4] } {0 {} {} {} {}} -test menu-11.3 {ConfigureMenuCloneEntries} { +test menu-12.3 {ConfigureMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -1627,7 +1666,18 @@ test menu-11.3 {ConfigureMenuCloneEntries} { list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1] } {0 {} {}} -test menu-12.1 {TkGetMenuIndex} { +test menu-12.4 {ConfigureMenuCloneEntries} { + catch {destroy .m1} + catch {destroy .m2} + 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 {} {}} + +test menu-13.1 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 add command -label "active" @@ -1636,7 +1686,7 @@ test menu-12.1 {TkGetMenuIndex} { .m1 activate 2 list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1] } {0 test2 {}} -test menu-12.2 {TkGetMenuIndex} { +test menu-13.2 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 add command -label "last" @@ -1645,7 +1695,7 @@ test menu-12.2 {TkGetMenuIndex} { .m1 activate 2 list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1] } {0 test3 {}} -test menu-12.3 {TkGetMenuIndex} { +test menu-13.3 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 add command -label "last" @@ -1654,19 +1704,19 @@ test menu-12.3 {TkGetMenuIndex} { .m1 activate 2 list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1] } {0 test3 {}} -test menu-12.4 {TkGetMenuIndex} { +test menu-13.4 {TkGetMenuIndex} { catch {destroy .m1} 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-12.5 {TkGetMenuIndex} { +test menu-13.5 {TkGetMenuIndex} { catch {destroy .m1} 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-12.6 {TkGetMenuIndex} { +test menu-13.6 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 add command -label "active" @@ -1676,7 +1726,7 @@ test menu-12.6 {TkGetMenuIndex} { list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1] } {0 {} {}} #test menu-13.7 - Need to add @test here. -test menu-12.7 {TkGetMenuIndex} { +test menu-13.7 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 add command -label "active" @@ -1684,32 +1734,32 @@ test menu-12.7 {TkGetMenuIndex} { .m1 add command -label "test3" list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1] } {0 active {}} -test menu-12.8 {TkGetMenuIndex} { +test menu-13.8 {TkGetMenuIndex} { catch {destroy .m1} 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-12.9 {TkGetMenuIndex} { +test menu-13.9 {TkGetMenuIndex} { catch {destroy .m1} 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-12.10 {TkGetMenuIndex} { +test menu-13.10 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 insert 999 command -label "test" list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1] } {0 test {}} -test menu-12.11 {TkGetMenuIndex} { +test menu-13.11 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 add command -label "1test" list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1] } {0 1test {}} -test menu-12.12 {TkGetMenuIndex} { +test menu-13.12 {TkGetMenuIndex} { catch {destroy .m1} menu .m1 .m1 add command -label "test" @@ -1718,101 +1768,101 @@ test menu-12.12 {TkGetMenuIndex} { list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1] } {0 beep {}} -test menu-13.1 {MenuCmdDeletedProc} { +test menu-14.1 {MenuCmdDeletedProc} { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} -test menu-13.2 {MenuCmdDeletedProc} { +test menu-14.2 {MenuCmdDeletedProc} { catch {destroy .m1} menu .m1 .m1 clone .m2 list [catch {destroy .m1} msg] $msg } {0 {}} -test menu-14.1 {MenuNewEntry} { +test menu-15.1 {MenuNewEntry} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1] } {0 {} {}} -test menu-14.2 {MenuNewEntry} { +test menu-15.2 {MenuNewEntry} { catch {destroy .m1} 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-14.3 {MenuNewEntry} { +test menu-15.3 {MenuNewEntry} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1] } {0 {} {}} -test menu-14.4 {MenuNewEntry} { +test menu-15.4 {MenuNewEntry} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.1 {MenuAddOrInsert} { +test menu-16.1 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1] } {1 {bad menu entry index "foo"} {}} -test menu-15.2 {MenuAddOrInsert} { +test menu-16.2 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.3 {MenuAddOrInsert} { +test menu-16.3 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1] } {1 {bad menu entry index "-1"} {}} -test menu-15.4 {MenuAddOrInsert} { +test menu-16.4 {MenuAddOrInsert} { catch {destroy .m1} 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-15.5 {MenuAddOrInsert} { +test menu-16.5 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 add cascade} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.6 {MenuAddOrInsert} { +test menu-16.6 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 add checkbutton} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.7 {MenuAddOrInsert} { +test menu-16.7 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.8 {MenuAddOrInsert} { +test menu-16.8 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 add radiobutton} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.9 {MenuAddOrInsert} { +test menu-16.9 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 add separator} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.10 {MenuAddOrInsert} { +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-15.11 {MenuAddOrInsert} { +test menu-16.11 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] } {0 {} {}} -test menu-15.12 {MenuAddOrInsert} { +test menu-16.12 {MenuAddOrInsert} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -1821,7 +1871,7 @@ test menu-15.12 {MenuAddOrInsert} { .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-15.13 {MenuAddOrInsert} { +test menu-16.13 {MenuAddOrInsert} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -1830,12 +1880,12 @@ test menu-15.13 {MenuAddOrInsert} { .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-15.14 {MenuAddOrInsert} { +test menu-16.14 {MenuAddOrInsert} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -blork} msg] $msg [destroy .m1] } {1 {unknown option "-blork"} {}} -test menu-15.15 {MenuAddOrInsert} { +test menu-16.15 {MenuAddOrInsert} { catch {destroy .m1} catch {destroy .container} menu .m1 @@ -1844,7 +1894,7 @@ test menu-15.15 {MenuAddOrInsert} { . configure -menu .container list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1] } {0 {} {} {}} -test menu-15.16 {MenuAddOrInsert} { +test menu-16.16 {MenuAddOrInsert} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -1852,7 +1902,7 @@ test menu-15.16 {MenuAddOrInsert} { set tearoff [tkTearOffMenu .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-15.17 {MenuAddOrInsert} { +test menu-16.17 {MenuAddOrInsert} { catch {destroy .m1} catch {destroy .container} menu .m1 @@ -1861,7 +1911,7 @@ test menu-15.17 {MenuAddOrInsert} { set tearoff [tkTearOffMenu .container] list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container] } {0 {} {} {}} -test menu-15.18 {MenuAddOrInsert} { +test menu-16.18 {MenuAddOrInsert} { catch {destroy .m1} catch {destroy .container} menu .m1 @@ -1870,7 +1920,7 @@ test menu-15.18 {MenuAddOrInsert} { . configure -menu .container list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container] } {0 {} {} {}} -test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} { +test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} { catch {destroy .menubar} menu .menubar menu .menubar.test -tearoff 0 @@ -1884,7 +1934,7 @@ test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} { [. configure -menu ""] [destroy .menubar] } {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}} -test menu-16.1 {MenuVarProc} { +test menu-17.1 {MenuVarProc} { catch {destroy .m1} catch {unset foo} menu .m1 @@ -1892,45 +1942,45 @@ test menu-16.1 {MenuVarProc} { list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1] } {0 {} 0 {} {}} # menu-17.2 - Don't know how to generate the flags in the if -test menu-16.2 {MenuVarProc} { +test menu-17.2 {MenuVarProc} { catch {destroy .m1} 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-16.3 {MenuVarProc} { +test menu-17.3 {MenuVarProc} { catch {destroy .m1} 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-16.4 {MenuVarProc} { +test menu-17.4 {MenuVarProc} { catch {destroy .m1} 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-16.5 {MenuVarProc} { +test menu-17.5 {MenuVarProc} { catch {destroy .m1} 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 {}} -test menu-17.1 {TkActivateMenuEntry} { +test menu-18.1 {TkActivateMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [catch {.m1 activate 1} msg] $msg [destroy .m1] } {0 {} {}} -test menu-17.2 {TkActivateMenuEntry} { +test menu-18.2 {TkActivateMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [catch {.m1 activate 0} msg] $msg [destroy .m1] } {0 {} {}} -test menu-17.3 {TkActivateMenuEntry} { +test menu-18.3 {TkActivateMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command -label "test" @@ -1938,7 +1988,7 @@ test menu-17.3 {TkActivateMenuEntry} { .m1 activate 1 list [catch {.m1 activate 2} msg] $msg [destroy .m1] } {0 {} {}} -test menu-17.4 {TkActivateMenuEntry} { +test menu-18.4 {TkActivateMenuEntry} { catch {destroy .m1} menu .m1 .m1 add command -label "test" @@ -1947,56 +1997,56 @@ test menu-17.4 {TkActivateMenuEntry} { list [catch {.m1 activate 1} msg] $msg [destroy .m1] } {0 {} {}} -test menu-18.1 {TkPostCommand} {menuInteractive} { +test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } { catch {destroy .m1} 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-18.2 {TkPostCommand} {menuInteractive} { +test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } { catch {destroy .m1} 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-19.1 {CloneMenu} { +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-19.2 {CloneMenu} { +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-19.3 {CloneMenu} { +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-19.4 {CloneMenu} { +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-19.5 {CloneMenu} { +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 - must be normal, tearoff, or menubar} {}} -test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} { +} {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-19.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} { + test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -2004,14 +2054,14 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} { .m1 clone .m2 list [catch {.m1 clone .m3} msg] $msg [destroy .m1] } {0 {} {}} - test menu-19.8 {CloneMenu - cascade entries} { + test menu-20.8 {CloneMenu - cascade entries} { catch {destroy .m1} catch {destroy .foo} menu .m1 .m1 add cascade -menu .m2 list [catch {.m1 clone .foo} msg] $msg [destroy .m1] } {0 {} {}} - test menu-19.9 {CloneMenu - cascades entries} { + test menu-20.9 {CloneMenu - cascades entries} { catch {destroy .m1} catch {destroy .m2} catch {destroy .foo} @@ -2020,13 +2070,13 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} { menu .m2 list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2] } {0 {} {}} -test menu-19.10 {CloneMenu - tearoff fields} { +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-19.11 {CloneMenu} { +test menu-20.11 {CloneMenu} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -2034,26 +2084,26 @@ test menu-19.11 {CloneMenu} { list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2] } {1 {window name "m2" already exists in parent} {}} -test menu-20.1 {MenuDoYPosition} { +test menu-21.1 {MenuDoYPosition} { catch {destroy .m1} menu .m1 list [catch {.m1 yposition glorp} msg] $msg [destroy .m1] } {1 {bad menu entry index "glorp"} {}} -test menu-20.2 {MenuDoYPosition} { +test menu-21.2 {MenuDoYPosition} { catch {destroy .m1} menu .m1 .m1 add command -label "Test" list [catch {.m1 yposition 1}] [destroy .m1] } {0 {}} -test menu-21.1 {GetIndexFromCoords} { +test menu-22.1 {GetIndexFromCoords} { catch {destroy .m1} menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 list [catch {.m1 index @5} msg] $msg [destroy .m1] } {0 0 {}} -test menu-21.2 {GetIndexFromCoords} { +test menu-22.2 {GetIndexFromCoords} { catch {destroy .m1} menu .m1 .m1 add command -label "test" @@ -2061,13 +2111,13 @@ test menu-21.2 {GetIndexFromCoords} { list [catch {.m1 index @5,5} msg] $msg [destroy .m1] } {0 0 {}} -test menu-22.1 {RecursivelyDeleteMenu} { +test menu-23.1 {RecursivelyDeleteMenu} { catch {destroy .m1} menu .m1 . configure -menu .m1 list [catch {. configure -menu ""} msg] $msg [destroy .m1] } {0 {} {}} -test menu-22.2 {RecursivelyDeleteMenu} { +test menu-23.2 {RecursivelyDeleteMenu} { catch {destroy .m1} catch {destroy .m2} menu .m2 @@ -2078,40 +2128,40 @@ test menu-22.2 {RecursivelyDeleteMenu} { list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2] } {0 {} {}} -test menu-23.1 {TkNewMenuName} { +test menu-24.1 {TkNewMenuName} { catch {destroy .m1} menu .m1 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test menu-23.2 {TkNewMenuName} { +test menu-24.2 {TkNewMenuName} { catch {destroy .m1} catch {destroy .m1\#0} menu .m1 menu .m1\#0 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test menu-23.3 {TkNewMenuName} { +test menu-24.3 {TkNewMenuName} { catch {destroy .#m} menu .#m rename .#m hideme list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme] } {0 {} {} {} {}} -test menu-24.1 {TkSetWindowMenuBar} { +test menu-25.1 {TkSetWindowMenuBar} { . configure -menu "" list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] } {0 {} {}} -test menu-24.2 {TkSetWindowMenuBar} { +test menu-25.2 {TkSetWindowMenuBar} { . configure -menu "" list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] } {0 {} {}} -test menu-24.3 {TkSetWindowMenuBar} { +test menu-25.3 {TkSetWindowMenuBar} { . configure -menu "" catch {destroy .m1} menu .m1 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test menu-24.4 {TkSetWindowMenuBar} { +test menu-25.4 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} . configure -menu "" @@ -2120,7 +2170,7 @@ test menu-24.4 {TkSetWindowMenuBar} { menu .m2 list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2] } {0 {} {} {}} -test menu-24.5 {TkSetWindowMenuBar} { +test menu-25.5 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -2131,7 +2181,7 @@ test menu-24.5 {TkSetWindowMenuBar} { menu .m3 list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3] } {0 {} {} {}} -test menu-24.6 {TkSetWindowMenuBar} { +test menu-25.6 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -2142,7 +2192,7 @@ test menu-24.6 {TkSetWindowMenuBar} { menu .m3 list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3] } {0 {} {} {}} -test menu-24.7 {TkSetWindowMenuBar} { +test menu-25.7 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} . configure -menu "" @@ -2153,7 +2203,7 @@ test menu-24.7 {TkSetWindowMenuBar} { .t2 configure -menu .m1 list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2] } {0 {} {} {}} -test menu-24.8 {TkSetWindowMenuBar} { +test menu-25.8 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} catch {destroy .t2} @@ -2166,7 +2216,7 @@ test menu-24.8 {TkSetWindowMenuBar} { .t2 configure -menu .m1 list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2] } {0 {} {} {}} -test menu-24.9 {TkSetWindowMenuBar} { +test menu-25.9 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} catch {destroy .t2} @@ -2181,7 +2231,7 @@ test menu-24.9 {TkSetWindowMenuBar} { wm geometry .t3 +0+0 list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2] } {0 {} {} {}} -test menu-24.10 {TkSetWindowMenuBar} { +test menu-25.10 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} catch {destroy .t2} @@ -2196,7 +2246,7 @@ test menu-24.10 {TkSetWindowMenuBar} { wm geometry .t3 +0+0 list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2] } {0 {} {} {}} -test menu-24.11 {TkSetWindowMenuBar} { +test menu-25.11 {TkSetWindowMenuBar} { catch {destroy .m1} catch {destroy .m2} catch {destroy .t2} @@ -2211,27 +2261,27 @@ test menu-24.11 {TkSetWindowMenuBar} { wm geometry .t3 +0+0 list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2] } {0 {} {} {}} -test menu-24.12 {TkSetWindowMenuBar} { +test menu-25.12 {TkSetWindowMenuBar} { catch {destroy .m1} . configure -menu "" menu .m1 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test menu-24.13 {TkSetWindowMenuBar} { +test menu-25.13 {TkSetWindowMenuBar} { . configure -menu "" list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] } {0 {} {}} -test menu-24.14 {TkSetWindowMenuBar} { +test menu-25.14 {TkSetWindowMenuBar} { catch {destroy .m1} . configure -menu "" menu .m1 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test menu-24.15 {TkSetWindowMenuBar} { +test menu-25.15 {TkSetWindowMenuBar} { . configure -menu "" list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] } {0 {} {}} -test menu-24.16 {TkSetWindowMenuBar} { +test menu-25.16 {TkSetWindowMenuBar} { catch {destroy .m1} . configure -menu "" menu .m1 @@ -2239,7 +2289,7 @@ test menu-24.16 {TkSetWindowMenuBar} { list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1] } {0 .t2 {} {}} -test menu-25.1 {DestroyMenuHashTable} { +test menu-26.1 {DestroyMenuHashTable} { catch {interp destroy testinterp} interp create testinterp load {} Tk testinterp @@ -2247,18 +2297,18 @@ test menu-25.1 {DestroyMenuHashTable} { list [catch {interp delete testinterp} msg] $msg } {0 {}} -test menu-26.1 {GetMenuHashTable} { +test menu-27.1 {GetMenuHashTable} { catch {interp destroy testinterp} interp create testinterp load {} tk testinterp list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp] } {0 .m1 {}} -test menu-27.1 {TkCreateMenuReferences - not there before} { +test menu-28.1 {TkCreateMenuReferences - not there before} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} -test menu-27.2 {TkCreateMenuReferences - there already} { +test menu-28.2 {TkCreateMenuReferences - there already} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -2266,14 +2316,14 @@ test menu-27.2 {TkCreateMenuReferences - there already} { list [catch {menu .m2} msg] $msg [destroy .m1 .m2] } {0 .m2 {}} -test menu-28.1 {TkFindMenuReferences - not there} { +test menu-29.1 {TkFindMenuReferences - not there} { catch {destroy .m1} . configure -menu "" menu .m1 .m1 add cascade -menu .m2 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test menu-29.1 {TkFindMenuReferences - there already} { +test menu-30.1 {TkFindMenuReferences - there already} { catch {destroy .m1} catch {destroy .m2} . configure -menu "" @@ -2283,23 +2333,23 @@ test menu-29.1 {TkFindMenuReferences - there already} { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2] } {0 {} {} {}} -test menu-30.1 {TkFreeMenuReferences - menuPtr} { +test menu-31.1 {TkFreeMenuReferences - menuPtr} { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} -test menu-30.2 {TkFreeMenuReferences - cascadePtr} { +test menu-31.2 {TkFreeMenuReferences - cascadePtr} { catch {destroy .m1} . configure -menu "" menu .m1 .m1 add cascade -menu .m2 list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1] } {0 {} {}} -test menu-30.3 {TkFreeMenuReferences - topLevelListPtr} { +test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} { . configure -menu .m1 list [catch {. configure -menu ""} msg] $msg } {0 {}} -test menu-30.4 {TkFreeMenuReferences - not empty} { +test menu-31.4 {TkFreeMenuReferences - not empty} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -2309,7 +2359,7 @@ test menu-30.4 {TkFreeMenuReferences - not empty} { list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2] } {0 {} {}} -test menu-31.1 {DeleteMenuCloneEntries} { +test menu-32.1 {DeleteMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -2317,7 +2367,7 @@ test menu-31.1 {DeleteMenuCloneEntries} { .m1 clone .m2 list [catch {.m1 delete 1} msg] $msg [destroy .m1] } {0 {} {}} -test menu-31.2 {DeleteMenuCloneEntries} { +test menu-32.2 {DeleteMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -2328,7 +2378,7 @@ test menu-31.2 {DeleteMenuCloneEntries} { .m1 clone .m2 list [catch {.m1 delete 2 3} msg] $msg [destroy .m1] } {0 {} {}} -test menu-31.3 {DeleteMenuCloneEntries} { +test menu-32.3 {DeleteMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} menu .m1 -tearoff 0 @@ -2340,7 +2390,7 @@ test menu-31.3 {DeleteMenuCloneEntries} { .m2 configure -tearoff 1 list [catch {.m1 delete 1 2} msg] $msg [destroy .m1] } {0 {} {}} -test menu-31.4 {DeleteMenuCloneEntries} { +test menu-32.4 {DeleteMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -2352,7 +2402,7 @@ test menu-31.4 {DeleteMenuCloneEntries} { .m2 configure -tearoff 0 list [catch {.m1 delete 2 3} msg] $msg [destroy .m1] } {0 {} {}} -test menu-31.5 {DeleteMenuCloneEntries} { +test menu-32.5 {DeleteMenuCloneEntries} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -2362,17 +2412,23 @@ test menu-31.5 {DeleteMenuCloneEntries} { .m1 activate one list [catch {.m1 delete one} msg] $msg [destroy .m1] } {0 {} {}} -test menu-31.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.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} + menu .m1 -tearoff 0 + .m1 add command -label Hello + list [catch {.m1 delete Hello} msg] $msg [destroy .m1] +} {0 {} {}} set l [interp hidden] eval destroy [winfo children .] -test menu-32.1 {menu vs command hiding} { +test menu-33.1 {menu vs command hiding} { catch {destroy .m} menu .m interp hide {} .m @@ -2382,4 +2438,20 @@ test menu-32.1 {menu vs command hiding} { # menu-34 MenuInit only called at boot time +# cleanup deleteWindows +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/menuDraw.test b/tests/menuDraw.test index b142f98..fdb051b 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -2,23 +2,23 @@ # organized in the standard fashion for Tcl tests. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: menuDraw.test,v 1.2 1998/09/14 18:23:48 stanton Exp $ +# RCS: @(#) $Id: menuDraw.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - proc deleteWindows {} { foreach i [winfo children .] { catch [destroy $i] @@ -29,16 +29,6 @@ deleteWindows wm geometry . {} raise . -if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test." - set testConfig(menuInteractive) 0 -} else { - set testConfig(menuInteractive) 1 -} - test menuDraw-1.1 {TkMenuInitializeDrawingFields} { catch {destroy .m1} list [menu .m1] [destroy .m1] @@ -118,7 +108,7 @@ test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} { menu .m1 .m1 add command -label "foo" list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1] -} {1 {bad state value "foo": must be normal, active, or disabled} {}} +} {1 {bad state "foo": must be active, normal, or disabled} {}} test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} { catch {destroy .m1} menu .m1 @@ -191,7 +181,7 @@ test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} { } {{} {}} -test menuDraw-8.1 {TkRecomputeMenu} {menuInteractive} { +test menuDraw-8.1 {TkRecomputeMenu} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 configure -postcommand [.m1 add command -label foo] @@ -506,7 +496,7 @@ test menuDraw-16.5 {TkPostSubMenu} {unixOnly} { set tearoff [tkTearOffMenu .m1 40 40] list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2] } {1 {invalid command name "glorp"} {} {}} -test menuDraw-16.6 {TkPostSubMenu} {menuInteractive} { +test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -532,7 +522,7 @@ test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} { } list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2] } {{} {} {} {}} -test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} { +test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -543,4 +533,20 @@ test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} { list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} +# cleanup deleteWindows +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/menubut.test b/tests/menubut.test index 9bdf04c..89d46d8 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -3,27 +3,27 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: menubut.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: menubut.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ # XXX This test file is woefully incomplete right now. If any part # XXX of a procedure has tests then the whole procedure has tests, # XXX but many procedures have no tests. +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -51,7 +51,7 @@ foreach test { {unknown color name "non-existent"}} {-activeforeground #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} + {-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"}} @@ -59,7 +59,7 @@ foreach test { {-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 value "badValue": must be above, below, left, right, or flush}} + {-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}} @@ -74,8 +74,8 @@ foreach test { {-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 type "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}} + {-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 {} {}} @@ -122,7 +122,7 @@ test menubutton-3.1 {MenuButtonWidgetCmd procedure} { } {1 {wrong # args: should be ".mb option ?arg arg ...?"}} test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.mb c} msg] $msg -} {1 {bad option "c": must be cget or configure}} +} {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"}} @@ -204,7 +204,7 @@ test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} { menubutton .mb -text "Test" list [catch {.mb configure -direction badValue} msg] $msg \ [.mb cget -direction] [destroy .mb] -} {1 {bad direction value "badValue": must be above, below, left, right, or flush} below {}} +} {1 {bad direction "badValue": must be above, below, flush, left, or right} below {}} # XXX Need to add tests for several procedures here. XXX @@ -314,7 +314,7 @@ test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} { pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {78 28} -test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} { +test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. @@ -324,7 +324,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} { pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {64 23} -test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pc nonPortable} { +test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. @@ -350,3 +350,19 @@ eval image delete [image names] eval destroy [winfo children .] option clear +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/msgbox.test b/tests/msgbox.test index 0511c87..e9a16d4 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -2,23 +2,27 @@ # It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: msgbox.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: msgbox.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ # -if {[string compare test [info procs test]] == 1} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } +# Some tests require user interaction on non-unix platform +set ::tcltest::testConfig(nonUnixUserInteraction) \ + [expr {$::tcltest::testConfig(userInteraction) || \ + $::tcltest::testConfig(unixOnly)}] + test msgbox-1.1 {tk_messageBox command} { list [catch {tk_messageBox -foo} msg] $msg -} {1 {unknown option "-foo", must be -default, -icon, -message, -parent, -title or -type}} +} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}} test msgbox-1.2 {tk_messageBox command} { list [catch {tk_messageBox -foo bar} msg] $msg -} {1 {unknown option "-foo", must be -default, -icon, -message, -parent, -title or -type}} +} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}} catch {tk_messageBox -foo bar} msg regsub -all , $msg "" options @@ -38,23 +42,31 @@ test msgbox-1.4 {tk_messageBox command} { test msgbox-1.5 {tk_messageBox command} { list [catch {tk_messageBox -type foo} msg] $msg -} {1 {invalid message box type "foo", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel}} +} {1 {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}} + +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.6 {tk_messageBox command} { list [catch {tk_messageBox -default 1.1} msg] $msg -} {1 {invalid default button "1.1"}} +} [list 1 [createPlatformMsg "1.1"]] test msgbox-1.7 {tk_messageBox command} { list [catch {tk_messageBox -default foo} msg] $msg -} {1 {invalid default button "foo"}} +} [list 1 [createPlatformMsg "foo"]] test msgbox-1.8 {tk_messageBox command} { list [catch {tk_messageBox -type yesno -default 3} msg] $msg -} {1 {invalid default button "3"}} +} [list 1 [createPlatformMsg "3"]] test msgbox-1.9 {tk_messageBox command} { list [catch {tk_messageBox -icon foo} msg] $msg -} {1 {invalid icon "foo", must be error, info, question or warning}} +} {1 {bad -icon value "foo": must be error, info, question, or warning}} test msgbox-1.10 {tk_messageBox command} { list [catch {tk_messageBox -parent foo.bar} msg] $msg @@ -66,14 +78,6 @@ if {[info commands tkMessageBox] == ""} { set isNative 0 } -if {$isNative && ![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test" - return -} - proc ChooseMsg {parent btn} { global isNative if {!$isNative} { @@ -128,30 +132,52 @@ set specs { # 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.1 {tk_messageBox command} { + 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.2 {tk_messageBox command -icon option} { + 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 } foreach button $buttons { - test msgbox-2.3 {tk_messageBox command} { + 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 } } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/obj.test b/tests/obj.test new file mode 100644 index 0000000..f24ff68 --- /dev/null +++ b/tests/obj.test @@ -0,0 +1,52 @@ +# This file is a Tcl script to test new object types in Tk. +# It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: obj.test,v 1.2 1999/04/16 01:51:39 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +foreach i [winfo children .] { + destroy $i +} +wm geometry . {} +raise . + +test obj-1.1 {TkGetPixelsFromObj} { +} {} + +test obj-2.1 {FreePixelInternalRep} { +} {} + +test obj-3.1 {DupPixelInternalRep} { +} {} + +test obj-4.1 {SetPixelFromAny} { +} {} + + + +eval destroy [winfo children .] + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + + diff --git a/tests/oldpack.test b/tests/oldpack.test index 984e4fe..a793304 100644 --- a/tests/oldpack.test +++ b/tests/oldpack.test @@ -4,14 +4,14 @@ # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: oldpack.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: oldpack.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} # First, test a single window packed in various ways in a parent @@ -505,4 +505,20 @@ test pack-9.3 {information output} { } {{.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} -concat {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/option.test b/tests/option.test index 3acc8f8..339d723 100644 --- a/tests/option.test +++ b/tests/option.test @@ -3,14 +3,14 @@ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: option.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: option.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} catch {destroy .op1} catch {destroy .op2} @@ -185,15 +185,9 @@ test option-14.12 {error conditions} { list [catch {option get .gorp.gorp a A} msg] $msg } {1 {bad window path name ".gorp.gorp"}} -if {$tcl_platform(os) == "Win32s"} { - set option1 OPTION~2.FIL - set option2 OPTION~1.FIL - set option3 OPTION~3.FIL -} else { - set option1 option.file1 - set option2 option.file2 - set option3 option.file3 -} +set option1 [file join $::tcltest::testsDir option.file1] +set option2 [file join $::tcltest::testsDir option.file2] +set option3 [file join $::tcltest::testsDir option.file3] test option-15.1 {database files} { list [catch {option read non-existent} msg] $msg @@ -229,4 +223,20 @@ test option-16.1 {ReadOptionFile} { catch {destroy .op1} catch {destroy .op2} -concat {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/pack.test b/tests/pack.test index 0084de4..6f6adbd 100644 --- a/tests/pack.test +++ b/tests/pack.test @@ -3,14 +3,14 @@ # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: pack.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: pack.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} # Utility procedures: @@ -967,3 +967,20 @@ destroy .pack foreach i {pack1 pack2 pack3 pack4} { rename $i {} } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/place.test b/tests/place.test index aaa2537..ea4014b 100644 --- a/tests/place.test +++ b/tests/place.test @@ -2,14 +2,13 @@ # organized in the standard fashion for Tcl tests. # # Copyright (c) 1995 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: place.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: place.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -218,4 +217,20 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} { } {1 0 42 32 0 1} catch {destroy .t} -concat + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/raise.test b/tests/raise.test index 5c40341..14323c5 100644 --- a/tests/raise.test +++ b/tests/raise.test @@ -5,11 +5,10 @@ # # Copyright (c) 1993-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: raise.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: raise.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ if {[info commands testmakeexist] == {}} { puts "This application hasn't been compiled with the \"testmakeexist\"" @@ -18,8 +17,9 @@ if {[info commands testmakeexist] == {}} { return } -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} # Procedure to create a bunch of overlapping windows, which should # make it easy to detect differences in order. @@ -297,3 +297,20 @@ test raise-7.8 {errors in raise/lower commands} { foreach i [winfo child .] { destroy $i } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/safe.test b/tests/safe.test index 1a1970b..b134268 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -3,31 +3,28 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: safe.test,v 1.4 1999/04/16 01:25:55 stanton Exp $ +# RCS: @(#) $Id: safe.test,v 1.5 1999/04/16 01:51:40 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { - puts "*** Destroying $i ***"; update idletasks destroy $i } # The set of hidden commands is platform dependent: if {"$tcl_platform(platform)" == "macintosh"} { - set hidden_cmds {beep bell cd clipboard echo exit fconfigure file glob grab load ls menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm} + set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm} } elseif {"$tcl_platform(platform)" == "windows"} { - set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm} + set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm} } else { - set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection send socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm} + set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk toplevel wm} } -puts "About to do 1" test safe-1.1 {Safe Tk loading into an interpreter} { catch {safe::interpDelete a} @@ -51,7 +48,7 @@ test safe-1.3 {Safe Tk loading into an interpreter} { set l [lsort [interp aliases a]] safe::interpDelete a set l -} {exit file load source} +} {encoding exit file load source} test safe-2.1 {Unsafe commands not available} { catch {safe::interpDelete a} @@ -99,19 +96,14 @@ test safe-3.2 {Unsafe commands are available hidden} { set status } ok -# This test gets a panic on the Mac in Tk8.0.5. It did not in 8.0.4, -# and it also does not if you update before deleting. This is just -# revealing the weakness in the link between the container list and the -# ports for the windows. The same comment applies to safe-5.2 - -test safe-4.1 {testing loadTk} {unixOrPc} { +test safe-4.1 {testing loadTk} { # 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 impy 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 } {} @@ -133,7 +125,7 @@ test safe-5.1 {loading Tk in safe interps without master's clearance} { set msg } {not allowed to start Tk by master's safe::TkInit} -test safe-5.2 {multi-level Tk loading with clearance} {unixOrPc} { +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] @@ -173,4 +165,27 @@ test safe-6.2 {loadTk -use windowPath, conflicting -display} { } {conflicting -display :23.56 and -use } +test safe-7.1 {canvas printing} { + set i [safe::loadTk [safe::interpCreate]] + set r [catch {interp eval $i {canvas .c; .c postscript}}] + safe::interpDelete $i + set r +} 0 + +# cleanup unset hidden_cmds +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/scale.test b/tests/scale.test index adc50e9..01b1609 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -3,14 +3,13 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: scale.test,v 1.3 1998/11/03 02:06:43 stanton Exp $ +# RCS: @(#) $Id: scale.test,v 1.4 1999/04/16 01:51:40 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -56,18 +55,18 @@ foreach test { {-label "Some text" {Some text} {} {}} {-length 130 130 badValue {bad screen distance "badValue"}} {-orient horizontal horizontal badValue - {bad orientation "badValue": must be vertical or horizontal}} + {bad orient "badValue": must be horizontal or vertical}} {-orient horizontal 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 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 type "badValue": must be flat, groove, raised, ridge, solid, or sunken}} + {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-state disabled disabled badValue - {bad state value "badValue": must be normal, active, or disabled}} + {bad state "badValue": must be active, disabled, or normal}} {-state normal normal {} {}} {-takefocus "any string" "any string" {} {}} {-tickinterval 4.3 4.0 badValue @@ -212,10 +211,10 @@ test scale-3.29 {ScaleWidgetCmd procedure} { } {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 {bad option "c": must be cget, configure, coords, get, identify, or set}} +} {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 {bad option "co": must be cget, configure, coords, get, identify, or set}} +} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}} test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} { proc kill args { destroy .s @@ -270,7 +269,7 @@ test scale-5.4 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 0 -to 100 list [catch {.s configure -orient dumb} msg] $msg -} {1 {bad orientation "dumb": must be vertical or horizontal}} +} {1 {bad orient "dumb": must be horizontal or vertical}} test scale-5.5 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76 @@ -288,7 +287,7 @@ test scale-5.6 {ConfigureScale procedure} { test scale-5.7 {ConfigureScale procedure} { catch {destroy .s} list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg -} {1 {bad state value "bogus": must be normal, active, or disabled}} +} {1 {bad state "bogus": must be active, disabled, or normal}} catch {destroy .s} scale .s -orient horizontal -length 200 @@ -360,7 +359,7 @@ test scale-6.13 {ComputeFormat procedure} { .s configure -from .000001 -to .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} -} 1 +} {1} test scale-6.14 {ComputeFormat procedure} { .s configure -to .00001 -from .0001 -resolution .00001 .s set .00006 @@ -370,12 +369,12 @@ test scale-6.15 {ComputeFormat procedure} { .s configure -to .000001 -from .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} -} 1 +} {1} test scale-6.16 {ComputeFormat procedure} { .s configure -from .00001 -to .0001 -resolution .00001 -digits 1 .s set .00006 expr {[.s get] == 6e-05} -} 1 +} {1} test scale-6.17 {ComputeFormat procedure} { .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3 .s set 49300000 @@ -799,3 +798,20 @@ test scale-16.1 {scale widget vs hidden commands} { catch {destroy .s} option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 7790b05..0328043 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -4,14 +4,13 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: scrollbar.test,v 1.2 1998/09/14 18:23:50 stanton Exp $ +# RCS: @(#) $Id: scrollbar.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -170,16 +169,16 @@ test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} { list [catch {.s cget -orient} msg] $msg } {0 vertical} scrollbar .s2 -test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pc} { +test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} { list [catch {.s2 cget -bd} msg] $msg } {0 0} -test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} { +test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} { list [catch {.s2 cget -bd} msg] $msg } {0 2} -test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pc} { +test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} { list [catch {.s2 cget -highlightthickness} msg] $msg } {0 0} -test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} { +test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} { list [catch {.s2 cget -highlightthickness} msg] $msg } {0 1} destroy .s2 @@ -662,4 +661,20 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { catch {destroy .s} catch {destroy .t} -concat {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/select.test b/tests/select.test index d449f7c..9f1e6a6 100644 --- a/tests/select.test +++ b/tests/select.test @@ -3,19 +3,18 @@ # fashion for Tcl tests. # # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: select.test,v 1.2 1998/09/14 18:23:50 stanton Exp $ +# RCS: @(#) $Id: select.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ # # Note: Multiple display selection handling will only be tested if the # environment variable TK_ALT_DISPLAY is set to an alternate display. # -if {[string compare test [info procs test]] == 1} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } eval destroy [winfo child .] @@ -449,10 +448,10 @@ test select-5.10 {Tk_GetSelection procedure} {unixOnly} { set selInfo "" selection own .f1 set result "" - fileevent $fd readable {} - puts $fd {catch {selection get TEST} msg; update; puts $msg; flush stdout} - flush $fd - lappend result [gets $fd] + fileevent $::tcltest::fd readable {} + puts $::tcltest::fd {catch {selection get TEST} msg; update; puts $msg; flush stdout} + flush $::tcltest::fd + lappend result [gets $::tcltest::fd] cleanupbg lappend result $selInfo } {{selection owner didn't respond} {}} @@ -814,14 +813,14 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} {unixOn set selInfo "" selection handle .f1 {handler STRING} update - puts $fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout} - flush $fd + puts $::tcltest::fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout} + flush $::tcltest::fd after 200 selection own . - set bgData {} - tkwait variable bgDone + set ::tcltest::bgData {} + tkwait variable ::tcltest::bgDone cleanupbg - list $bgData $selInfo + list $::tcltest::bgData $selInfo } {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}} test select-10.2 {ConvertSelection procedure} {unixOnly} { setup @@ -984,4 +983,20 @@ test select-13.1 {SelectionSize procedure, handler deleted} {unixOnly} { } {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}} catch {rename weirdHandler {}} -concat + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/send.test b/tests/send.test index 2f6e7d1..816151e 100644 --- a/tests/send.test +++ b/tests/send.test @@ -4,28 +4,31 @@ # # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: send.test,v 1.2 1998/09/14 18:23:50 stanton Exp $ +# RCS: @(#) $Id: send.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {$tcl_platform(platform) == "macintosh"} { puts "send is not available on the Mac - skipping tests" + ::tcltest::cleanupTests return } if {$tcl_platform(platform) == "window"} { puts "send is not available under Windows - skipping tests" + ::tcltest::cleanupTests return } if {[auto_execok xhost] == ""} { puts "xhost application isn't available - skipping tests" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} if {[info commands testsend] == "testsend"} { set gotTestCmds 1 } else { @@ -48,6 +51,7 @@ if {[catch {send $app set a 0} msg] == 1} { puts -nonewline "Your X server is insecure, so \"send\" can't be used;" puts " skipping \"send\" tests." cleanupbg + ::tcltest::cleanupTests return } } @@ -325,6 +329,8 @@ if $gotTestCmds { while executing "open bogus_file_name" invoked from within +"if 1 {open bogus_file_name}" + invoked from within "send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}} test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} { testsend prop root InterpRegistry "10234 bogus\n" @@ -546,7 +552,7 @@ r setupbg dobg {tk appname t_s_3} set x [list [catch {send t_s_3 exit} msg] $msg] - close $fd + close $::tcltest::fd set x } {1 {target application died}} @@ -577,15 +583,15 @@ test send-12.2 {TimeoutProc procedure} { tk appname tktest update setupbg - puts $fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout} - set bgDone 0 - set bgData {} - flush $fd - tkwait variable bgDone - set app $bgData + puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout} + set ::tcltest::bgDone 0 + set ::tcltest::bgData {} + flush $::tcltest::fd + tkwait variable ::tcltest::bgDone + set app $::tcltest::bgData after 200 set result [list [catch {send $app foo} msg] $msg] - close $fd + close $::tcltest::fd set result } {1 {target application died}} @@ -654,3 +660,20 @@ if $gotTestCmds { testdeleteapps } rename newApp {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/text.test b/tests/text.test index 62d5839..fd953d0 100644 --- a/tests/text.test +++ b/tests/text.test @@ -3,14 +3,14 @@ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: text.test,v 1.2 1998/09/14 18:23:50 stanton Exp $ +# RCS: @(#) $Id: text.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} eval destroy [winfo child .] @@ -906,7 +906,7 @@ test text-20.17 {TextSearchCmd procedure, pattern case conversion} { } {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: unmatched ()}} +} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test text-20.19 {TextSearchCmd procedure, skip dummy last line} { .t search -backwards BaR end 1.0 } {2.23} @@ -1082,6 +1082,27 @@ test text-20.62 {TextSearchCmd, freeing copy of pattern} { set p $p$p$p$p$p .t search -nocase $p 1.0 } {} +test text-20.63 {TextSearchCmd, unicode} { + .t delete 1.0 end + .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 + .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 + 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} + eval destroy [winfo child .] text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 @@ -1260,3 +1281,20 @@ test text-23.1 {text widget vs hidden commands} { eval destroy [winfo child .] option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/textBTree.test b/tests/textBTree.test index d59a9b8..855a8f3 100644 --- a/tests/textBTree.test +++ b/tests/textBTree.test @@ -5,14 +5,14 @@ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: textBTree.test,v 1.2 1998/09/14 18:23:50 stanton Exp $ +# RCS: @(#) $Id: textBTree.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} catch {destroy .t} text .t @@ -893,5 +893,21 @@ test btree-18.9 {tag search back, large complex btree spans} { list [.t tag prev x end] [.t tag prev x 433.0] } {{500.0 520.0} {200.0 220.0}} - destroy .t + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/textDisp.test b/tests/textDisp.test index 9741fdc..7ae7f25 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -3,17 +3,16 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: textDisp.test,v 1.2 1998/09/14 18:23:50 stanton Exp $ +# RCS: @(#) $Id: textDisp.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ -if {[string compare test [info procs test]] == 1} { - source defs - if {$testConfig(fonts) == 0} { - puts "skipping font-sensitive tests" - } +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} +if {$::tcltest::testConfig(fonts) == 0} { + puts "skipping font-sensitive tests" } # The procedure below is used as the scrolling command for the text; @@ -2866,3 +2865,20 @@ foreach i [winfo children .] { catch {destroy $i} } option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/textImage.test b/tests/textImage.test index e639097..9b17358 100644 --- a/tests/textImage.test +++ b/tests/textImage.test @@ -1,7 +1,17 @@ -# RCS: @(#) $Id: textImage.test,v 1.2 1998/09/14 18:23:51 stanton Exp $ - -if {[string compare test [info procs test]] == 1} then \ - {source ../tests/defs} +# textImage.test -- test images embedded in text widgets +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: textImage.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} # Test Arguments: # name - Name of test, in the form foo-1.2. @@ -9,7 +19,7 @@ if {[string compare test [info procs test]] == 1} then \ # help humans understand what it does. # constraints - A list of one or more keywords, each of # which must be the name of an element in -# the array "testConfig". If any of these +# the array "::tcltest::testConfig". If any of these # elements is zero, the test is skipped. # This argument may be omitted. # script - Script to run to carry out the test. It must @@ -351,3 +361,20 @@ test textImage-4.3 {alignment and padding checking} {fonts} { catch {destroy .t} foreach image [image names] {image delete $image} font delete test_font + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/textIndex.test b/tests/textIndex.test index 1744834..2bfdbc1 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -3,21 +3,22 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: textIndex.test,v 1.2 1998/09/14 18:23:51 stanton Exp $ +# RCS: @(#) $Id: textIndex.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +# Some tests require the testtext command -if {[string compare test [info procs test]] == 1} then \ - {source defs} +set ::tcltest::testConfig(testtext) \ + [expr {[info commands testtext] != {}}] catch {destroy .t} -if [catch {text .t -font {Courier 12} -width 20 -height 10}] { - puts "The font needed by these tests isn't available, so I'm" - puts "going to skip the tests." - return -} +text .t -font {Courier -12} -width 20 -height 10 pack append . .t {top expand fill} update .t debug on @@ -35,73 +36,181 @@ wm deiconify . abcdefghijklm 12345 Line 4 -bOy GIrl .#@? x_yz +b\u4e4fy GIrl .#@? x_yz !@#$% Line 7" -test textIndex-1.1 {TkTextMakeIndex} { +image create photo textimage -width 10 -height 10 +textimage put red -to 0 0 9 9 + +test textIndex-1.1 {TkTextMakeByteIndex} {testtext} { + # (lineIndex < 0) + testtext .t byteindex -1 3 +} {1.0 0} +test textIndex-1.2 {TkTextMakeByteIndex} {testtext} { + # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1 + testtext .t byteindex 0 3 +} {1.0 0} +test textIndex-1.3 {TkTextMakeByteIndex} {testtext} { + # not (lineIndex < 0) + testtext .t byteindex 1 3 +} {1.3 3} +test textIndex-1.4 {TkTextMakeByteIndex} {testtext} { + # (byteIndex < 0) + testtext .t byteindex 3 -1 +} {3.0 0} +test textIndex-1.5 {TkTextMakeByteIndex} {testtext} { + # not (byteIndex < 0) + testtext .t byteindex 3 3 +} {3.3 3} +test textIndex-1.6 {TkTextMakeByteIndex} {testtext} { + # (indexPtr->linePtr == NULL) + testtext .t byteindex 9 2 +} {8.0 0} +test textIndex-1.7 {TkTextMakeByteIndex} {testtext} { + # not (indexPtr->linePtr == NULL) + testtext .t byteindex 7 2 +} {7.2 2} +test textIndex-1.8 {TkTextMakeByteIndex: shortcut for 0} {testtext} { + # (byteIndex == 0) + testtext .t byteindex 1 0 +} {1.0 0} +test textIndex-1.9 {TkTextMakeByteIndex: shortcut for 0} {testtext} { + # not (byteIndex == 0) + testtext .t byteindex 3 80 +} {3.5 5} +test textIndex-1.10 {TkTextMakeByteIndex: verify index is in range} {testtext} { + # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) + # one segment + + testtext .t byteindex 3 5 +} {3.5 5} +test textIndex-1.11 {TkTextMakeByteIndex: verify index is in range} {testtext} { + # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) + # index += segPtr->size + # Multiple segments, make sure add segment size to index. + + .t mark set foo 3.2 + set x [testtext .t byteindex 3 7] + .t mark unset foo + set x +} {3.5 5} +test textIndex-1.12 {TkTextMakeByteIndex: verify index is in range} {testtext} { + # (segPtr == NULL) + testtext .t byteindex 3 7 +} {3.5 5} +test textIndex-1.13 {TkTextMakeByteIndex: verify index is in range} {testtext} { + # not (segPtr == NULL) + testtext .t byteindex 3 4 +} {3.4 4} +test textIndex-1.14 {TkTextMakeByteIndex: verify index is in range} {testtext} { + # (index + segPtr->size > byteIndex) + # in this segment. + + testtext .t byteindex 3 4 +} {3.4 4} +test textIndex-1.15 {TkTextMakeByteIndex: verify index is in range} {testtext} { + # (index + segPtr->size > byteIndex), index != 0 + # in this segment. + + .t mark set foo 3.2 + set x [testtext .t byteindex 3 4] + .t mark unset foo + set x +} {3.4 4} +test textIndex-1.16 {TkTextMakeByteIndex: UTF-8 characters} {testtext} { + testtext .t byteindex 5 100 +} {5.18 20} +test textIndex-1.17 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \ + {testtext} { + # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) + # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f). + + set x [testtext .t byteindex 5 2] + list $x [.t get insert] +} {{5.2 4} y} +test textIndex-1.18 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \ + {testtext} { + # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) + testtext .t byteindex 5 1 + .t get insert +} "\u4e4f" + +test textIndex-2.1 {TkTextMakeCharIndex} { + # (lineIndex < 0) .t index -1.3 } 1.0 -test textIndex-1.2 {TkTextMakeIndex} { +test textIndex-2.2 {TkTextMakeCharIndex} { + # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1 .t index 0.3 } 1.0 -test textIndex-1.3 {TkTextMakeIndex} { +test textIndex-2.3 {TkTextMakeCharIndex} { + # not (lineIndex < 0) .t index 1.3 } 1.3 -test textIndex-1.4 {TkTextMakeIndex} { +test textIndex-2.4 {TkTextMakeCharIndex} { + # (charIndex < 0) .t index 3.-1 } 3.0 -test textIndex-1.5 {TkTextMakeIndex} { +test textIndex-2.5 {TkTextMakeCharIndex} { + # (charIndex < 0) .t index 3.3 } 3.3 -test textIndex-1.6 {TkTextMakeIndex} { +test textIndex-2.6 {TkTextMakeCharIndex} { + # (indexPtr->linePtr == NULL) + .t index 9.2 +} 8.0 +test textIndex-2.7 {TkTextMakeCharIndex} { + # not (indexPtr->linePtr == NULL) + .t index 7.2 +} 7.2 +test textIndex-2.8 {TkTextMakeCharIndex: verify index is in range} { + # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) + # one segment + .t index 3.5 } 3.5 -test textIndex-1.7 {TkTextMakeIndex} { - .t index 3.6 +test textIndex-2.9 {TkTextMakeCharIndex: verify index is in range} { + # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) + # Multiple segments, make sure add segment size to index. + + .t mark set foo 3.2 + set x [.t index 3.7] + .t mark unset foo + set x } 3.5 -test textIndex-1.8 {TkTextMakeIndex} { +test textIndex-2.10 {TkTextMakeCharIndex: verify index is in range} { + # (segPtr == NULL) .t index 3.7 } 3.5 -test textIndex-1.9 {TkTextMakeIndex} { - .t index 7.2 -} 7.2 -test textIndex-1.10 {TkTextMakeIndex} { - .t index 8.0 -} 8.0 -test textIndex-1.11 {TkTextMakeIndex} { - .t index 8.1 -} 8.0 -test textIndex-1.12 {TkTextMakeIndex} { - .t index 9.0 -} 8.0 +test textIndex-2.11 {TkTextMakeCharIndex: verify index is in range} { + # not (segPtr == NULL) + .t index 3.4 +} 3.4 +test textIndex-2.12 {TkTextMakeCharIndex: verify index is in range} { + # (segPtr->typePtr == &tkTextCharType) + # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f). + + .t mark set insert 5.2 + .t get insert +} y +test textIndex-2.13 {TkTextMakeCharIndex: verify index is in range} { + # not (segPtr->typePtr == &tkTextCharType) + + .t image create 5.2 -image textimage + .t mark set insert 5.5 + set x [.t get insert] + .t delete 5.2 + set x +} "G" +test textIndex-2.14 {TkTextMakeCharIndex: verify index is in range} { + # (charIndex < segPtr->size) -.t tag add x 2.3 2.6 -test textIndex-2.1 {TkTextIndexToSeg} { - .t get 2.0 -} a -test textIndex-2.2 {TkTextIndexToSeg} { - .t get 2.2 -} c -test textIndex-2.3 {TkTextIndexToSeg} { - .t get 2.3 -} d -test textIndex-2.4 {TkTextIndexToSeg} { - .t get 2.6 -} g -test textIndex-2.5 {TkTextIndexToSeg} { - .t get 2.7 -} h -test textIndex-2.6 {TkTextIndexToSeg} { - .t get 2.12 -} m -test textIndex-2.7 {TkTextIndexToSeg} { - .t get 2.13 -} \n -test textIndex-2.8 {TkTextIndexToSeg} { - .t get 2.14 -} \n -.t tag delete x + .t image create 5.0 -image textimage + set x [.t index 5.0] + .t delete 5.0 + set x +} 5.0 .t mark set foo 3.2 .t tag add x 2.8 2.11 @@ -242,8 +351,8 @@ test textIndex-10.4 {ForwBack} { list [catch {.t index {2.3 - 3ch}} msg] $msg } {0 2.0} test textIndex-10.5 {ForwBack} { - list [catch {.t index {2.3 + 3 lines}} msg] $msg -} {0 5.3} + list [catch {.t index {1.3 + 3 lines}} msg] $msg +} {0 4.3} test textIndex-10.6 {ForwBack} { list [catch {.t index {2.3 -1l}} msg] $msg } {0 1.3} @@ -253,97 +362,325 @@ test textIndex-10.7 {ForwBack} { test textIndex-10.8 {ForwBack} { list [catch {.t index {2.3 - 4 lines}} msg] $msg } {0 1.3} +test textIndex-10.9 {ForwBack} { + .t mark set insert 2.0 + list [catch {.t index {insert -0 chars}} msg] $msg +} {0 2.0} +test textIndex-10.10 {ForwBack} { + .t mark set insert 2.end + list [catch {.t index {insert +0 chars}} msg] $msg +} {0 2.13} -test textIndex-11.1 {TkTextIndexForwChars} { +test textIndex-11.1 {TkTextIndexForwBytes} {testtext} { + testtext .t forwbytes 2.3 -7 +} {1.3 3} +test textIndex-11.2 {TkTextIndexForwBytes} {testtext} { + testtext .t forwbytes 2.3 5 +} {2.8 8} +test textIndex-11.3 {TkTextIndexForwBytes} {testtext} { + testtext .t forwbytes 2.3 10 +} {2.13 13} +test textIndex-11.4 {TkTextIndexForwBytes} {testtext} { + testtext .t forwbytes 2.3 11 +} {3.0 0} +test textIndex-11.5 {TkTextIndexForwBytes} {testtext} { + testtext .t forwbytes 2.3 57 +} {7.6 6} +test textIndex-11.6 {TkTextIndexForwBytes} {testtext} { + testtext .t forwbytes 2.3 58 +} {8.0 0} +test textIndex-11.7 {TkTextIndexForwBytes} {testtext} { + testtext .t forwbytes 2.3 59 +} {8.0 0} + +test textIndex-12.1 {TkTextIndexForwChars} { + # (charCount < 0) .t index {2.3 + -7 chars} } 1.3 -test textIndex-11.2 {TkTextIndexForwChars} { +test textIndex-12.2 {TkTextIndexForwChars} { + # not (charCount < 0) .t index {2.3 + 5 chars} } 2.8 -test textIndex-11.3 {TkTextIndexForwChars} { +test textIndex-12.3 {TkTextIndexForwChars: find index} { + # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) + # one loop + .t index {2.3 + 9 chars} +} 2.12 +test textIndex-12.4 {TkTextIndexForwChars: find index} { + # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) + # multiple loops + .t mark set foo 2.5 + set x [.t index {2.3 + 9 chars}] + .t mark unset foo + set x +} 2.12 +test textIndex-12.5 {TkTextIndexForwChars: find index} { + # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) + # border condition: last char + .t index {2.3 + 10 chars} } 2.13 -test textIndex-11.4 {TkTextIndexForwChars} { +test textIndex-12.6 {TkTextIndexForwChars: find index} { + # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) + # border condition: segPtr == NULL -> beginning of next line + .t index {2.3 + 11 chars} } 3.0 -test textIndex-11.5 {TkTextIndexForwChars} { - .t index {2.3 + 55 chars} -} 7.6 -test textIndex-11.6 {TkTextIndexForwChars} { +test textIndex-12.7 {TkTextIndexForwChars: find index} { + # (segPtr->typePtr == &tkTextCharType) + .t index {2.3 + 2 chars} +} 2.5 +test textIndex-12.8 {TkTextIndexForwChars: find index} { + # (charCount == 0) + # No more chars, so we found byte offset. + + .t index {2.3 + 2 chars} +} 2.5 +test textIndex-12.9 {TkTextIndexForwChars: find index} { + # not (segPtr->typePtr == &tkTextCharType) + + .t image create 2.4 -image textimage + set x [.t get {2.3 + 3 chars}] + .t delete 2.4 + set x +} "f" +test textIndex-12.10 {TkTextIndexForwChars: find index} { + # dstPtr->byteIndex += segPtr->size - byteOffset + # When moving to next segment, account for bytes in last segment. + # Wrong answer would be 2.4 + + .t mark set foo 2.4 + set x [.t index {2.3 + 5 chars}] + .t mark unset foo + set x +} 2.8 +test textIndex-12.11 {TkTextIndexForwChars: go to next line} { + # (linePtr == NULL) + .t index {7.6 + 3 chars} +} 8.0 +test textIndex-12.12 {TkTextIndexForwChars: go to next line} { + # Reset byteIndex to 0 now that we are on a new line. + # Wrong answer would be 2.9 + .t index {1.3 + 6 chars} +} 2.2 +test textIndex-12.13 {TkTextIndexForwChars} { + # right to end .t index {2.3 + 56 chars} } 8.0 -test textIndex-11.7 {TkTextIndexForwChars} { +test textIndex-12.14 {TkTextIndexForwChars} { + # try to go past end .t index {2.3 + 57 chars} } 8.0 -test textIndex-12.1 {TkTextIndexBackChars} { +test textIndex-13.1 {TkTextIndexBackBytes} {testtext} { + testtext .t backbytes 3.2 -10 +} {4.6 6} +test textIndex-13.2 {TkTextIndexBackBytes} {testtext} { + testtext .t backbytes 3.2 2 +} {3.0 0} +test textIndex-13.3 {TkTextIndexBackBytes} {testtext} { + testtext .t backbytes 3.2 3 +} {2.13 13} +test textIndex-13.4 {TkTextIndexBackBytes} {testtext} { + testtext .t backbytes 3.2 22 +} {1.1 1} +test textIndex-13.5 {TkTextIndexBackBytes} {testtext} { + testtext .t backbytes 3.2 23 +} {1.0 0} +test textIndex-13.6 {TkTextIndexBackBytes} {testtext} { + testtext .t backbytes 3.2 24 +} {1.0 0} + +test textIndex-14.1 {TkTextIndexBackChars} { + # (charCount < 0) .t index {3.2 - -10 chars} } 4.6 -test textIndex-12.2 {TkTextIndexBackChars} { +test textIndex-14.2 {TkTextIndexBackChars} { + # not (charCount < 0) .t index {3.2 - 2 chars} } 3.0 -test textIndex-12.3 {TkTextIndexBackChars} { +test textIndex-14.3 {TkTextIndexBackChars: find starting segment} { + # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) + # single loop + .t index {3.2 - 3 chars} } 2.13 -test textIndex-12.4 {TkTextIndexBackChars} { +test textIndex-14.4 {TkTextIndexBackChars: find starting segment} { + # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) + # multiple loop + + .t mark set foo1 2.5 + .t mark set foo2 2.7 + .t mark set foo3 2.10 + set x [.t index {2.9 - 1 chars}] + .t mark unset foo1 foo2 foo3 + set x +} 2.8 +test textIndex-14.5 {TkTextIndexBackChars: find starting seg and offset} { + # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) + # Make sure segSize was decremented. Wrong answer would be 2.10 + + .t mark set foo 2.2 + set x [.t index {2.9 - 1 char}] + .t mark unset foo + set x +} 2.8 +test textIndex-14.6 {TkTextIndexBackChars: back over characters} { + # (segPtr->typePtr == &tkTextCharType) + .t index {3.2 - 22 chars} } 1.1 -test textIndex-12.5 {TkTextIndexBackChars} { - .t index {3.2 - 23 chars} -} 1.0 -test textIndex-12.6 {TkTextIndexBackChars} { - .t index {3.2 - 24 chars} +test textIndex-14.7 {TkTextIndexBackChars: loop backwards over chars} { + # (charCount == 0) + # No more chars, so we found byte offset. + + .t index {3.4 - 2 chars} +} 3.2 +test textIndex-14.8 {TkTextIndexBackChars: loop backwards over chars} { + # (p == start) + # Still more chars, but we reached beginning of segment + + .t image create 5.6 -image textimage + set x [.t index {5.8 - 3 chars}] + .t delete 5.6 + set x +} 5.5 +test textIndex-14.9 {TkTextIndexBackChars: back over image} { + # not (segPtr->typePtr == &tkTextCharType) + + .t image create 5.6 -image textimage + set x [.t get {5.8 - 4 chars}] + .t delete 5.6 + set x +} "G" +test textIndex-14.10 {TkTextIndexBackChars: move to previous segment} { + # (segPtr != oldPtr) + # More segments to go + + .t mark set foo 3.4 + set x [.t index {3.5 - 2 chars}] + .t mark unset foo + set x +} 3.3 +test textIndex-14.11 {TkTextIndexBackChars: move to previous segment} { + # not (segPtr != oldPtr) + # At beginning of line. + + .t mark set foo 3.4 + set x [.t index {3.5 - 10 chars}] + .t mark unset foo + set x +} 2.9 +test textIndex-14.12 {TkTextIndexBackChars: move to previous line} { + # (lineIndex == 0) + .t index {1.5 - 10 chars} } 1.0 +test textIndex-14.13 {TkTextIndexBackChars: move to previous line} { + # not (lineIndex == 0) + .t index {2.5 - 10 chars} +} 1.2 +test textIndex-14.14 {TkTextIndexBackChars: move to previous line} { + # for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr) + # Set byteIndex to end of previous line so we can subtract more + # bytes from it. Otherwise we get an TkTextIndex with a negative + # byteIndex. + + .t index {2.5 - 6 chars} +} 1.6 +test textIndex-14.15 {TkTextIndexBackChars: UTF} { + .t get {5.3 - 1 chars} +} y +test textIndex-14.16 {TkTextIndexBackChars: UTF} { + .t get {5.3 - 2 chars} +} \u4e4f +test textIndex-14.17 {TkTextIndexBackChars: UTF} { + .t get {5.3 - 3 chars} +} b proc getword index { .t get [.t index "$index wordstart"] [.t index "$index wordend"] } -test textIndex-13.1 {StartEnd} { +test textIndex-15.1 {StartEnd} { list [catch {.t index {2.3 lineend}} msg] $msg } {0 2.13} -test textIndex-13.2 {StartEnd} { +test textIndex-15.2 {StartEnd} { list [catch {.t index {2.3 linee}} msg] $msg } {0 2.13} -test textIndex-13.3 {StartEnd} { +test textIndex-15.3 {StartEnd} { list [catch {.t index {2.3 line}} msg] $msg } {1 {bad text index "2.3 line"}} -test textIndex-13.4 {StartEnd} { +test textIndex-15.4 {StartEnd} { list [catch {.t index {2.3 linestart}} msg] $msg } {0 2.0} -test textIndex-13.5 {StartEnd} { +test textIndex-15.5 {StartEnd} { list [catch {.t index {2.3 lines}} msg] $msg } {0 2.0} -test textIndex-13.6 {StartEnd} { +test textIndex-15.6 {StartEnd} { getword 5.3 } { } -test textIndex-13.7 {StartEnd} { +test textIndex-15.7 {StartEnd} { getword 5.4 } GIrl -test textIndex-13.8 {StartEnd} { +test textIndex-15.8 {StartEnd} { getword 5.7 } GIrl -test textIndex-13.9 {StartEnd} { +test textIndex-15.9 {StartEnd} { getword 5.8 } { } -test textIndex-13.10 {StartEnd} { +test textIndex-15.10 {StartEnd} { getword 5.14 } x_yz -test textIndex-13.11 {StartEnd} { +test textIndex-15.11 {StartEnd} { getword 6.2 } # -test textIndex-13.12 {StartEnd} { +test textIndex-15.12 {StartEnd} { getword 3.4 } 12345 .t tag add x 2.8 2.11 -test textIndex-13.13 {StartEnd} { +test textIndex-15.13 {StartEnd} { list [catch {.t index {2.2 worde}} msg] $msg } {0 2.13} -test textIndex-13.14 {StartEnd} { +test textIndex-15.14 {StartEnd} { list [catch {.t index {2.12 words}} msg] $msg } {0 2.0} -test textIndex-13.15 {StartEnd} { +test textIndex-15.15 {StartEnd} { list [catch {.t index {2.12 word}} msg] $msg } {1 {bad text index "2.12 word"}} +test testIndex-16.1 {TkTextPrintIndex} { + set t [text .t2] + $t insert end \n + $t window create end -window [button $t.b] + set result [$t index end-2c] + pack $t + catch {destroy $t} +} 0 + + +test testIndex-16.2 {TkTextPrintIndex} { + set t [text .t2] + $t insert end \n + $t window create end -window [button $t.b] + set result [$t tag add {} end-2c] + pack $t + catch {destroy $t} +} 0 + +# cleanup +rename textimage {} catch {destroy .t} -concat +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/textMark.test b/tests/textMark.test index 6bc2589..775c252 100644 --- a/tests/textMark.test +++ b/tests/textMark.test @@ -3,19 +3,20 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: textMark.test,v 1.2 1998/09/14 18:23:51 stanton Exp $ +# RCS: @(#) $Id: textMark.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} catch {destroy .t} if [catch {text .t -font {Courier 12} -width 20 -height 10}] { puts "The font needed by these tests isn't available, so I'm" puts "going to skip the tests." + ::tcltest::cleanupTests return } pack append . .t {top expand fill} @@ -219,4 +220,20 @@ test textMark-8.8 {MarkFindPrev - no previous mark} { } {} catch {destroy .t} -concat {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/textTag.test b/tests/textTag.test index 79901cf..0cfc840 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -3,19 +3,20 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: textTag.test,v 1.2 1998/09/14 18:23:52 stanton Exp $ +# RCS: @(#) $Id: textTag.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} catch {destroy .t} if [catch {text .t -font {Courier 12} -width 20 -height 10}] { puts "The font needed by these tests isn't available, so I'm" puts "going to skip the tests." + ::tcltest::cleanupTests return } pack append . .t {top expand fill} @@ -183,7 +184,14 @@ test textTag-3.7 {TkTextTagCmd - "bind" option} { .t tag bind x <Enter> } {script1 script2} - +test textTag-3.7 {TkTextTagCmd - "bind" option} { + .t tag delete x + list [catch {.t tag bind x <Enter>} msg] $msg +} {0 {}} +test textTag-3.8 {TkTextTagCmd - "bind" option} { + .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} { list [catch {.t tag cget a} msg] $msg @@ -753,4 +761,20 @@ test textTag-16.7 {TkTextPickCurrent procedure} { } {3.1} catch {destroy .t} -concat {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/textWind.test b/tests/textWind.test index a62663d..4e11955 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -3,14 +3,14 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: textWind.test,v 1.2 1998/09/14 18:23:52 stanton Exp $ +# RCS: @(#) $Id: textWind.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} foreach i [winfo child .] { catch {destroy $i} @@ -824,3 +824,20 @@ pack .t catch {destroy .t} option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/tk.test b/tests/tk.test index 89a853b..c62832c 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -2,14 +2,13 @@ # It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: tk.test,v 1.2 1998/09/14 18:23:52 stanton Exp $ +# RCS: @(#) $Id: tk.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ -if {[info commands test] == ""} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } test tk-1.1 {tk command: general} { @@ -17,7 +16,7 @@ test tk-1.1 {tk command: general} { } {1 {wrong # args: should be "tk option ?arg?"}} test tk-1.2 {tk command: general} { list [catch {tk xyz} msg] $msg -} {1 {bad option "xyz": must be appname, or scaling}} +} {1 {bad option "xyz": must be appname or scaling}} set appname [tk appname] test tk-2.1 {tk command: appname} { @@ -78,3 +77,20 @@ test tk-3.11 {tk command: scaling: heightmm} { expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]} } {0} tk scaling $scaling + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/unixButton.test b/tests/unixButton.test index 6788655..6604e36 100644 --- a/tests/unixButton.test +++ b/tests/unixButton.test @@ -5,13 +5,18 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: unixButton.test,v 1.2 1998/09/14 18:23:52 stanton Exp $ +# RCS: @(#) $Id: unixButton.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {$tcl_platform(platform)!="unix"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests return } @@ -19,13 +24,10 @@ if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\"" puts "image, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -180,3 +182,20 @@ test unixbutton-1.11 {TkpComputeButtonGeometry procedure} { } {27 37} eval destroy [winfo children .] + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test index 39a3cf5..2f2970d 100644 --- a/tests/unixEmbed.test +++ b/tests/unixEmbed.test @@ -3,18 +3,19 @@ # tests. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: unixEmbed.test,v 1.4 1998/12/08 04:05:34 hershey Exp $ +# RCS: @(#) $Id: unixEmbed.test,v 1.5 1999/04/16 01:51:41 stanton Exp $ -if {$tcl_platform(platform) != "unix"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {[info procs test] != "test"} { - source defs +if {$tcl_platform(platform) != "unix"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests + return } eval destroy [winfo children .] @@ -72,7 +73,7 @@ test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} { 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} { +test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {nonPortable} { catch {destroy .t} catch {destroy .x} toplevel .t -colormap new @@ -84,7 +85,7 @@ test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} { destroy .t set result } {0} -test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} { +test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {nonPortable} { catch {destroy .t} catch {destroy .t2} catch {destroy .x} @@ -101,6 +102,7 @@ if {[string compare testembed [info commands testembed]] != 0} { puts "This application hasn't been compiled with the testembed command," puts "therefore I am skipping all of these tests." cleanupbg + ::tcltest::cleanupTests return } @@ -621,8 +623,23 @@ test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} { wm geometry .t1 } {70x300+0+0} - +# cleanup foreach w [winfo child .] { catch {destroy $w} } cleanupbg +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/unixFont.test b/tests/unixFont.test index 9dcd672..896eda9 100644 --- a/tests/unixFont.test +++ b/tests/unixFont.test @@ -9,18 +9,19 @@ # at all sites. # # Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: unixFont.test,v 1.2 1998/09/14 18:23:52 stanton Exp $ +# RCS: @(#) $Id: unixFont.test,v 1.3 1999/04/16 01:51:42 stanton Exp $ -if {$tcl_platform(platform)!="unix"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {[string compare test [info procs test]] != 0} { - source defs +if {$tcl_platform(platform)!="unix"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests + return } catch {destroy .b} @@ -222,23 +223,25 @@ test unixfont-8.1 {AllocFont procedure: use old font} { font delete xyz } {} test unixfont-8.2 {AllocFont procedure: parse information from XLFD} { - expr [lindex [font actual {-family times -size 0}] 3]==0 + expr {[lindex [font actual {-family times -size 0}] 3] == 0} } {0} test unixfont-8.3 {AllocFont procedure: can't parse info from name} { - if [catch {set a [font actual a12biluc]}]==0 { - string compare $a "-family a12biluc -size 0 -weight normal -slant roman -underline 0 -overstrike 0" - } else { - set a 0 - } -} {0} + catch {unset fontArray} + # check that font actual returns the correct attributes. + # the values of those attributes are system dependent. + array set fontArray [font actual a12biluc] + set result [lsort [array names fontArray]] + catch {unset fontArray} + set result +} {-family -overstrike -size -slant -underline -weight} test unixfont-8.4 {AllocFont procedure: classify characters} { set x 0 - incr x [font measure $courier "\001"] ;# 4 + incr x [font measure $courier "\u4000"] ;# 6 incr x [font measure $courier "\002"] ;# 4 incr x [font measure $courier "\012"] ;# 2 incr x [font measure $courier "\101"] ;# 1 set x -} [expr $cx*11] +} [expr $cx*13] test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} { font metrics $courier -fixed } {1} @@ -281,7 +284,7 @@ test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} { } {0 1 1 2} test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} { .b.c dchars $t 0 end - .b.c insert $t 0 "0\1770" + .b.c insert $t 0 "0\0010" set x {} lappend x [.b.c index $t @[expr $ax*0],0] lappend x [.b.c index $t @[expr $ax*1],0] @@ -291,3 +294,19 @@ test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} { lappend x [.b.c index $t @[expr $ax*5],0] } {0 1 1 1 1 2} +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/unixMenu.test b/tests/unixMenu.test index cd1e87b..ebc833b 100644 --- a/tests/unixMenu.test +++ b/tests/unixMenu.test @@ -4,13 +4,18 @@ # system. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: unixMenu.test,v 1.2 1998/09/14 18:23:52 stanton Exp $ +# RCS: @(#) $Id: unixMenu.test,v 1.3 1999/04/16 01:51:42 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {$tcl_platform(platform) != "unix"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests return } @@ -18,13 +23,10 @@ if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - proc deleteWindows {} { foreach i [winfo children .] { catch [destroy $i] @@ -332,8 +334,8 @@ test unixMenu-18.1 {GetTearoffEntryGeometry} { .mb.m add command -label test pack .mb raise . - list [catch {tkMbPost .mb} msg] $msg [destroy .mb] -} {0 {} {}} + list [catch {tkMbPost .mb} msg] $msg [tkMenuUnpost .mb.m] [destroy .mb] +} {0 {} {} {}} # Don't know how to reproduce the case where the tkwin has been deleted. test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} { @@ -848,8 +850,8 @@ test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { .mb.m add command -label test pack .mb catch {tkMbPost .mb} - list [update] [destroy .mb] -} {{} {}} + list [update] [tkMenuUnpost .mb.m] [destroy .mb] +} {{} {} {}} test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} { catch {destroy .m1} menu .m1 @@ -966,4 +968,20 @@ test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} { test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {} +# cleanup deleteWindows +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/unixSend.test b/tests/unixSend.test new file mode 100644 index 0000000..5914dd7 --- /dev/null +++ b/tests/unixSend.test @@ -0,0 +1,679 @@ +# This file is a Tcl script to test out the "send" command and the +# other procedures in the file tkSend.c. It is organized in the +# standard fashion for Tcl tests. +# +# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: unixSend.test,v 1.2 1999/04/16 01:51:42 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {$tcl_platform(platform) == "macintosh"} { + puts "send is not available on the Mac - skipping tests" + ::tcltest::cleanupTests + return +} +if {$tcl_platform(platform) == "windows"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests + return +} +if {[auto_execok xhost] == ""} { + puts "xhost application isn't available - skipping tests" + ::tcltest::cleanupTests + return +} + +if {[info commands testsend] == "testsend"} { + set gotTestCmds 1 +} else { + set gotTestCmds 0 +} + +foreach i [winfo children .] { + destroy $i +} +wm geometry . {} +raise . + +# If send is disabled because of inadequate security, don't run any +# of these tests at all. + +setupbg +set app [dobg {tk appname}] +if {[catch {send $app set a 0} msg] == 1} { + if [string match "X server insecure *" $msg] { + puts -nonewline "Your X server is insecure, so \"send\" can't be used;" + puts " skipping \"send\" tests." + cleanupbg + ::tcltest::cleanupTests + return + } +} +cleanupbg + +# Compute a script that will load Tk into a child interpreter. + +foreach pkg [info loaded] { + if {[lindex $pkg 1] == "Tk"} { + set loadTk "load $pkg" + break + } +} + +# Procedure to create a new application with a given name and class. + +proc newApp {screen name class} { + global loadTk + interp create $name + $name eval [list set argv [list -display $screen -name $name -class $class]] + eval $loadTk $name +} + +set name [tk appname] +if $gotTestCmds { + set registry [testsend prop root InterpRegistry] + set commId [lindex [testsend prop root InterpRegistry] 0] +} +tk appname tktest +catch {send t_s_1 destroy .} +catch {send t_s_2 destroy .} + +if $gotTestCmds { + test unixSend-1.1 {RegOpen procedure, bogus property} { + testsend bogus + set result [winfo interps] + tk appname tktest + list $result [winfo interps] + } {{} tktest} + test unixSend-1.2 {RegOpen procedure, bogus property} { + testsend prop root InterpRegistry {} + set result [winfo interps] + tk appname tktest + list $result [winfo interps] + } {{} tktest} + test unixSend-1.3 {RegOpen procedure, bogus property} { + testsend prop root InterpRegistry abcdefg + tk appname tktest + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end + } " tktest\nabcdefg\n" + + frame .f -width 1 -height 1 + set id [string range [winfo id .f] 2 end] + test unixSend-2.1 {RegFindName procedure} { + testsend prop root InterpRegistry {} + list [catch {send foo bar} msg] $msg + } {1 {no application named "foo"}} + test unixSend-2.2 {RegFindName procedure} { + testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n" + tk appname foo + } {foo #2} + test unixSend-2.3 {RegFindName procedure} { + testsend prop root InterpRegistry "gyz foo\n" + tk appname foo + } {foo} + test unixSend-2.4 {RegFindName procedure} { + testsend prop root InterpRegistry "${id}z foo\n" + tk appname foo + } {foo} + + test unixSend-3.1 {RegDeleteName procedure} { + tk appname tktest + testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end + } " x\n012345 gorp\n12345 foo\n" + test unixSend-3.2 {RegDeleteName procedure} { + tk appname tktest + testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end + } " x\n012345 gorp\n23456 tktest\n" + test unixSend-3.3 {RegDeleteName procedure} { + tk appname tktest + testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end + } " x\n12345 bar\n23456 tktest\n" + test unixSend-3.4 {RegDeleteName procedure} { + tk appname tktest + testsend prop root InterpRegistry "foo" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end + } " x\nfoo\n" + test unixSend-3.5 {RegDeleteName procedure} { + tk appname tktest + testsend prop root InterpRegistry "" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end + } " x\n" + + test unixSend-4.1 {RegAddName procedure} { + testsend prop root InterpRegistry "" + tk appname bar + testsend prop root InterpRegistry + } "$commId bar\n" + test unixSend-4.2 {RegAddName procedure} { + testsend prop root InterpRegistry "abc def" + tk appname bar + tk appname foo + testsend prop root InterpRegistry + } "$commId foo\nabc def\n" + + # Previous checks should already cover the Regclose procedure. + + test unixSend-5.1 {ValidateName procedure} { + testsend prop root InterpRegistry "123 abc\n" + winfo interps + } {} + test unixSend-5.2 {ValidateName procedure} { + testsend prop root InterpRegistry "$id Hi there" + winfo interps + } {{Hi there}} + test unixSend-5.3 {ValidateName procedure} { + testsend prop root InterpRegistry "$id Bogus" + list [catch {send Bogus set a 44} msg] $msg + } {1 {target application died or uses a Tk version before 4.0}} + test unixSend-5.4 {ValidateName procedure} { + tk appname test + testsend prop root InterpRegistry "$commId Bogus\n$commId test\n" + winfo interps + } {test} +} + +winfo interps +tk appname tktest +update +setupbg +set x [split [exec xhost] \n] +foreach i [lrange $x 1 end] { + exec xhost - $i +} +test unixSend-6.1 {ServerSecure procedure} {nonPortable} { + set a 44 + list [dobg [list send [tk appname] set a 55]] $a +} {55 55} +test unixSend-6.2 {ServerSecure procedure} {nonPortable} { + set a 22 + exec xhost [exec hostname] + list [catch {dobg [list send [tk appname] set a 33]} msg] $a $msg +} {0 22 {X server insecure (must use xauth-style authorization); command ignored}} +test unixSend-6.3 {ServerSecure procedure} {nonPortable} { + set a abc + exec xhost - [exec hostname] + list [dobg [list send [tk appname] set a new]] $a +} {new new} +cleanupbg + +if $gotTestCmds { + test unixSend-7.1 {Tk_SetAppName procedure} { + testsend prop root InterpRegistry "" + tk appname newName + list [tk appname oldName] [testsend prop root InterpRegistry] + } "oldName {$commId oldName\n}" + test unixSend-7.2 {Tk_SetAppName procedure, name not in use} { + testsend prop root InterpRegistry "" + list [tk appname gorp] [testsend prop root InterpRegistry] + } "gorp {$commId gorp\n}" + test unixSend-7.3 {Tk_SetAppName procedure, name in use by us} { + tk appname name1 + testsend prop root InterpRegistry "$commId name2\n" + list [tk appname name2] [testsend prop root InterpRegistry] + } "name2 {$commId name2\n}" + test unixSend-7.4 {Tk_SetAppName procedure, name in use} { + tk appname name1 + testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n" + list [tk appname foo] [testsend prop root InterpRegistry] + } "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}" +} + +test unixSend-8.1 {Tk_SendCmd procedure, options} { + setupbg + set app [dobg {tk appname}] + set a 66 + send -async $app [list send [tk appname] set a 77] + set result $a + after 200 set x 40 + tkwait variable x + cleanupbg + lappend result $a +} {66 77} +if [info exists env(TK_ALT_DISPLAY)] { + test unixSend-8.2 {Tk_SendCmd procedure, options} { + setupbg -display $env(TK_ALT_DISPLAY) + tk appname xyzgorp + set a homeDisplay + set result [dobg " + toplevel .t -screen [winfo screen .] + wm geometry .t +0+0 + set a altDisplay + tk appname xyzgorp + list \[send xyzgorp set a\] \[send -displayof .t xyzgorp set a\] + "] + cleanupbg + set result + } {altDisplay homeDisplay} +} +test unixSend-8.3 {Tk_SendCmd procedure, options} { + list [catch {send -- -async foo bar baz} msg] $msg +} {1 {no application named "-async"}} +test unixSend-8.4 {Tk_SendCmd procedure, options} { + list [catch {send -gorp foo bar baz} msg] $msg +} {1 {bad option "-gorp": must be -async, -displayof, or --}} +test unixSend-8.5 {Tk_SendCmd procedure, options} { + list [catch {send -async foo} msg] $msg +} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} +test unixSend-8.6 {Tk_SendCmd procedure, options} { + list [catch {send foo} msg] $msg +} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} +test unixSend-8.7 {Tk_SendCmd procedure, local execution} { + set a initial + send [tk appname] {set a new} + set a +} {new} +test unixSend-8.8 {Tk_SendCmd procedure, local execution} { + set a initial + send [tk appname] set a new + set a +} {new} +test unixSend-8.9 {Tk_SendCmd procedure, local execution} { + set a initial + string tolower [list [catch {send [tk appname] open bad_file} msg] \ + $msg $errorInfo $errorCode] +} {1 {couldn't open "bad_file": no such file or directory} {couldn't open "bad_file": no such file or directory + while executing +"open bad_file" + invoked from within +"send [tk appname] open bad_file"} {posix enoent {no such file or directory}}} +test unixSend-8.10 {Tk_SendCmd procedure, no such interpreter} { + list [catch {send bogus_name bogus_command} msg] $msg +} {1 {no application named "bogus_name"}} +if $gotTestCmds { + newApp "" t_s_1 Test + t_s_1 eval wm withdraw . + test unixSend-8.11 {Tk_SendCmd procedure, local execution, different interp} { + set a us + send t_s_1 set a them + list $a [send t_s_1 set a] + } {us them} + test unixSend-8.12 {Tk_SendCmd procedure, local execution, different interp} { + set a us + send t_s_1 {set a them} + list $a [send t_s_1 {set a}] + } {us them} + test unixSend-8.13 {Tk_SendCmd procedure, local execution, different interp} { + set a us + send t_s_1 {set a them} + list $a [send t_s_1 {set a}] + } {us them} + test unixSend-8.14 {Tk_SendCmd procedure, local interp killed by send} { + newApp "" t_s_2 Test + list [catch {send t_s_2 {destroy .; concat result}} msg] $msg + } {0 result} + interp delete t_s_2 + test unixSend-8.15 {Tk_SendCmd procedure, local interp, error info} { + catch {error foo} + list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode + } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory + while executing +"open bogus_file_name" + invoked from within +"if 1 {open bogus_file_name}" + invoked from within +"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}} + test unixSend-8.16 {Tk_SendCmd procedure, bogusCommWindow} { + testsend prop root InterpRegistry "10234 bogus\n" + set result [list [catch {send bogus bogus command} msg] $msg] + winfo interps + tk appname tktest + set result + } {1 {no application named "bogus"}} + interp delete t_s_1 +} +test unixSend-8.17 {Tk_SendCmd procedure, deferring events} {nonPortable} { + # Non-portable because some window managers ignore "raise" + # requests so can't guarantee that new app's window won't + # obscure .f, thereby masking the Expose event. + + setupbg + set app [dobg {tk appname}] + raise . ; # Don't want new app obscuring .f + catch {destroy .f} + frame .f + place .f -x 0 -y 0 + bind .f <Expose> {set a exposed} + set a {no event yet} + set result "" + lappend result [send $app send [list [tk appname]] set a] + lappend result $a + update + cleanupbg + lappend result $a +} {{no event yet} {no event yet} exposed} +test unixSend-8.18 {Tk_SendCmd procedure, error in remote app} { + setupbg + set app [dobg {tk appname}] + set result [string tolower [list [catch {send $app open bad_name} msg] \ + $msg $errorInfo $errorCode]] + cleanupbg + set result +} {1 {couldn't open "bad_name": no such file or directory} {couldn't open "bad_name": no such file or directory + while executing +"open bad_name" + invoked from within +"send $app open bad_name"} {posix enoent {no such file or directory}}} +test unixSend-8.19 {Tk_SendCmd, using modal timeouts} { + setupbg + set app [dobg {tk appname}] + set x no + set result "" + after 0 {set x yes} + lappend result [send $app {concat x y z}] + lappend result $x + update + cleanupbg + lappend result $x +} {{x y z} no yes} + +tk appname tktest +catch {destroy .f} +frame .f +set id [string range [winfo id .f] 2 end] +if $gotTestCmds { + test unixSend-9.1 {Tk_GetInterpNames procedure} { + testsend prop root InterpRegistry \ + "$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n" + list [winfo interps] [testsend prop root InterpRegistry] + } "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f +}" + test unixSend-9.2 {Tk_GetInterpNames procedure} { + testsend prop root InterpRegistry \ + "$commId tktest\nfoobar\n$commId gorp\n" + list [winfo interps] [testsend prop root InterpRegistry] + } "tktest {$commId tktest\n}" + test unixSend-9.3 {Tk_GetInterpNames procedure} { + testsend prop root InterpRegistry {} + list [winfo interps] [testsend prop root InterpRegistry] + } {{} {}} + + testsend prop root InterpRegistry "$commId tktest\n$id dummy\n" + test unixSend-10.1 {SendEventProc procedure, bogus comm property} { + testsend prop comm Comm {abc def} + testsend prop comm Comm {} + update + } {} + test unixSend-10.2 {SendEventProc procedure, simultaneous messages} { + testsend prop comm Comm \ + "c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n" + set a null + set b xyzzy + update + list $a $b + } {44 45} + test unixSend-10.3 {SendEventProc procedure, simultaneous messages} { + testsend prop comm Comm \ + "c\n-n tktest\n-s set a newA\nr\n-s [testsend serial]\n-r 12345\nc\n-n tktest\n-s set b newB\n" + set a null + set b xyzzy + set x [send dummy bogus] + list $x $a $b + } {12345 newA newB} + test unixSend-10.4 {SendEventProc procedure, leading nulls, bogus commands} { + testsend prop comm Comm \ + "\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n" + set a null + update + set a + } {44} + test unixSend-10.5 {SendEventProc procedure, extraneous command options} { + testsend prop comm Comm \ + "c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n" + set a null + update + set a + } {new} + test unixSend-10.6 {SendEventProc procedure, unknown interpreter} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n unknown\n-r $id 44\n-s set a new\n" + set a null + update + list [testsend prop [winfo id .f] Comm] $a + } "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null" + test unixSend-10.7 {SendEventProc procedure, error in script} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n" + update + testsend prop [winfo id .f] Comm + } { +r +-s 62 +-r test error +-i Initial errorInfo + ("foreach" body line 1) + invoked from within +"foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}" +-e test code +-c 1 +} + test unixSend-10.8 {SendEventProc procedure, exceptional return} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-r $id 62\n-s break\n" + update + testsend prop [winfo id .f] Comm + } { +r +-s 62 +-r +-c 3 +} + test unixSend-10.9 {SendEventProc procedure, empty return} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-r $id 62\n-s concat\n" + update + testsend prop [winfo id .f] Comm + } { +r +-s 62 +-r +} + test unixSend-10.10 {SendEventProc procedure, asynchronous calls} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n" + update + testsend prop [winfo id .f] Comm + } {} + test unixSend-10.11 {SendEventProc procedure, exceptional return} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-s break\n" + update + testsend prop [winfo id .f] Comm + } {} + test unixSend-10.12 {SendEventProc procedure, empty return} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-s concat\n" + update + testsend prop [winfo id .f] Comm + } {} + test unixSend-10.13 {SendEventProc procedure, return processing} { + testsend prop comm Comm \ + "r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n" + list [catch {send dummy foo} msg] $msg $errorInfo $errorCode + } {1 test3 {test2 + invoked from within +"send dummy foo"} test1} + test unixSend-10.14 {SendEventProc procedure, extraneous return options} { + testsend prop comm Comm \ + "r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n" + list [catch {send dummy foo} msg] $msg + } {0 result} + test unixSend-10.15 {SendEventProc procedure, serial number} { + testsend prop comm Comm \ + "r\n-r response\n" + list [catch {send dummy foo} msg] $msg + } {1 {target application died or uses a Tk version before 4.0}} + test unixSend-10.16 {SendEventProc procedure, serial number} { + testsend prop comm Comm \ + "r\n-r response\n\n-s 0" + list [catch {send dummy foo} msg] $msg + } {1 {target application died or uses a Tk version before 4.0}} + test unixSend-10.17 {SendEventProc procedure, errorCode and errorInfo} { + testsend prop comm Comm \ + "r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n" + set errorCode oldErrorCode + set errorInfo oldErrorInfo + list [catch {send dummy foo} msg] $msg $errorInfo $errorCode + } {4 {} oldErrorInfo oldErrorCode} + test unixSend-10.18 {SendEventProc procedure, send kills application} { + setupbg + dobg {tk appname t_s_3} + set x [list [catch {send t_s_3 destroy .} msg] $msg] + cleanupbg + set x + } {0 {}} + test unixSend-10.19 {SendEventProc procedure, send exits} { + setupbg + dobg {tk appname t_s_3} + set x [list [catch {send t_s_3 exit} msg] $msg] + close $::tcltest::fd + set x + } {1 {target application died}} + + test unixSend-11.1 {AppendPropCarefully and AppendErrorProc procedures} { + testsend prop root InterpRegistry "0x21447 dummy\n" + list [catch {send dummy foo} msg] $msg + } {1 {no application named "dummy"}} + test unixSend-11.2 {AppendPropCarefully and AppendErrorProc procedures} { + testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n" + update + } {} +} + +winfo interps +tk appname tktest +catch {destroy .f} +frame .f +set id [string range [winfo id .f] 2 end] +if $gotTestCmds { + test unixSend-12.1 {TimeoutProc procedure} { + testsend prop root InterpRegistry "$id dummy\n" + list [catch {send dummy foo} msg] $msg + } {1 {target application died or uses a Tk version before 4.0}} + testsend prop root InterpRegistry "" +} +test unixSend-12.2 {TimeoutProc procedure} { + winfo interps + tk appname tktest + update + setupbg + puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout} + set ::tcltest::bgDone 0 + set ::tcltest::bgData {} + flush $::tcltest::fd + tkwait variable ::tcltest::bgDone + set app $::tcltest::bgData + after 200 + set result [list [catch {send $app foo} msg] $msg] + close $::tcltest::fd + set result +} {1 {target application died}} + +winfo interps +tk appname tktest +test unixSend-13.1 {DeleteProc procedure} { + setupbg + set app [dobg {rename send {}; tk appname}] + set result [list [catch {send $app foo} msg] $msg [winfo interps]] + cleanupbg + set result +} {1 {no application named "tktest #2"} tktest} +test unixSend-13.2 {DeleteProc procedure} { + winfo interps + tk appname tktest + rename send {} + set result {} + lappend result [winfo interps] [info commands send] + tk appname foo + lappend result [winfo interps] [info commands send] +} {{} {} foo send} + +if [info exists env(TK_ALT_DISPLAY)] { + test unixSend-14.1 {SendRestrictProc procedure, sends crossing from different displays} { + setupbg -display $env(TK_ALT_DISPLAY) + set result [dobg " + toplevel .t -screen [winfo screen .] + wm geometry .t +0+0 + tk appname xyzgorp1 + set x child + "] + toplevel .t -screen $env(TK_ALT_DISPLAY) + wm geometry .t +0+0 + tk appname xyzgorp2 + update + set y parent + set result [send -displayof .t xyzgorp1 {list $x [send -displayof .t xyzgorp2 set y]}] + destroy .t + cleanupbg + set result + } {child parent} +} + +if $gotTestCmds { + testsend prop root InterpRegister $registry + tk appname tktest + test unixSend-15.1 {UpdateCommWindow procedure} { + set x [list [testsend prop comm TK_APPLICATION]] + newApp "" t_s_1 Test + send t_s_1 wm withdraw . + newApp "" t_s_2 Test + send t_s_2 wm withdraw . + lappend x [testsend prop comm TK_APPLICATION] + interp delete t_s_1 + lappend x [testsend prop comm TK_APPLICATION] + interp delete t_s_2 + lappend x [testsend prop comm TK_APPLICATION] + } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest} +} + +tk appname $name +if $gotTestCmds { + testsend prop root InterpRegistry $registry +} +if $gotTestCmds { + testdeleteapps +} +rename newApp {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/unixWm.test b/tests/unixWm.test index f70c589..11528d6 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -4,18 +4,19 @@ # # Copyright (c) 1992-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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: unixWm.test,v 1.4 1999/02/04 21:03:28 stanton Exp $ +# RCS: @(#) $Id: unixWm.test,v 1.5 1999/04/16 01:51:42 stanton Exp $ -if {$tcl_platform(platform) != "unix"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {[string compare test [info procs test]] == 1} { - source defs +if {$tcl_platform(platform) != "unix"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests + return } proc sleep ms { @@ -195,7 +196,7 @@ test unixWm-6.3 {size changes} { update wm geom .t } 170x140+10+10 -test unixWm-6.4 {size changes} {nonPortable} { +test unixWm-6.4 {size changes} {nonPortable userInteraction} { wm minsize .t 1 1 update puts stdout "Please resize window \"t\" with the mouse (but don't move it!)," @@ -355,6 +356,7 @@ test unixWm-8.9 {icon windows} {nonPortable} { if {[string compare testwrapper [info commands testwrapper]] != 0} { puts "This application hasn't been compiled with the testwrapper command," puts "therefore I am skipping all of these tests." + ::tcltest::cleanupTests return } @@ -1309,7 +1311,7 @@ test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} { sleep 500 lappend result [winfo width .t] [winfo height .t] } {400 150 200 300} -test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} { +test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -1473,22 +1475,26 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} { update list [winfo width .t] [winfo height .t] } {100 1} + +catch {destroy .t} +toplevel .t -width 80 -height 60 test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} { - catch {destroy .t} - toplevel .t -width 80 -height 60 wm geometry .t +5-10 wm overrideredirect .t 1 tkwait visibility .t list [winfo x .t] [winfo y .t] -} "5 [expr [winfo screenheight .t] - 70]" +} [list 5 [expr [winfo screenheight .t] - 70]] + +catch {destroy .t} +toplevel .t -width 80 -height 60 test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} { - catch {destroy .t} - toplevel .t -width 80 -height 60 wm geometry .t -30+2 wm overrideredirect .t 1 tkwait visibility .t list [winfo x .t] [winfo y .t] -} "[expr [winfo screenwidth .t] - 110] 2" +} [list [expr [winfo screenwidth .t] - 110] 2] +catch {destroy .t} + test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} { catch {destroy .t} toplevel .t -width 80 -height 60 @@ -2291,6 +2297,37 @@ test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} { lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] } {0 20 0 1} +test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unixOnly} { + catch {destroy .t} + toplevel .t -width 100 -height 50 + wm geom .t +0+0 + wm command .t "argumentNumber0 argumentNumber1 argumentNumber2 argumentNumber0 argumentNumber3 argumentNumber4 argumentNumber5 argumentNumber6 argumentNumber0 argumentNumber7 argumentNumber8 argumentNumber9 argumentNumber10 argumentNumber0 argumentNumber11 argumentNumber12 argumentNumber13 argumentNumber14 argumentNumber15 argumentNumber16 argumentNumber17 argumentNumber18" + update + testprop [testwrapper .t] WM_COMMAND +} {argumentNumber0 +argumentNumber1 +argumentNumber2 +argumentNumber0 +argumentNumber3 +argumentNumber4 +argumentNumber5 +argumentNumber6 +argumentNumber0 +argumentNumber7 +argumentNumber8 +argumentNumber9 +argumentNumber10 +argumentNumber0 +argumentNumber11 +argumentNumber12 +argumentNumber13 +argumentNumber14 +argumentNumber15 +argumentNumber16 +argumentNumber17 +argumentNumber18 +} + # Test exit processing and cleanup: test unixWm-58.1 {exit processing} { @@ -2301,7 +2338,7 @@ test unixWm-58.1 {exit processing} { exit } close $fd - if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} { + if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 @@ -2320,7 +2357,7 @@ test unixWm-58.2 {exit processing} { exit } close $fd - if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} { + if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 @@ -2345,7 +2382,7 @@ test unixWm-58.3 {exit processing} { exit } close $fd - if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} { + if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 @@ -2353,7 +2390,21 @@ test unixWm-58.3 {exit processing} { list $error $msg } {0 {}} - +# cleanup catch {destroy .t} catch {removeFile script} -concat {} +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/util.test b/tests/util.test index 9793144..d3d5c91 100644 --- a/tests/util.test +++ b/tests/util.test @@ -3,14 +3,14 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: util.test,v 1.2 1998/09/14 18:23:53 stanton Exp $ +# RCS: @(#) $Id: util.test,v 1.3 1999/04/16 01:51:42 stanton Exp $ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} foreach i [winfo children .] { destroy $i @@ -68,3 +68,20 @@ test util-1.11 {Tk_GetScrollInfo procedure} { 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}} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/visual b/tests/visual deleted file mode 100644 index d227503..0000000 --- a/tests/visual +++ /dev/null @@ -1,81 +0,0 @@ -#!/usr/local/bin/wish -f -# -# This script displays provides visual tests for many of Tk's features. -# Each test displays a window with various information in it, along -# with instructions about how the window should appear. You can look -# at the window to make sure it appears as expected. Individual tests -# are kept in separate ".tcl" files in this directory. -# -# RCS: @(#) $Id: visual,v 1.2 1998/09/14 18:23:53 stanton Exp $ - -set auto_path ". $auto_path" -wm title . "Visual Tests for Tk" - -#------------------------------------------------------- -# The code below create the main window, consisting of a -# menu bar and a message explaining the basic operation -# of the program. -#------------------------------------------------------- - -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." - -pack .menu -side top -fill x -pack .msg -side bottom -expand yes -fill both - -#------------------------------------------------------- -# The code below creates all the menus, which invoke procedures -# to create particular demonstrations of various widgets. -#------------------------------------------------------- - -menubutton .menu.file -text "File" -menu .menu.file.m -menu .menu.file.m -.menu.file.m add command -label "Quit" -command exit - -menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m -menu .menu.group1.m -.menu.group1.m add command -label "Canvas arcs" -command {source arc.tcl} -.menu.group1.m add command -label "Beveled borders in text widgets" \ - -command {source bevel.tcl} -.menu.group1.m add command -label "Colormap management" \ - -command {source cmap.tcl} -.menu.group1.m add command -label "Label/button geometry" \ - -command {source butGeom.tcl} -.menu.group1.m add command -label "Label/button colors" \ - -command {source 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 {source canvPsGrph.tcl} -.menu.ps.m add command -label "Text" \ - -command {source canvPsText.tcl} -.menu.ps.m add command -label "Bitmaps" \ - -command {source canvPsBmap.tcl} -.menu.ps.m add command -label "Arcs" \ - -command {source 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 - } -} -tk_menuBar .menu .menu.file .menu.group1 .menu.ps - -# The following procedure is invoked to print the contents of a canvas: - -proc lpr c { - exec rm -f tmp.ps - $c postscript -file tmp.ps - exec lpr tmp.ps -} - -# Set up a class binding to allow objects to be deleted from a canvas -# by clicking with mouse button 1: - -bind Canvas <1> {%W delete [%W find closest %x %y]} diff --git a/tests/visual.test b/tests/visual.test index 402bd5c..8614c2d 100644 --- a/tests/visual.test +++ b/tests/visual.test @@ -4,14 +4,13 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: visual.test,v 1.2 1998/09/14 18:23:53 stanton Exp $ +# RCS: @(#) $Id: visual.test,v 1.3 1999/04/16 01:51:43 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -310,3 +309,20 @@ foreach w [winfo child .] { } rename eatColors {} rename colorsFree {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/visual_bb.test b/tests/visual_bb.test new file mode 100644 index 0000000..efafc09 --- /dev/null +++ b/tests/visual_bb.test @@ -0,0 +1,109 @@ +#!/usr/local/bin/wish -f +# +# This script displays provides visual tests for many of Tk's features. +# Each test displays a window with various information in it, along +# with instructions about how the window should appear. You can look +# at the window to make sure it appears as expected. Individual tests +# are kept in separate ".tcl" files in this directory. +# +# RCS: @(#) $Id: visual_bb.test,v 1.2 1999/04/16 01:51:43 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +set auto_path ". $auto_path" +wm title . "Visual Tests for Tk" + +set testNum 1 + +# Each menu entry invokes a visual test file + +proc runTest {file} { + global testNum + + test "2.$testNum" "testing $file" {userInteraction} { + uplevel \#0 source [file join $::tcltest::testsDir $file] + concat "" + } {} + incr testNum +} + +# The following procedure is invoked to print the contents of a canvas: + +proc lpr c { + exec rm -f tmp.ps + $c postscript -file tmp.ps + exec lpr tmp.ps + exec rm -f tmp.ps +} + +test 1.1 "running visual tests" {userInteraction} { + + #------------------------------------------------------- + # The code below create the main window, consisting of a + # menu bar and a message explaining the basic operation + # of the program. + #------------------------------------------------------- + + 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." + + pack .menu -side top -fill x + pack .msg -side bottom -expand yes -fill both + + #------------------------------------------------------- + # The code below creates all the menus, which invoke procedures + # to create particular demonstrations of various widgets. + #------------------------------------------------------- + + menubutton .menu.file -text "File" -menu .menu.file.m + menu .menu.file.m + .menu.file.m add command -label "Quit" -command ::tcltest::cleanupTests + + 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} + .menu.group1.m add command -label "Colormap management" \ + -command {runTest cmap.tcl} + .menu.group1.m add command -label "Label/button geometry" \ + -command {runTest butGeom.tcl} + .menu.group1.m add command -label "Label/button colors" \ + -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} + .menu.ps.m add command -label "Text" \ + -command {runTest canvPsText.tcl} + .menu.ps.m add command -label "Bitmaps" \ + -command {runTest canvPsBmap.tcl} + .menu.ps.m add command -label "Arcs" \ + -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 + } + } + tk_menuBar .menu .menu.file .menu.group1 .menu.ps + + # Set up a class binding to allow objects to be deleted from a canvas + # by clicking with mouse button 1: + + bind Canvas <1> {%W delete [%W find closest %x %y]} + + concat "" +} {} + +if {!$::tcltest::testConfig(userInteraction)} { + ::tcltest::cleanupTests +} diff --git a/tests/winButton.test b/tests/winButton.test index 4202a6a..48a60d5 100644 --- a/tests/winButton.test +++ b/tests/winButton.test @@ -5,27 +5,23 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winButton.test,v 1.3 1998/09/14 18:23:53 stanton Exp $ +# RCS: @(#) $Id: winButton.test,v 1.4 1999/04/16 01:51:43 stanton Exp $ -if {$tcl_platform(platform)!="windows"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\"" puts "image, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -47,7 +43,7 @@ radiobutton .r -text Radiobutton pack .l .b .c .r update -test winbutton-1.1 {TkpComputeButtonGeometry procedure} { +test winbutton-1.1 {TkpComputeButtonGeometry procedure} {pcOnly} { eval destroy [winfo children .] image create test image1 image1 changed 0 0 0 0 60 40 @@ -62,7 +58,7 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {68 48 71 51 96 50 96 50} -test winbutton-1.2 {TkpComputeButtonGeometry procedure} { +test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} { eval destroy [winfo children .] label .b1 -bitmap question -bd 3 -padx 0 -pady 2 button .b2 -bitmap question -bd 3 -padx 0 -pady 2 @@ -75,7 +71,7 @@ test winbutton-1.2 {TkpComputeButtonGeometry procedure} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {23 33 26 36 51 35 51 35} -test winbutton-1.3 {TkpComputeButtonGeometry procedure} { +test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} { eval destroy [winfo children .] label .b1 -bitmap question -bd 3 -highlightthickness 4 button .b2 -bitmap question -bd 3 -highlightthickness 0 @@ -89,7 +85,7 @@ test winbutton-1.3 {TkpComputeButtonGeometry procedure} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {31 41 24 34 26 36 26 36} -test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} { +test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { eval destroy [winfo children .] 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} @@ -102,21 +98,21 @@ test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} { [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} {nonPortable} { +test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { eval destroy [winfo children .] 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] } {178 84} -test winbutton-1.6 {TkpComputeButtonGeometry procedure} {nonPortable} { +test winbutton-1.6 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { eval destroy [winfo children .] 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] } {222 52} -test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} { +test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { eval destroy [winfo children .] label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 @@ -129,7 +125,7 @@ test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} { [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} {nonPortable} { +test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { eval destroy [winfo children .] label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ -highlightthickness 4 @@ -145,10 +141,26 @@ test winbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable} { [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} { +test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} { eval destroy [winfo children .] button .b2 -bitmap question -default normal list [winfo reqwidth .b2] [winfo reqheight .b2] } {24 34} +# cleanup eval destroy [winfo children .] +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/winClipboard.test b/tests/winClipboard.test index 6727a27..446dbd1 100644 --- a/tests/winClipboard.test +++ b/tests/winClipboard.test @@ -7,41 +7,52 @@ # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winClipboard.test,v 1.3 1998/11/03 02:06:44 stanton Exp $ - -if {$tcl_platform(platform)!="windows"} { - return -} +# RCS: @(#) $Id: winClipboard.test,v 1.4 1999/04/16 01:51:43 stanton Exp $ -if {[string compare test [info procs test]] == 1} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } # Note that these tests may fail if another application is grabbing the # clipboard (e.g. an X server) -test winClipboard-1.1 {TkSelGetSelection} { +test winClipboard-1.1 {TkSelGetSelection} {pcOnly} { 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} { +test winClipboard-1.2 {TkSelGetSelection} {pcOnly} { clipboard clear clipboard append {} list [selection get -selection CLIPBOARD] [testclipboard] } {{} {}} -test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} { +test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { clipboard clear clipboard append abcd list [selection get -selection CLIPBOARD] [testclipboard] } {abcd abcd} -test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} { +test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { clipboard clear clipboard append "line 1\nline 2" list [selection get -selection CLIPBOARD] [testclipboard] } [list "line 1\nline 2" "line 1\r\nline 2"] +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + diff --git a/tests/winDialog.test b/tests/winDialog.test new file mode 100644 index 0000000..64ed21b --- /dev/null +++ b/tests/winDialog.test @@ -0,0 +1,335 @@ +# This file is a Tcl script to test the Windows specific behavior of +# the common dialog boxes. It is organized in the standard +# fashion for Tcl tests. +# +# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: winDialog.test,v 1.2 1999/04/16 01:51:43 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {[info command testwinevent] == ""} { + puts "skipping: tests require the testwinevent command" + ::tcltest::cleanupTests + return +} + +testwinevent debug 1 + +eval destroy [winfo children .] +wm geometry . {} +raise . + +proc start {arg} { + set ::tk_dialog 0 + + after 1 "$arg" +} + +proc then {cmd} { + set ::command $cmd + set ::dialogresult {} + + afterbody + vwait ::dialogresult + return $::dialogresult +} + +proc afterbody {} { + if {$::tk_dialog == 0} { + after 100 {afterbody} + return + } + uplevel #0 {set dialogresult [eval $command]} +} + +proc Click {button} { + testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b + testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b +} + +proc GetText {button} { + return [testwinevent $::tk_dialog $button WM_GETTEXT] +} + +proc SetText {button text} { + return [testwinevent $::tk_dialog $button WM_SETTEXT $text] +} + +test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} { +} {} + +test winDialog-2.1 {ColorDlgHookProc} {nt} { +} {} + +test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} { + start {tk_getOpenFile} + then { + set x [GetText 2] + Click 2 + } + set x +} {Cancel} + +test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} { + start {tk_getSaveFile} + then { + set x [GetText 2] + Click 2 + } + set x +} {Cancel} + +test winDialog-5.1 {GetFileName: no arguments} {nt} { + start {tk_getOpenFile -title Open} + then { + Click cancel + } +} {0} +test winDialog-5.2 {GetFileName: one argument} {nt} { + list [catch {tk_getOpenFile -foo} msg] $msg +} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} +test winDialog-5.4 {GetFileName: many arguments} {nt} { + start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} + then { + Click cancel + } +} {0} +test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} { + list [catch {tk_getOpenFile -foo bar -abc} msg] $msg +} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} +test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} { + start {tk_getOpenFile -title bar} + then { + Click cancel + } +} {0} +test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} { + list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg +} {1 {value for "-title" missing}} +test winDialog-5.8 {GetFileName: extension begins with .} {nt} { +# if (string[0] == '.') { +# string++; +# } + + start {set x [tk_getSaveFile -defaultextension .foo -title Save]} + then { + SetText 0x480 bar + Click 1 + } + set x +} [file join [pwd] bar.foo] +test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} { + start {set x [tk_getSaveFile -defaultextension foo -title Save]} + then { + SetText 0x480 bar + Click 1 + } + set x +} [file join [pwd] bar.foo] +test winDialog-5.10 {GetFileName: file types} {nt} { +# case FILE_TYPES: + + start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} + then { + set x [GetText 0x470] + Click cancel + } + set x +} {foo files (*.foo)} +test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} { +# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) + + list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg +} {1 {bad Macintosh file type "FOO"}} +test winDialog-5.12 {GetFileName: initial directory} {nt} { +# case FILE_INITDIR: + + start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]} + then { + Click 1 + } + set x +} {C:/12x 455} +test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \ + {nt} { +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + + list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg +} {1 {user "12x" doesn't exist}} +test winDialog-5.14 {GetFileName: initial file} {nt} { +# case FILE_INITFILE: + + start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} + then { + Click 1 + } + set x +} [file join [pwd] "12x 456"] +test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} { +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg +} {1 {user "12x" doesn't exist}} +set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa +append a $a +append a $a +append a $a +append a $a +test winDialog-5.16 {GetFileName: initial file: long name} {knownBug nt} { + start {set x [tk_getSaveFile -initialfile $a -title Long]} + then { + Click 1 + } + set x +} [string range [file join [pwd] $a] 0 257] +test winDialog-5.17 {GetFileName: parent} {nt} { +# case FILE_PARENT: + + toplevel .t + set x 0 + start {tk_getOpenFile -parent .t -title Parent; set x 1} + then { + destroy .t + } + set x +} {1} +test winDialog-5.18 {GetFileName: title} {nt} { +# case FILE_TITLE: + + start {tk_getOpenFile -title Narf} + then { + Click 2 + } +} {0} +test winDialog-5.19 {GetFileName: no filter specified} {nt} { +# if (ofn.lpstrFilter == NULL) + + start {tk_getOpenFile -title Filter} + then { + set x [GetText 0x470] + Click 2 + } + set x +} {All Files (*.*)} +test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} { +# if (Tk_WindowId(parent) == None) + + toplevel .t + start {tk_getOpenFile -parent .t -title Open} + then { + destroy .t + } +} {} +test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} { + toplevel .t + update + start {tk_getOpenFile -parent .t -title Open} + then { + destroy .t + } +} {} +test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} { +# winCode = GetOpenFileName(&ofn); + + start {tk_getOpenFile -title Open} + then { + set x [GetText 1] + Click 2 + } + set x +} {&Open} +test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} { +# winCode = GetSaveFileName(&ofn); + + start {tk_getSaveFile -title Save} + then { + set x [GetText 1] + Click 2 + } + set x +} {&Save} +test winDialog-5.22 {GetFileName: convert \ to /} {nt} { + start {set x [tk_getSaveFile -title Back]} + then { + SetText 0x480 "c:\\12x 457" + Click 1 + } + set x +} {c:/12x 457} + +test winDialog-8.1 {OFNHookProc} {nt} { +} {} + +test winDialog-6.1 {MakeFilter} {nt} { +} {} + +test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} { + start {tk_chooseDirectory} + then { + Click cancel + } +} {0} +test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} { + list [catch {tk_chooseDirectory -foo} msg] $msg +} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} +test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} { + start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test} + then { + Click cancel + } +} {0} +test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \ + {nt} { + list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg +} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} +test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \ + {nt} { + start {tk_chooseDirectory -title bar} + then { + Click cancel + } +} {0} +test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \ + {nt} { + list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg +} {1 {value for "-title" missing}} +test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} { +# case DIR_INITIAL: + + start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} + then { + Click 1 + } + string tolower [set x] +} {c:/} +test winDialog-5.13 \ + {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \ + {nt} { +# if (Tcl_TranslateFileName(interp, string, +# &utfDirString) == NULL) + + list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg +} {1 {user "12x" doesn't exist}} + +test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {} + +testwinevent debug 0 + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + diff --git a/tests/winFont.test b/tests/winFont.test index a02b461..2c2798e 100644 --- a/tests/winFont.test +++ b/tests/winFont.test @@ -7,18 +7,13 @@ # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winFont.test,v 1.3 1998/09/14 18:23:53 stanton Exp $ - -if {$tcl_platform(platform)!="windows"} { - return -} +# RCS: @(#) $Id: winFont.test,v 1.4 1999/04/16 01:51:43 stanton Exp $ -if {[string compare test [info procs test]] != 0} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {destroy .b} @@ -45,10 +40,10 @@ proc getsize {} { return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" } -test winfont-1.1 {TkpGetNativeFont procedure: not native} { +test winfont-1.1 {TkpGetNativeFont procedure: not native} {pcOnly} { list [catch {font measure {} xyz} msg] $msg } {1 {font "" doesn't exist}} -test winfont-1.2 {TkpGetNativeFont procedure: native} { +test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} { font measure ansifixed 0 font measure ansi 0 font measure device 0 @@ -58,98 +53,99 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} { set x {} } {} -test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} { +test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} { expr [font actual {-size -10} -size]>0 } {1} -test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} { +test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} { expr [font actual {-family Arial} -size]>0 } {1} -test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} { +test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {pcOnly} { font actual {-weight normal} -weight } {normal} -test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} { +test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {pcOnly} { font actual {-weight bold} -weight } {bold} -test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} { +test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {pcOnly} { catch {expr {[font actual {-size 10} -size]}} } 0 -test winfont-2.6 {TkpGetFontFromAttributes procedure: family} { +test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {pcOnly} { font actual {-family Arial} -family } {Arial} -test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} { +test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {pcOnly} { set x {} 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} { +test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {pcOnly} { set x {} 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} { +test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {pcOnly} { set x {} 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} { +test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {pcOnly} { # No way to get it to fail! Any font name is acceptable. } {} -test winfont-3.1 {TkpDeleteFont procedure} { +test winfont-3.1 {TkpDeleteFont procedure} {pcOnly} { font actual {-family xyz} set x {} } {} -test winfont-4.1 {TkpGetFontFamilies procedure} { +test winfont-4.1 {TkpGetFontFamilies procedure} {pcOnly} { font families set x {} } {} -test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} { +test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {pcOnly} { .b.l config -wrap 0 -text "000000" getsize } "[expr $ax*6] $ay" -test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} { +test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {pcOnly} { .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" getsize } "[expr $ax*256] $ay" -test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} { +test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {pcOnly} { .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} { +test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {pcOnly} { .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} { +test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {pcOnly} { .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} { +test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} {pcOnly} { .b.l config -text "000000" -wrap 1 getsize } "$ax [expr $ay*6]" -test winfont-5.7 {Tk_MeasureChars procedure: whole words} { +test winfont-5.7 {Tk_MeasureChars procedure: whole words} {pcOnly} { .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} { +test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {pcOnly} { .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} { +test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {pcOnly} { .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} { +test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {pcOnly} { .b.l config -wrap [expr $ax*12] -text "0000000000000000" getsize } "[expr $ax*12] [expr $ay*2]" -test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} { +test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} \ + {pcOnly nonPortable} { set font [.b.l cget -font] .b.l config -font {{MS Sans Serif} 8} -text "W" set width [winfo reqwidth .b.l] @@ -158,12 +154,12 @@ test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} { .b.l config -font $font expr $x < ($width*10) } 1 -test winfont-6.1 {Tk_DrawChars procedure: loop test} { +test winfont-6.1 {Tk_DrawChars procedure: loop test} {pcOnly} { .b.l config -text "a" update } {} -test winfont-7.1 {AllocFont procedure: use old font} { +test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} { font create xyz catch {destroy .c} button .c -font xyz @@ -172,14 +168,29 @@ test winfont-7.1 {AllocFont procedure: use old font} { destroy .c font delete xyz } {} -test winfont-7.2 {AllocFont procedure: extract info from logfont} { +test winfont-7.2 {AllocFont procedure: extract info from logfont} {pcOnly} { 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} { +test winfont-7.3 {AllocFont procedure: extract info from textmetric} {pcOnly} { font metric {arial 10 bold italic underline overstrike} -fixed } {0} -test winfont-7.4 {AllocFont procedure: extract info from textmetric} { +test winfont-7.4 {AllocFont procedure: extract info from textmetric} {pcOnly} { font metric systemfixed -fixed } {1} +# cleanup destroy .b +::tcltest::cleanupTests +return + + + + + + + + + + + + diff --git a/tests/winMenu.test b/tests/winMenu.test index 96fdd21..576646f 100644 --- a/tests/winMenu.test +++ b/tests/winMenu.test @@ -4,37 +4,23 @@ # system. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winMenu.test,v 1.2 1998/09/14 18:23:53 stanton Exp $ - -if {$tcl_platform(platform) != "windows"} { - return -} +# RCS: @(#) $Id: winMenu.test,v 1.3 1999/04/16 01:51:43 stanton Exp $ -if {![info exists INTERACTIVE]} { - puts " Some tests were skipped because they could not be performed" - puts " automatically on this platform. If you wish to execute them" - puts " interactively, set the TCL variable INTERACTIVE and re-run" - puts " the test." - set testConfig(menuInteractive) 0 -} else { - set testConfig(menuInteractive) 1 +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - proc deleteWindows {} { foreach i [winfo children .] { catch [destroy $i] @@ -45,23 +31,23 @@ deleteWindows wm geometry . {} raise . -test winMenu-1.1 {GetNewID} { +test winMenu-1.1 {GetNewID} {pcOnly} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} # Basically impossible to test menu IDs wrapping. -test winMenu-2.1 {FreeID} { +test winMenu-2.1 {FreeID} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} -test winMenu-3.1 {TkpNewMenu} { +test winMenu-3.1 {TkpNewMenu} {pcOnly} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2 } {0 .m1 0 {}} -test winMenu-3.2 {TkpNewMenu} { +test winMenu-3.2 {TkpNewMenu} {pcOnly} { catch {destroy .m1} . configure -menu "" menu .m1 @@ -69,12 +55,12 @@ test winMenu-3.2 {TkpNewMenu} { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 } {0 {} {} 0 {}} -test winMenu-4.1 {TkpDestroyMenu} { +test winMenu-4.1 {TkpDestroyMenu} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} -test winMenu-4.2 {TkpDestroyMenu - help menu} { +test winMenu-4.2 {TkpDestroyMenu - help menu} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.system @@ -82,7 +68,7 @@ test winMenu-4.2 {TkpDestroyMenu - help menu} { list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-5.1 {TkpDestroyMenuEntry} { +test winMenu-5.1 {TkpDestroyMenuEntry} {pcOnly} { catch {destroy .m1} . configure -menu "" menu .m1 @@ -91,89 +77,89 @@ test winMenu-5.1 {TkpDestroyMenuEntry} { list [catch {.m1 delete 1} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.1 {GetEntryText} { +test winMenu-6.1 {GetEntryText} {pcOnly} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} -test winMenu-6.2 {GetEntryText} { +test winMenu-6.2 {GetEntryText} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-6.3 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.4 {GetEntryText} { +test winMenu-6.4 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.5 {GetEntryText} { +test winMenu-6.5 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.6 {GetEntryText} { +test winMenu-6.6 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.7 {GetEntryText} { +test winMenu-6.7 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.8 {GetEntryText} { +test winMenu-6.8 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.9 {GetEntryText} { +test winMenu-6.9 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.10 {GetEntryText} { +test winMenu-6.10 {GetEntryText} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-6.11 {GetEntryText} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-6.12 {GetEntryText} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-6.13 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.14 {GetEntryText} { +test winMenu-6.14 {GetEntryText} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-6.15 {GetEntryText} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-6.16 {GetEntryText} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} { +test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.system @@ -183,7 +169,7 @@ test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} { .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} { +test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label Hello @@ -191,77 +177,77 @@ test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} { .m1 add command -label foo list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.3 {ReconfigureWindowsMenu - zero items} { +test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.4 {ReconfigureWindowsMenu - one item} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.5 {ReconfigureWindowsMenu - two items} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.6 {ReconfigureWindowsMenu - separator item} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add separator list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} { +test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.14 {ReconfigureWindowsMenu - cascade} { +test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {pcOnly} { catch {destroy .m1} catch {destroy .m2} menu .m1 -tearoff 0 @@ -269,7 +255,7 @@ test winMenu-7.14 {ReconfigureWindowsMenu - cascade} { .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} { +test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.file @@ -277,7 +263,7 @@ test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} { . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} { +test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system @@ -287,7 +273,7 @@ test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} { .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} { +test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system @@ -295,7 +281,7 @@ test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} { . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} { +test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system @@ -305,7 +291,7 @@ test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} { . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.19 {ReconfigureWindowsMenu - column break} { +test winMenu-7.19 {ReconfigureWindowsMenu - column break} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -314,23 +300,23 @@ test winMenu-7.19 {ReconfigureWindowsMenu - column break} { } {0 {} {}} #Don't know how to generate nested post menus -test winMenu-8.1 {TkpPostMenu} { +test winMenu-8.1 {TkpPostMenu} {pcOnly} { catch {destroy .m1} menu .m1 -postcommand "blork" list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {1 {invalid command name "blork"} {}} -test winMenu-8.2 {TkpPostMenu} { +test winMenu-8.2 {TkpPostMenu} {pcOnly} { catch {destroy .m1} menu .m1 -postcommand "destroy .m1" list [.m1 post 40 40] [winfo exists .m1] } {{} 0} -test winMenu-8.3 {TkpPostMenu - popup menu} {menuInteractive} { +test winMenu-8.3 {TkpPostMenu - popup menu} {pcOnly userInteraction} { catch {destroy .m1} 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} {menuInteractive} { +test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} { catch {destroy .mb} menubutton .mb -text test -menu .mb.menu menu .mb.menu @@ -338,7 +324,7 @@ test winMenu-8.4 {TkpPostMenu - menu button} {menuInteractive} { pack .mb list [tkMbPost .mb] [destroy .m1] } {{} {}} -test winMenu-8.5 {TkpPostMenu - update not pending} {menuInteractive} { +test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-8.5 - Hit ESCAPE." @@ -346,13 +332,13 @@ test winMenu-8.5 {TkpPostMenu - update not pending} {menuInteractive} { list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-9.1 {TkpMenuNewEntry} { +test winMenu-9.1 {TkpMenuNewEntry} {pcOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-10.1 {TkwinMenuProc} {menuInteractive} { +test winMenu-10.1 {TkwinMenuProc} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-10.1: Hit ESCAPE." @@ -360,46 +346,63 @@ test winMenu-10.1 {TkwinMenuProc} {menuInteractive} { } {{} {}} # Can't generate a WM_INITMENU without a Tk menu yet. -test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {menuInteractive} { +test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {pcOnly userInteraction} { catch {destroy .m1} 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} {menuInteractive} { +test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} { catch {destroy .m1} 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} {pcOnly userInteraction} { + catch {destroy .m1} + catch {unset foo} + proc bgerror {args} { + 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 + while executing +"error 1" + (menu invoke)}} {} {}} + # Can't test WM_MENUCHAR -test winMenu-11.3 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} { +test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-11.3: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} { +test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1 list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-11.5 {TkWinHandleMenuEvent - WM_DRAWITEM} {menuInteractive} { +test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-11.5: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} {menuInteractive} { +test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} \ + {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-11.7 {TkWinHandleMenuEvent - WM_INITMENU - not pending} {menuInteractive} { +test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \ + {pcOnly userInteraction} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label "winMenu-11.7: Hit ESCAPE" @@ -407,14 +410,14 @@ test winMenu-11.7 {TkWinHandleMenuEvent - WM_INITMENU - not pending} {menuIntera list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-12.1 {TkpSetWindowMenuBar} { +test winMenu-12.1 {TkpSetWindowMenuBar} {pcOnly} { catch {destroy .m1} . 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} { +test winMenu-12.2 {TkpSetWindowMenuBar} {pcOnly} { catch {destroy .m1} . configure -menu "" menu .m1 @@ -422,7 +425,7 @@ test winMenu-12.2 {TkpSetWindowMenuBar} { . configure -menu .m1 list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2 } {0 {} 0 {}} -test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} { +test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {pcOnly} { catch {destroy .m1} . configure -menu "" menu .m1 -tearoff 0 @@ -431,48 +434,48 @@ test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {} {} +test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest pcOnly} {} {} -test winMenu-14.1 {GetMenuIndicatorGeometry} { +test winMenu-14.1 {GetMenuIndicatorGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-14.2 {GetMenuIndicatorGeometry} { +test winMenu-14.2 {GetMenuIndicatorGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -hidemargin 1 list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-15.1 {GetMenuAccelGeometry} { +test winMenu-15.1 {GetMenuAccelGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo -accel Ctrl+U list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-15.2 {GetMenuAccelGeometry} { +test winMenu-15.2 {GetMenuAccelGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-15.3 {GetMenuAccelGeometry} { +test winMenu-15.3 {GetMenuAccelGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-16.1 {GetTearoffEntryGeometry} {menuInteractive} { +test winMenu-16.1 {GetTearoffEntryGeometry} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-19.1: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-17.1 {GetMenuSeparatorGeometry} { +test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add separator @@ -481,7 +484,7 @@ test winMenu-17.1 {GetMenuSeparatorGeometry} { # Currently, the only callers to DrawWindowsSystemBitmap want things # centered vertically, and either centered or right aligned horizontally. -test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} { +test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -489,7 +492,7 @@ test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} { +test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo @@ -497,21 +500,22 @@ test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} { list [update] [destroy .m1] } {{} {}} -test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} { +test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \ + {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.2 {DrawMenuEntryIndicator - not selected} { +test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} { +test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -519,7 +523,7 @@ test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} { +test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo @@ -527,7 +531,7 @@ test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.5 {DrawMenuEntryIndicator - disabled} { +test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -536,7 +540,7 @@ test winMenu-19.5 {DrawMenuEntryIndicator - disabled} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} { +test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -indicatoron 0 @@ -545,42 +549,44 @@ test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} { list [update] [destroy .m1] } {{} {}} -test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} { +test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground red .m1 add command -label foo -accel "Ctrl+U" -state disabled set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} { +test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} { +test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \ + {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -accel "Ctrl+U" -state disabled set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} { +test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} {menuInteractive} { +test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \ + {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add cascade -label "winMenu-23.5: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-21.1 {DrawMenuSeparator} { +test winMenu-21.1 {DrawMenuSeparator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add separator @@ -588,7 +594,7 @@ test winMenu-21.1 {DrawMenuSeparator} { list [update] [destroy .m1] } {{} {}} -test winMenu-22.1 {DrawMenuUnderline} { +test winMenu-22.1 {DrawMenuUnderline} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -underline 0 @@ -596,24 +602,26 @@ test winMenu-22.1 {DrawMenuUnderline} { list [update] [destroy .m1] } {{} {}} -test winMenu-23.1 {Don't know how to test MenuKeyBindProc} {} {} -test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} {} {} +test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \ + {pcOnly emptyTest} {} {} +test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} \ + {pcOnly emptyTest} {} {} -test winMenu-25.1 {DrawMenuEntryLabel - normal} { +test winMenu-25.1 {DrawMenuEntryLabel - normal} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} { +test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground red .m1 add command -label foo -state disabled set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} { +test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled @@ -621,27 +629,27 @@ test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} { list [update] [destroy .m1] } {{} {}} -test winMenu-26.1 {TkpComputeMenubarGeometry} { +test winMenu-26.1 {TkpComputeMenubarGeometry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label File list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] } {{} {} {}} -test winMenu-27.1 {DrawTearoffEntry} {menuInteractive} { +test winMenu-27.1 {DrawTearoffEntry} {pcOnly userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-24.4: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-28.1 {TkpConfigureMenuEntry - update pending} { +test winMenu-28.1 {TkpConfigureMenuEntry - update pending} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label One @@ -649,7 +657,8 @@ test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} { list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} { +test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \ + {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -657,7 +666,8 @@ test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} { +test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} \ + {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground red @@ -665,7 +675,7 @@ test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} { +test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} { catch {destroy .m1} menu .m1 set tk_strictMotif 1 @@ -674,42 +684,44 @@ test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} { .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} { +test winMenu-29.4 \ + {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \ + {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} { +test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} { +test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {pcOnly} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} { +test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -foreground red set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} { +test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { +test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -selectcolor orange @@ -717,7 +729,7 @@ test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} { +test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -725,7 +737,7 @@ test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} { +test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activebackground green @@ -733,7 +745,7 @@ test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.12 {TkpDrawMenuEntry - border} { +test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -741,7 +753,7 @@ test winMenu-29.12 {TkpDrawMenuEntry - border} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} { +test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} { catch {destroy .m1} set tk_strictMotif 1 menu .m1 @@ -750,7 +762,7 @@ test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} -test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} { +test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground yellow @@ -758,7 +770,7 @@ test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.15 {TkpDrawMenuEntry - active border} { +test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -766,35 +778,35 @@ test winMenu-29.15 {TkpDrawMenuEntry - active border} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} { +test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -font "Helvectica 72" set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.17 {TkpDrawMenuEntry - font} { +test winMenu-29.17 {TkpDrawMenuEntry - font} {pcOnly} { catch {destroy .m1} menu .m1 -font "Courier 72" .m1 add command -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.18 {TkpDrawMenuEntry - separator} { +test winMenu-29.18 {TkpDrawMenuEntry - separator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add separator set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.19 {TkpDrawMenuEntry - standard} { +test winMenu-29.19 {TkpDrawMenuEntry - standard} {pcOnly} { catch {destroy .mb} menu .m1 .m1 add command -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} { +test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label File -menu .m1.file @@ -804,7 +816,7 @@ test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.21 {TkpDrawMenuEntry - indicator} { +test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label winMenu-31.20 @@ -812,7 +824,7 @@ test winMenu-29.21 {TkpDrawMenuEntry - indicator} { set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.22 {TkpDrawMenuEntry - indicator} { +test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label winMenu-31.21 -hidemargin 1 @@ -821,7 +833,7 @@ test winMenu-29.22 {TkpDrawMenuEntry - indicator} { list [update] [destroy .m1] } {{} {}} -test winMenu-30.1 {GetMenuLabelGeometry - image} { +test winMenu-30.1 {GetMenuLabelGeometry - image} {pcOnly} { catch {destroy .m1} catch {image delete image1} menu .m1 @@ -829,33 +841,33 @@ test winMenu-30.1 {GetMenuLabelGeometry - image} { .m1 add command -image image1 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test winMenu-30.2 {GetMenuLabelGeometry - bitmap} { +test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -bitmap questhead list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-30.3 {GetMenuLabelGeometry - no text} { +test winMenu-30.3 {GetMenuLabelGeometry - no text} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-30.4 {GetMenuLabelGeometry - text} { +test winMenu-30.4 {GetMenuLabelGeometry - text} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a test." list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-31.1 {DrawMenuEntryBackground} { +test winMenu-31.1 {DrawMenuEntryBackground} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tkTearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-31.2 {DrawMenuEntryBackground} { +test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -864,25 +876,25 @@ test winMenu-31.2 {DrawMenuEntryBackground} { list [update] [destroy .m1] } {{} {}} -test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} { +test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {pcOnly} { catch {destroy .m1} menu .m1 list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} { +test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "one" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} { +test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} { +test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add separator @@ -897,60 +909,65 @@ test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { catch {tkMbPost .mb} list [update] [destroy .mb] } {{} {}} -test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} { +test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \ + {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} { +test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} \ + {pcOnly} { catch {destroy .m1} 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} { +test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} \ + {pcOnly} { catch {destroy .m1} 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} { +test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test test" .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} { +test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "Ctrl+S" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} { +test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} {pcOnly} { catch {destroy .m1} 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} { +test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {pcOnly} { catch {destroy .m1} 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 } { +test winMenu-32.14 \ + {TkpComputeStandardMenuGeometry - second indicator less or equal} \ + {pcOnly} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -961,7 +978,8 @@ test winMenu-32.14 {TkpComputeStandardMenuGeometry - second indicator less or eq .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unixOnly} { +test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \ + {unixOnly} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -972,12 +990,14 @@ test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger } { .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} { +test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} \ + {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} { +test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} \ + {pcOnly} { catch {destroy .m1} menu .m1 .m1 add command -label one @@ -985,7 +1005,8 @@ test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} { .m1 add command -label three -columnbreak 1 list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} { +test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \ + {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -993,7 +1014,7 @@ test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} { .m1 add command -label three list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} { +test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {pcOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -1005,14 +1026,14 @@ test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} { list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} { +test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {pcOnly} { catch {destroy .t2} catch {destroy .m1} toplevel .t2 -menu .m1 wm geometry .t2 +0+0 list [update idletasks] [destroy .t2] } {{} {}} -test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} { +test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {pcOnly} { catch {destroy .t2} catch {destroy .m1} menu .m1 @@ -1025,6 +1046,21 @@ test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} { list [update idletasks] [destroy .m1] [destroy .t2] } {{} {} {}} -test winMenu-34.1 {TkpMenuInit called at boot time} {} {} +test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest pcOnly} {} {} +# cleanup deleteWindows +::tcltest::cleanupTests +return + + + + + + + + + + + + diff --git a/tests/winSend.test b/tests/winSend.test new file mode 100644 index 0000000..34819b5 --- /dev/null +++ b/tests/winSend.test @@ -0,0 +1,428 @@ +# This file is a Tcl script to test out the "send" command and the +# other procedures in the file tkSend.c. It is organized in the +# standard fashion for Tcl tests. +# +# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: winSend.test,v 1.2 1999/04/16 01:51:44 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {$tcl_platform(platform) != "windows"} { + puts "skipping: Windows only tests..." + ::tcltest::cleanupTests + return +} + +if {[info commands send] != "send"} { + puts "skipping: Unimplemented send command" + ::tcltest::cleanupTests + return +} + +foreach i [winfo children .] { + destroy $i +} +wm geometry . {} +raise . + +set currentInterps [winfo interps] + +if {[catch {exec tktest &}] == 1} { + puts "Could not run winSend.test because another instance of tktest could not be loaded." + ::tcltest::cleanupTests + return; +} + +# Compute a script that will load Tk into a child interpreter. + +foreach pkg [info loaded] { + if {[lindex $pkg 1] == "Tk"} { + set loadTk "load $pkg" + break + } +} + +# Procedure to create a new application with a given name and class. + +proc newApp {name {safe {}}} { + global loadTk + if {[string compare $safe "-safe"] == 0} { + interp create -safe $name + } else { + interp create $name + } + $name eval [list set argv [list -name $name]] + catch {eval $loadTk $name} +} + +# Wait until the child application has launched. + +while {[llength [winfo interps]] == [llength $currentInterps]} { +} + +# Now find an interp to send to +set newInterps [winfo interps] +foreach interp $newInterps { + if {[lsearch -exact $currentInterps $interp] < 0} { + break + } +} + +# Now we have found our interpreter we are going to send to. Make sure that +# it works first. +if {[catch {send $interp {console hide; update}}] == 1} { + puts "Could not send to child interpreter $interp" + ::tcltest::cleanupTests + return +} + +# setting up dde server is done when the first interp is created and +# cannot be tested very easily. +test winSend-1.1 {Tk_SetAppName - changing name of interp} { + newApp testApp + list [testApp eval tk appname testApp2] [interp delete testApp] +} {testApp2 {}} +test winSend-1.2 {Tk_SetAppName - changing name - not front of linked list} { + newApp testApp + newApp testApp2 + list [testApp eval tk appname testApp3] [interp delete testApp] [interp delete testApp2] +} {testApp3 {} {}} +test winSend-1.3 {Tk_SetAppName - unique name - no conflicts} { + newApp testApp + list [testApp eval tk appname testApp] [interp delete testApp] +} {testApp {}} +test winSend-1.4 {Tk_SetAppName - unique name - one conflict} { + newApp testApp + newApp foobar + list [foobar eval tk appname testApp] [interp delete foobar] [interp delete testApp] +} {{testApp #2} {} {}} +test winSend-1.5 {Tk_SetAppName - unique name - one conflict} { + newApp testApp + newApp foobar + newApp blaz + foobar eval tk appname testApp + list [blaz eval tk appname testApp] [interp delete foobar] [interp delete testApp] [interp delete blaz] +} {{testApp #3} {} {} {}} +test winSend-1.6 {Tk_SetAppName - safe interps} { + newApp testApp -safe + list [catch {testApp eval send testApp {set foo a}} msg] $msg [interp delete testApp] +} {1 {invalid command name "send"} {}} + +test winSend-2.1 {Tk_SendObjCmd - # of args} { + list [catch {send tktest} msg] $msg +} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} +test winSend-2.1 {Tk_SendObjCmd: arguments} { + list [catch {send -bogus tktest} msg] $msg +} {1 {bad option "-bogus": must be -async, -displayof, or --}} +test winSend-2.1 {Tk_SendObjCmd: arguments} { + list [catch {send -async bogus foo} msg] $msg +} {1 {no registered server named "bogus"}} +test winSend-2.1 {Tk_SendObjCmd: arguments} { + list [catch {send -displayof . bogus foo} msg] $msg +} {1 {no registered server named "bogus"}} +test winSend-2.1 {Tk_SendObjCmd: arguments} { + list [catch {send -- -bogus foo} msg] $msg +} {1 {no registered server named "-bogus"}} +test winSend-2.2 {Tk_SendObjCmd - sending to ourselves} { + list [send [tk appname] {set foo a}] +} {a} +test winSend-2.3 {Tk_SendObjCmd - sending to ourselves in a different interpreter} { + newApp testApp + list [catch {send testApp {set foo b}} msg] $msg [interp delete testApp] +} {0 b {}} +test winSend-2.4 {Tk_SendObjCmd - sending to ourselves in a different interp with errors} { + newApp testApp + list [catch {send testApp {expr 2 / 0}} msg] $msg $errorCode $errorInfo [interp delete testApp] +} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send testApp {expr 2 / 0}\"} {}" +test winSend-2.5 {Tk_SendObjCmd - sending to another app async} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {send -async $interp {set foo a}} msg] $msg +} {0 {}} +test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {send $interp {set foo a}} msg] $msg +} {0 a} +test winSend-2.7 {Tk_SendObjCmd - sending to another app - error} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {send $interp {expr 2 / 0}} msg] $msg $errorCode $errorInfo +} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send \$interp {expr 2 / 0}\"}" + +test winSend-3.1 {TkGetInterpNames} { + set origLength [llength $currentInterps] + set newLength [llength [winfo interps]] + expr {($newLength - 2) == $origLength} +} {1} + +test winSend-4.1 {DeleteProc - changing name of app} { + newApp a + list [a eval tk appname foo] [interp delete a] +} {foo {}} +test winSend-4.2 {DeleteProc - normal} { + newApp a + list [interp delete a] +} {{}} + +test winSend-5.1 {ExecuteRemoteObject - no error} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [send $interp {send [tk appname] {expr 2 / 1}}] +} {2} +test winSend-5.2 {ExecuteRemoteObject - error} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {send $interp {send [tk appname] {expr 2 / 0}}} msg] $msg +} {1 {divide by zero}} + +test winSend-6.1 {SendDDEServer - XTYP_CONNECT} { + set foo "Hello, World" + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "dde request Tk [tk appname] foo" + list [catch "send \{$interp\} \{$command\}" msg] $msg +} {0 {Hello, World}} +test winSend-6.2 {SendDDEServer - XTYP_CONNECT_CONFIRM} { + set foo "Hello, World" + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "dde request Tk [tk appname] foo" + list [catch "send \{$interp\} \{$command\}" msg] $msg +} {0 {Hello, World}} +test winSend-6.3 {SendDDEServer - XTYP_DISCONNECT} { + set foo "Hello, World" + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "dde request Tk [tk appname] foo" + list [catch "send \{$interp\} \{$command\}" msg] $msg +} {0 {Hello, World}} +test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} { + set foo "Hello, World" + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "dde request Tk [tk appname] foo" + list [catch "send \{$interp\} \{$command\}" msg] $msg +} {0 {Hello, World}} +test winSend-6.5 {SendDDEServer - XTYP_REQUEST array} { + catch {unset foo} + set foo(test) "Hello, World" + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "dde request Tk [tk appname] foo(test)" + list [catch "send \{$interp\} \{$command\}" msg] $msg [catch {unset foo}] +} {0 {Hello, World} 0} +test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} { + set foo 3 + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "send [tk appname] {expr $foo + 1}" + list [catch "send \{$interp\} \{$command\}" msg] $msg +} {0 4} +test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "send [tk appname] {expr 4 / 2}" + list [catch "send \{$interp\} \{$command\}" msg] $msg +} {0 2} +test winSend-6.8 {SendDDEServer - XTYP_WILDCONNECT} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + set command "dde services Tk {}" + list [catch "send \{$interp\} \{$command\}"] +} {0} + +test winSend-7.1 {DDEExitProc} { + newApp testApp + list [interp delete testApp] +} {{}} + +test winSend-8.1 {SendDdeConnect} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [send $interp {set tk foo}] +} {foo} + +test winSend-9.1 {SetDDEError} { + list [catch {dde execute Tk foo {set foo hello}} msg] $msg +} {1 {dde command failed}} + +test winSend-10.1 {Tk_DDEObjCmd - wrong num args} { + list [catch {dde} msg] $msg +} {1 {wrong # args: should be "dde ?-async? serviceName topicName value"}} +test winSend-10.2 {Tk_DDEObjCmd - unknown subcommand} { + list [catch {dde foo} msg] $msg +} {1 {bad command "foo": must be execute, request, or services}} +test winSend-10.3 {Tk_DDEObjCmd - execute - wrong num args} { + list [catch {dde execute} msg] $msg +} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}} +test winSend-10.4 {Tk_DDEObjCmd - execute - wrong num args} { + list [catch {dde execute 3 4 5 6 7} msg] $msg +} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}} +test winSend-10.5 {Tk_DDEObjCmd - execute async - wrong num args} { + list [catch {dde execute -async} msg] $msg +} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}} +test winSend-10.6 {Tk_DDEObjCmd - request - wrong num args} { + list [catch {dde request} msg] $msg +} {1 {wrong # args: should be "dde request serviceName topicName value"}} +test winSend-10.7 {Tk_DDEObjCmd - services wrong num args} { + list [catch {dde services} msg] $msg +} {1 {wrong # args: should be "dde services serviceName topicName"}} +test winSend-10.8 {Tk_DDEObjCmd - null service name} { + list [catch {dde services {} {tktest #2}}] +} {0} +test winSend-10.9 {Tk_DDEObjCmd - null topic name} { + list [catch {dde services {Tk} {}}] +} {0} +test winSend-10.10 {Tk_DDEObjCmd - execute - nothing to execute} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {dde execute Tk $interp {}} msg] $msg +} {1 {cannot execute null data}} +test winSend-10.11 {Tk_DDEObjCmd - execute - no such conversation} { + list [catch {dde execute Tk foo {set foo hello}} msg] $msg +} {1 {dde command failed}} +test winSend-10.12 {Tk_DDEObjCmd - execute - async} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {dde execute -async Tk $interp {set foo hello}} msg] $msg +} {0 {}} +test winSend-10.13 {Tk_DDEObjCmd - execute} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {dde execute Tk $interp {set foo goodbye}} msg] $msg +} {0 {}} +test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {dde request Tk $interp {}} msg] $msg +} {1 {cannot request value of null data}} +test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + list [catch {dde request Tk foo foo} msg] $msg +} {1 {dde command failed}} +test winSend-10.16 {Tk_DDEObjCmd - invalid variable} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + send $interp {unset foo} + list [catch {dde request Tk $interp foo} msg] $msg +} {1 {remote server cannot handle this command}} +test winSend-10.17 {Tk_DDEObjCmd - valid variable} { + set newInterps [winfo interps] + foreach interp $newInterps { + if {[lsearch $currentInterps $interp] < 0} { + break + } + } + send $interp {set foo winSend-10.17} + list [catch {dde request Tk $interp foo} msg] $msg +} {0 winSend-10.17} +test winSend-10.18 {Tk_DDEObjCmd - services} { + set currentService [list Tk [tk appname]] + list [catch {dde services Tk {}} msg] [expr [lsearch $msg $currentService] >= 0] +} {0 1} + +# Get rid of the other app and all of its interps + +set newInterps [winfo interps] +while {[llength $newInterps] != [llength $currentInterps]} { + foreach interp $newInterps { + if {[lsearch -exact $currentInterps $interp] < 0} { + catch {send $interp exit} + set newInterps [winfo interps] + break + } + } +} + +# cleanup +::tcltest::cleanupTests +return + diff --git a/tests/winWm.test b/tests/winWm.test index c48fc3b..e4275fe 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -6,18 +6,13 @@ # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 by Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winWm.test,v 1.2 1998/09/14 18:23:53 stanton Exp $ - -if {$tcl_platform(platform) != "windows"} { - return -} +# RCS: @(#) $Id: winWm.test,v 1.3 1999/04/16 01:51:44 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -41,7 +36,7 @@ update set menuheight [expr $menuheight - [winfo y .t]] destroy .t -test winWm-1.1 {TkWmMapWindow} { +test winWm-1.1 {TkWmMapWindow} {pcOnly} { toplevel .t wm override .t 1 wm geometry .t +0+0 @@ -50,7 +45,7 @@ test winWm-1.1 {TkWmMapWindow} { destroy .t set result } {0 0} -test winWm-1.2 {TkWmMapWindow} { +test winWm-1.2 {TkWmMapWindow} {pcOnly} { toplevel .t wm transient .t . update @@ -62,7 +57,7 @@ test winWm-1.2 {TkWmMapWindow} { destroy .t set msg } {can't iconify ".t": it is a transient} -test winWm-1.3 {TkWmMapWindow} { +test winWm-1.3 {TkWmMapWindow} {pcOnly} { toplevel .t update toplevel .t2 @@ -71,7 +66,7 @@ test winWm-1.3 {TkWmMapWindow} { destroy .t .t2 set result } 1 -test winWm-1.4 {TkWmMapWindow} { +test winWm-1.4 {TkWmMapWindow} {pcOnly} { toplevel .t wm geometry .t +10+10 update @@ -82,7 +77,7 @@ test winWm-1.4 {TkWmMapWindow} { destroy .t .t2 set result } {10 40} -test winWm-1.5 {TkWmMapWindow} { +test winWm-1.5 {TkWmMapWindow} {pcOnly} { toplevel .t wm iconify .t update @@ -91,7 +86,7 @@ test winWm-1.5 {TkWmMapWindow} { set result } iconic -test winWm-2.1 {TkpWmSetState} { +test winWm-2.1 {TkpWmSetState} {pcOnly} { toplevel .t wm geometry .t 150x50+10+10 update @@ -105,7 +100,7 @@ test winWm-2.1 {TkpWmSetState} { destroy .t set result } {normal iconic normal} -test winWm-2.2 {TkpWmSetState} { +test winWm-2.2 {TkpWmSetState} {pcOnly} { toplevel .t wm geometry .t 150x50+10+10 update @@ -122,7 +117,7 @@ test winWm-2.2 {TkpWmSetState} { destroy .t set result } {normal withdrawn iconic normal} -test winWm-2.3 {TkpWmSetState} { +test winWm-2.3 {TkpWmSetState} {pcOnly} { set result {} toplevel .t wm geometry .t 150x50+10+10 @@ -142,7 +137,7 @@ test winWm-2.3 {TkpWmSetState} { } {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} -test winWm-3.1 {ConfigureTopLevel: window geometry propagation} { +test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} { toplevel .t wm geometry .t +0+0 button .t.b @@ -161,7 +156,7 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} { set x } 1 -test winWm-4.1 {ConfigureTopLevel: menu resizing} { +test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} { set result {} toplevel .t frame .t.f -width 150 -height 50 -bg red @@ -178,7 +173,7 @@ test winWm-4.1 {ConfigureTopLevel: menu resizing} { set result } [expr $menuheight + 1] -test winWm-5.1 {UpdateGeometryInfo: menu resizing} { +test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} { set result {} toplevel .t frame .t.f -width 150 -height 50 -bg red @@ -197,7 +192,7 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} { destroy .t set result } {50 50 50} -test winWm-5.2 {UpdateGeometryInfo: menu resizing} { +test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} { set result {} toplevel .t frame .t.f -width 150 -height 50 -bg red @@ -217,3 +212,19 @@ test winWm-5.2 {UpdateGeometryInfo: menu resizing} { destroy .t set result } {50 50 0} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + diff --git a/tests/window.test b/tests/window.test index 3a1df2b..2de63a0 100644 --- a/tests/window.test +++ b/tests/window.test @@ -2,14 +2,13 @@ # tkWindow.c. 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: window.test,v 1.3 1998/09/14 18:23:53 stanton Exp $ +# RCS: @(#) $Id: window.test,v 1.4 1999/04/16 01:51:44 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -80,13 +79,12 @@ test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} { destroy .f } {} -if {[string compare testmenubar [info commands testmenubar]] != 0} { - puts "This application hasn't been compiled with the testmenubar command," - puts "therefore I am skipping all of these tests." - return -} +# Some tests require the testmenubar command +set ::tcltest::testConfig(testmenubar) \ + [expr {[info commands testmenubar] != {}}] -test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly { +test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ + {unixOnly testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 @@ -96,7 +94,8 @@ test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unix update # If stacking order isn't handle properly, generates an X error. } {} -test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly { +test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \ + {unixOnly testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 @@ -110,11 +109,11 @@ test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unix # If stacking order isn't handled properly, generates an X error. } {} -test window-4.1 {Tk_NameToWindow procedure} { +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} { +test window-4.2 {Tk_NameToWindow procedure} {testmenubar} { catch {destroy .t} frame .t -width 100 -height 50 place .t -x 10 -y 10 @@ -122,7 +121,8 @@ test window-4.2 {Tk_NameToWindow procedure} { list [catch {winfo geometry .t} msg] $msg } {0 100x50+10+10} -test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly { +test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ + {unixOnly testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 @@ -135,3 +135,19 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unix update # If stacking order isn't handled properly, generates an X error. } {} + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + diff --git a/tests/winfo.test b/tests/winfo.test index 826d1e2..82bc261 100644 --- a/tests/winfo.test +++ b/tests/winfo.test @@ -3,14 +3,13 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winfo.test,v 1.3 1998/09/14 18:23:54 stanton Exp $ +# RCS: @(#) $Id: winfo.test,v 1.4 1999/04/16 01:51:44 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -19,6 +18,10 @@ foreach i [winfo children .] { wm geometry . {} raise . +# Some tests require the testwrapper command +set ::tcltest::testConfig(testwrapper) \ + [expr {[info commands testwrapper] != {}}] + # eatColors -- # Creates a toplevel window and allocates enough colors in it to # use up all the slots in the colormap. @@ -88,32 +91,33 @@ test winfo-2.7 {"winfo atom" command} { winfo atomname -displayof . 2 } SECONDARY -if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} { - test winfo-3.1 {"winfo colormapfull" command} { - list [catch {winfo colormapfull} msg] $msg - } {1 {wrong # args: should be "winfo colormapfull window"}} - test winfo-3.2 {"winfo colormapfull" command} { - list [catch {winfo colormapfull a b} msg] $msg - } {1 {wrong # args: should be "winfo colormapfull window"}} - test winfo-3.3 {"winfo colormapfull" command} { - list [catch {winfo colormapfull foo} msg] $msg - } {1 {bad window path name "foo"}} - test winfo-3.4 {"winfo colormapfull" command} {macOrUnix} { - eatColors .t {-colormap new} - set result [list [winfo colormapfull .] [winfo colormapfull .t]] - .t.c delete 34 - lappend result [winfo colormapfull .t] - .t.c create rectangle 30 30 80 80 -fill #441739 - lappend result [winfo colormapfull .t] - .t.c create rectangle 40 40 90 90 -fill #ffeedd - lappend result [winfo colormapfull .t] - destroy .t.c - lappend result [winfo colormapfull .t] - } {0 1 0 0 1 0} - catch {destroy .t} -} +# Some tests require the "pseudocolor" visual class. +set ::tcltest::testConfig(pseudocolor) \ + [expr {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")}] +test winfo-3.1 {"winfo colormapfull" command} {pseudocolor} { + list [catch {winfo colormapfull} msg] $msg +} {1 {wrong # args: should be "winfo colormapfull window"}} +test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} { + list [catch {winfo colormapfull a b} msg] $msg +} {1 {wrong # args: should be "winfo colormapfull window"}} +test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} { + list [catch {winfo colormapfull foo} msg] $msg +} {1 {bad window path name "foo"}} +test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} { + eatColors .t {-colormap new} + set result [list [winfo colormapfull .] [winfo colormapfull .t]] + .t.c delete 34 + lappend result [winfo colormapfull .t] + .t.c create rectangle 30 30 80 80 -fill #441739 + lappend result [winfo colormapfull .t] + .t.c create rectangle 40 40 90 90 -fill #ffeedd + 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 @@ -206,15 +210,9 @@ test winfo-7.6 {"winfo pathname" command} { test winfo-7.7 {"winfo pathname" command} { winfo pathname -displayof .b [winfo id .] } {.} - -if {[string compare testwrapper [info commands testwrapper]] == 0} { - puts "This application hasn't been compiled with the testwrapper command," - puts "therefore I am skipping all of these tests." - - test winfo-7.8 {"winfo pathname" command} {unixOnly} { - winfo pathname [testwrapper .] - } {} -} +test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} { + winfo pathname [testwrapper .] +} {} test winfo-8.1 {"winfo pointerx" command} { catch [winfo pointerx .b] @@ -317,7 +315,7 @@ proc MakeEmbed {} { pack .emb.b -expand yes -fill both update } -test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} { +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]] @@ -325,8 +323,8 @@ test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} { destroy .con set z } {1} -test winfo-13.2 {destroying embedded toplevel} {macOrUnix} { - catch {destroy .emb} +test winfo-13.2 {destroying embedded toplevel} { + destroy .emb update expr [winfo exists .emb.b] || [winfo exists .con] } 0 @@ -335,7 +333,7 @@ foreach i [winfo children .] { destroy $i } -test winfo-13.3 {destroying container window} {macOrUnix} { +test winfo-13.3 {destroying container window} { MakeEmbed destroy .con update @@ -349,7 +347,7 @@ foreach i [winfo children .] { destroy $i } -test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} { +test winfo-13.4 {[winfo containing] with embedded windows} { MakeEmbed button .b pack .b -expand yes -fill both @@ -365,3 +363,19 @@ test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} { foreach i [winfo children .] { catch {destroy $i} } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + diff --git a/tests/xmfbox.test b/tests/xmfbox.test new file mode 100644 index 0000000..c5b6736 --- /dev/null +++ b/tests/xmfbox.test @@ -0,0 +1,153 @@ +# 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 +# runs in a modal loop, the only way to test it sufficiently is +# to call the internal Tcl procedures in xmfbox.tcl directly. +# +# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: xmfbox.test,v 1.2 1999/04/16 01:51:44 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +set testPWD [pwd] +eval destroy [winfo children .] +catch {unset foo} + +catch {unset data foo} + +proc cleanup {} { + global testPWD + + set err0 [catch { + cd $testPWD + } msg0] + + set err1 [catch { + if [file exists ./~nosuchuser1] { + file delete ./~nosuchuser1 + } + } msg1] + + set err2 [catch { + if [file exists ./~nosuchuser2] { + file delete ./~nosuchuser2 + } + } msg2] + + set err3 [catch { + if [file exists ./~nosuchuser3] { + file delete ./~nosuchuser3 + } + } msg3] + + set err4 [catch { + if [file exists ./~nosuchuser4] { + file delete ./~nosuchuser4 + } + } msg4] + + if {$err0 || $err1 || $err2 || $err3 || $err4} { + error [list $msg0 $msg1 $msg2 $msg3 $msg4] + } + catch {unset foo} + catch {destroy .foo} +} + +test xmfbox-1.1 {tkMotifFDialog_Create, -parent switch} {unixOnly} { + catch {unset foo} + set x [tkMotifFDialog_Create foo open {-parent .}] + catch {destroy $x} + set x +} .foo + +test xmfbox-1.2 {tkMotifFDialog_Create, -parent switch} {unixOnly} { + catch {unset foo} + toplevel .bar + set x [tkMotifFDialog_Create foo open {-parent .bar}] + catch {destroy $x} + catch {destroy .bar} + set x +} .bar.foo + +test xmfbox-2.1 {tkMotifFDialog_InterpFilter, ~ in dir names} {unixOnly} { + cleanup + file mkdir ./~nosuchuser1 + set x [tkMotifFDialog_Create foo open {}] + $foo(fEnt) delete 0 end + $foo(fEnt) insert 0 [pwd]/~nosuchuser1 + set kk [tkMotifFDialog_InterpFilter $x] +} [list $testPWD/~nosuchuser1 *] + +test xmfbox-2.2 {tkMotifFDialog_InterpFilter, ~ in file names} {unixOnly} { + cleanup + close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] + set x [tkMotifFDialog_Create foo open {}] + $foo(fEnt) delete 0 end + $foo(fEnt) insert 0 [pwd]/~nosuchuser1 + set kk [tkMotifFDialog_InterpFilter $x] +} [list $testPWD ./~nosuchuser1] + +test xmfbox-2.3 {tkMotifFDialog_Update, ~ in file names} {unixOnly} { + cleanup + close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] + set x [tkMotifFDialog_Create foo open {}] + $foo(fEnt) delete 0 end + $foo(fEnt) insert 0 [pwd]/~nosuchuser1 + tkMotifFDialog_InterpFilter $x + tkMotifFDialog_Update $x + $foo(fList) get end +} ~nosuchuser1 + +test xmfbox-2.4 {tkMotifFDialog_LoadFile, ~ in file names} {unixOnly} { + cleanup + close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] + set x [tkMotifFDialog_Create foo open {}] + set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1] + expr {$i >= 0} +} 1 + +test xmfbox-2.5 {tkMotifFDialog_BrowseFList, ~ in file names} {unixOnly} { + cleanup + close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] + set x [tkMotifFDialog_Create foo open {}] + set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1] + $foo(fList) selection clear 0 end + $foo(fList) selection set $i + tkMotifFDialog_BrowseFList $x + $foo(sEnt) get +} $testPWD/~nosuchuser1 + +test xmfbox-2.5 {tkMotifFDialog_ActivateFList, ~ in file names} {unixOnly} { + cleanup + close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] + set x [tkMotifFDialog_Create foo open {}] + set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1] + $foo(fList) selection clear 0 end + $foo(fList) selection set $i + tkMotifFDialog_BrowseFList $x + tkMotifFDialog_ActivateFList $x + list $foo(selectPath) $foo(selectFile) $tkPriv(selectFilePath) +} [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1] + +# cleanup +cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + diff --git a/unix/Makefile.in b/unix/Makefile.in index a4af245..98dc87a 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.13 1999/03/10 07:04:45 stanton Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.14 1999/04/16 01:51:44 stanton Exp $ # Current Tk version; used in various names. @@ -76,6 +76,7 @@ MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # for this version of Tk ("srcdir" will be replaced or has already # been replaced by the configure script): TCL_GENERIC_DIR = @TCL_SRC_DIR@/generic +TCL_UNIX_DIR = @TCL_SRC_DIR@/unix # The directory containing the Tcl library archive file appropriate # for this version of Tk: @@ -110,6 +111,7 @@ X11_INCLUDES = @XINCLUDES@ # can override it). X11_LIB_SWITCHES = @XLIBSW@ + # To turn off the security checks that disallow incoming sends when # the X server appears to be insecure, reverse the comments on the # following lines: @@ -128,22 +130,6 @@ PROTO_FLAGS = MEM_DEBUG_FLAGS = #MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG -# To enable support for stubs in Tcl. -STUB_LIB_FILE = @STUB_LIB_FILE@ - -TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@ -#TK_STUB_LIB_FILE = libtkstub.a - -TK_STUB_LIB_FLAG = @TK_STUB_LIB_FLAG@ -#TK_STUB_LIB_FLAG = -ltkstub - - - -# Libraries to use when linking. This definition is determined by the -# configure script. -LIBS = @TCL_BUILD_LIB_SPEC@ @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc - - # If your X server is X11R4 or earlier, then you may wish to reverse # the comment characters on the following two lines. This will enable # extra code to speed up XStringToKeysym. In X11R5 and later releases @@ -151,6 +137,12 @@ LIBS = @TCL_BUILD_LIB_SPEC@ @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -l KEYSYM_FLAGS = #KEYSYM_FLAGS = -DREDO_KEYSYM_LOOKUP +# 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 + # Some versions of make, like SGI's, use the following variable to # determine which shell to use for executing commands: SHELL = /bin/sh @@ -172,15 +164,32 @@ INSTALL_DATA = ${INSTALL} -m 644 TK_SHLIB_CFLAGS = @TK_SHLIB_CFLAGS@ +# To enable support for stubs in Tcl. +STUB_LIB_FILE = @STUB_LIB_FILE@ + +TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@ +#TK_STUB_LIB_FILE = libtkstub.a + +TK_STUB_LIB_FLAG = @TK_STUB_LIB_FLAG@ +#TK_STUB_LIB_FLAG = -ltkstub + TK_LIB_FILE = @TK_LIB_FILE@ #TK_LIB_FILE = libtk.a TK_LIB_FLAG = @TK_LIB_FLAG@ #TK_LIB_FLAG = -ltk +TCL_LIB_SPEC = @TCL_BUILD_LIB_SPEC@ TK_EXP_FILE = @TK_EXP_FILE@ TK_BUILD_EXP_FILE = @TK_BUILD_EXP_FILE@ +TCL_STUB_FLAGS = @TCL_STUB_FLAGS@ + +# Libraries to use when linking. This definition is determined by the +# configure script. +LIBS = @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc +WISH_LIBS = $(TCL_LIB_SPEC) @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc + # The symbol below provides support for dynamic loading and shared # libraries. See configure.in for a description of what it means. # The values of the symbolis normally set by the configure script. @@ -216,29 +225,28 @@ TOOL_DIR = @TCL_SRC_DIR@/tools CC = @CC@ -CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TK_SHLIB_CFLAGS} \ + +CC_SWITCHES_NO_STUBS = ${CFLAGS} ${CFLAGS_WARNING} ${TK_SHLIB_CFLAGS} \ -I${UNIX_DIR} -I${GENERIC_DIR} \ -I${BMAP_DIR} -I${TCL_GENERIC_DIR} ${X11_INCLUDES} \ ${AC_FLAGS} ${PROTO_FLAGS} \ -${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} +${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} ${NO_DEPRECATED_FLAGS} + +CC_SWITCHES = ${CC_SWITCHES_NO_STUBS} ${TCL_STUB_FLAGS} -STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ --I${UNIX_DIR} -I${GENERIC_DIR} \ --I${BMAP_DIR} -I${TCL_GENERIC_DIR} ${X11_INCLUDES} \ -${AC_FLAGS} ${PROTO_FLAGS} \ -${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} \ - -DTK_SHLIB_EXT=\"${SHLIB_SUFFIX}\" DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ -I${BMAP_DIR} \ -I${TCL_GENERIC_DIR} ${X11_INCLUDES} \ ${AC_FLAGS} ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} \ -${KEYSYM_FLAGS} -DTK_SHLIB_EXT=\"${SHLIB_SUFFIX}\" +${KEYSYM_FLAGS} WISH_OBJS = tkAppInit.o -TKTEST_OBJS = tkTestInit.o tkTest.o tkSquare.o +TCLTEST_OBJS = ${TCL_BIN_DIR}/tclTest.o ${TCL_BIN_DIR}/tclThreadTest.o \ + ${TCL_BIN_DIR}/tclUnixTest.o +TKTEST_OBJS = $(TCLTEST_OBJS) tkTestInit.o tkTest.o tkSquare.o WIDGOBJS = tkButton.o tkEntry.o tkFrame.o tkListbox.o \ tkMenu.o tkMenubutton.o tkMenuDraw.o tkMessage.o tkScale.o \ @@ -253,19 +261,18 @@ IMAGEOBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPPM.o tkImgPhoto.o TEXTOBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \ tkTextMark.o tkTextTag.o tkTextWind.o -UNIXOBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixCursor.o \ - tkUnixDialog.o tkUnixDraw.o \ - tkUnixEmbed.o tkUnixEvent.o tkUnixFocus.o tkUnixFont.o tkUnixInit.o \ - tkUnixMenu.o tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o \ - tkUnixSelect.o tkUnixSend.o tkUnixWm.o tkUnixXId.o tkStubInit.o +UNIXOBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixConfig.o \ + tkUnixCursor.o tkUnixDraw.o tkUnixEmbed.o tkUnixEvent.o \ + tkUnixFocus.o tkUnixFont.o tkUnixInit.o tkUnixKey.o tkUnixMenu.o \ + tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o tkUnixSelect.o \ + tkUnixSend.o tkUnixWm.o tkUnixXId.o tkStubInit.o tkStubLib.o -STUB_LIB_OBJS = tkStubs.o tkIntStubs.o tkIntPlatStubs.o tkPlatStubs.o \ - tkIntXlibStubs.o tkStubLib.o +STUB_LIB_OBJS = tkStubLib.o OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o tkCmds.o \ tkColor.o tkConfig.o tkCursor.o tkError.o tkEvent.o \ tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o tkGrid.o \ - tkMain.o tkOption.o tkPack.o tkPlace.o \ + tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \ tkSelect.o tkUtil.o tkVisual.o tkWindow.o \ $(UNIXOBJS) $(WIDGOBJS) $(CANVOBJS) $(IMAGEOBJS) $(TEXTOBJS) @@ -288,7 +295,7 @@ SRCS = \ $(GENERIC_DIR)/tkPack.c $(GENERIC_DIR)/tkPlace.c \ $(GENERIC_DIR)/tkSelect.c $(GENERIC_DIR)/tkUtil.c \ $(GENERIC_DIR)/tkVisual.c $(GENERIC_DIR)/tkWindow.c \ - $(GENERIC_DIR)/tkButton.c \ + $(GENERIC_DIR)/tkButton.c $(GENERIC_DIR)/tkObj.c \ $(GENERIC_DIR)/tkEntry.c $(GENERIC_DIR)/tkFrame.c \ $(GENERIC_DIR)/tkListbox.c $(GENERIC_DIR)/tkMenu.c \ $(GENERIC_DIR)/tkMenubutton.c $(GENERIC_DIR)/tkMenuDraw.c \ @@ -308,18 +315,19 @@ SRCS = \ $(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)/tkSquare.c $(GENERIC_DIR)/tkTest.c \ - $(GENERIC_DIR)/tkStubs.c $(GENERIC_DIR)/tkIntStubs.c \ - $(GENERIC_DIR)/tkPlatStubs.c $(GENERIC_DIR)/tkIntPlatStubs.c \ - $(GENERIC_DIR)/tkIntXlibStubs.c $(GENERIC_DIR)/tkInitStubs.c \ + $(GENERIC_DIR)/tkStubInit.c $(GENERIC_DIR)/tkStubLib.c \ $(UNIX_DIR)/tkAppInit.c $(UNIX_DIR)/tkUnix.c \ $(UNIX_DIR)/tkUnix3d.c \ $(UNIX_DIR)/tkUnixButton.c $(UNIX_DIR)/tkUnixColor.c \ + $(UNIX_DIR)/tkUnixConfig.c \ $(UNIX_DIR)/tkUnixCursor.c \ - $(UNIX_DIR)/tkUnixDialog.c $(UNIX_DIR)/tkUnixDraw.c \ + $(UNIX_DIR)/tkUnixDraw.c \ $(UNIX_DIR)/tkUnixEmbed.c $(UNIX_DIR)/tkUnixEvent.c \ $(UNIX_DIR)/tkUnixFocus.c \ $(UNIX_DIR)/tkUnixFont.c $(UNIX_DIR)/tkUnixInit.c \ + $(UNIX_DIR)/tkUnixKey.c \ $(UNIX_DIR)/tkUnixMenu.c $(UNIX_DIR)/tkUnixMenubu.c \ $(UNIX_DIR)/tkUnixScale.c $(UNIX_DIR)/tkUnixScrlbr.c \ $(UNIX_DIR)/tkUnixSelect.c \ @@ -352,23 +360,26 @@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} # extensions. used for the Tcl Plugin. -- dl tkLibObjs: @echo ${OBJS} + # This targets actually build the objects needed for the lib in the above # case objs: ${OBJS} wish: $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) - $(CC) @LD_FLAGS@ $(WISH_OBJS) @TK_BUILD_LIB_SPEC@ $(LIBS) \ - $(TK_CC_SEARCH_FLAGS) -o wish + $(CC) @LD_FLAGS@ $(WISH_OBJS) \ + @TK_BUILD_LIB_SPEC@ \ + $(WISH_LIBS) $(TK_CC_SEARCH_FLAGS) -o wish tktest: $(TKTEST_OBJS) $(TK_LIB_FILE) - ${CC} @LD_FLAGS@ $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ $(LIBS) \ - $(TK_CC_SEARCH_FLAGS) -o tktest + ${CC} @LD_FLAGS@ $(TKTEST_OBJS) \ + @TK_BUILD_LIB_SPEC@ \ + $(WISH_LIBS) $(TK_CC_SEARCH_FLAGS) -o tktest xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE) ${CC} @LD_FLAGS@ test.o tkTest.o tkSquare.o \ - @TK_BUILD_LIB_SPEC@ $(LIBS) \ - @TK_LD_SEARCH_FLAGS@ -lXt -o xttest + @TK_BUILD_LIB_SPEC@ \ + $(WISH_LIBS) $(TK_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 @@ -380,10 +391,8 @@ test: tktest SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \ export SHLIB_PATH; \ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \ - TK_LIBRARY=$(TOP_DIR)/library; export TK_LIBRARY; \ - ( echo cd $(TOP_DIR)/tests\; source all\; exit ) \ - | ./tktest -geometry +0+0 - + TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \ + ./tktest $(TOP_DIR)/tests/all.tcl -geometry +0+0 # Useful target to launch a built tktest with the proper path,... runtest: @@ -392,7 +401,7 @@ runtest: SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \ export SHLIB_PATH; \ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \ - TK_LIBRARY=$(TOP_DIR)/library; export TK_LIBRARY; \ + TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \ ./tktest install: install-binaries install-libraries install-demos install-man @@ -415,15 +424,15 @@ install-binaries: $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) $(TK_BUILD_EXP_FILE) wish @$(INSTALL_DATA) $(TK_LIB_FILE) $(LIB_INSTALL_DIR)/$(TK_LIB_FILE) @(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TK_LIB_FILE)) @chmod 555 $(LIB_INSTALL_DIR)/$(TK_LIB_FILE) + @echo "Installing wish" + @$(INSTALL_PROGRAM) wish $(BIN_INSTALL_DIR)/wish$(VERSION) + @echo "Installing tkConfig.sh" + @$(INSTALL_DATA) tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh @if test "$(TK_BUILD_EXP_FILE)" != ""; then \ echo "Installing $(TK_EXP_FILE)"; \ $(INSTALL_DATA) $(TK_BUILD_EXP_FILE) \ $(LIB_INSTALL_DIR)/$(TK_EXP_FILE); \ fi - @echo "Installing wish" - @$(INSTALL_PROGRAM) wish $(BIN_INSTALL_DIR)/wish$(VERSION) - @echo "Installing tkConfig.sh" - @$(INSTALL_DATA) tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh @if test "$(TK_STUB_LIB_FILE)" != "" ; then \ echo "Installing $(TK_STUB_LIB_FILE)"; \ $(INSTALL_DATA) $(STUB_LIB_FILE) \ @@ -441,9 +450,12 @@ install-libraries: else true; \ fi; \ done; - @echo "Installing tk.h" - @$(INSTALL_DATA) $(GENERIC_DIR)/tk.h $(INCLUDE_INSTALL_DIR)/tk.h - for i in $(SRC_DIR)/library/*.tcl $(SRC_DIR)/library/tclIndex $(SRC_DIR)/library/prolog.ps $(UNIX_DIR)/tkAppInit.c; \ + @for i in $(GENERIC_DIR)/tk.h $(GENERIC_DIR)/tkDecls.h ; \ + do \ + echo "Installing $$i"; \ + $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \ + done; + for i in $(SRC_DIR)/library/*.tcl $(SRC_DIR)/library/tclIndex $(UNIX_DIR)/tkAppInit.c; \ do \ echo "Installing $$i"; \ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \ @@ -549,19 +561,19 @@ tkTestInit.o: $(UNIX_DIR)/tkAppInit.c rm -f tkAppInit.sav; \ mv tkAppInit.o tkAppInit.sav; \ fi; - $(CC) -c $(CC_SWITCHES) -DTK_TEST $(UNIX_DIR)/tkAppInit.c + $(CC) -c $(CC_SWITCHES_NO_STUBS) -DTK_TEST $(UNIX_DIR)/tkAppInit.c rm -f tkTestInit.o mv tkAppInit.o tkTestInit.o @if test -f tkAppInit.sav ; then \ mv tkAppInit.sav tkAppInit.o; \ fi; +tkAppInit.o: $(UNIX_DIR)/tkAppInit.c + $(CC) -c $(CC_SWITCHES_NO_STUBS) $(UNIX_DIR)/tkAppInit.c + tk3d.o: $(GENERIC_DIR)/tk3d.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tk3d.c -tkAppInit.o: $(UNIX_DIR)/tkAppInit.c - $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkAppInit.c - tkArgv.o: $(GENERIC_DIR)/tkArgv.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkArgv.c @@ -619,6 +631,12 @@ tkGrid.o: $(GENERIC_DIR)/tkGrid.c tkMain.o: $(GENERIC_DIR)/tkMain.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMain.c +tkObj.o: $(GENERIC_DIR)/tkObj.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkObj.c + +tkOldConfig.o: $(GENERIC_DIR)/tkOldConfig.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOldConfig.c + tkOption.o: $(GENERIC_DIR)/tkOption.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOption.c @@ -671,7 +689,7 @@ tkScrollbar.o: $(GENERIC_DIR)/tkScrollbar.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScrollbar.c tkSquare.o: $(GENERIC_DIR)/tkSquare.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkSquare.c + $(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkSquare.c tkCanvas.o: $(GENERIC_DIR)/tkCanvas.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvas.c @@ -725,7 +743,7 @@ tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhoto.c tkTest.o: $(GENERIC_DIR)/tkTest.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTest.c + $(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkTest.c tkText.o: $(GENERIC_DIR)/tkText.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkText.c @@ -751,6 +769,15 @@ tkTextTag.o: $(GENERIC_DIR)/tkTextTag.c tkTextWind.o: $(GENERIC_DIR)/tkTextWind.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextWind.c +tkStubInit.o: $(GENERIC_DIR)/tkStubInit.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubInit.c + +# Stub library binaries, these must be compiled for use in a shared library +# even though they will be placed in a static archive + +tkStubLib.o: $(GENERIC_DIR)/tkStubLib.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubLib.c + tkUnix.o: $(UNIX_DIR)/tkUnix.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix.c @@ -763,12 +790,12 @@ tkUnixButton.o: $(UNIX_DIR)/tkUnixButton.c tkUnixColor.o: $(UNIX_DIR)/tkUnixColor.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixColor.c +tkUnixConfig.o: $(UNIX_DIR)/tkUnixConfig.c + $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixConfig.c + tkUnixCursor.o: $(UNIX_DIR)/tkUnixCursor.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixCursor.c -tkUnixDialog.o: $(UNIX_DIR)/tkUnixDialog.c - $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDialog.c - tkUnixDraw.o: $(UNIX_DIR)/tkUnixDraw.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDraw.c @@ -788,6 +815,9 @@ tkUnixInit.o: $(UNIX_DIR)/tkUnixInit.c $(GENERIC_DIR)/tkInitScript.h tkConfig.sh $(CC) -c $(CC_SWITCHES) -DTK_LIBRARY=\"${TK_LIBRARY}\" \ $(UNIX_DIR)/tkUnixInit.c +tkUnixKey.o: $(UNIX_DIR)/tkUnixKey.c + $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixKey.c + tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenu.c @@ -812,35 +842,24 @@ tkUnixWm.o: $(UNIX_DIR)/tkUnixWm.c tkUnixXId.o: $(UNIX_DIR)/tkUnixXId.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixXId.c -tkStubInit.o: $(GENERIC_DIR)/tkStubInit.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubInit.c - - -# Stub library binaries, these must be compiled for use in a shared library -# even though they will be placed in a static archive - -tkStubs.o: $(GENERIC_DIR)/tkStubs.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tkStubs.c - -tkIntStubs.o: $(GENERIC_DIR)/tkIntStubs.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tkIntStubs.c - -tkPlatStubs.o: $(GENERIC_DIR)/tkPlatStubs.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tkPlatStubs.c +.c.o: + $(CC) -c $(CC_SWITCHES) $< -tkIntPlatStubs.o: $(GENERIC_DIR)/tkIntPlatStubs.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tkIntPlatStubs.c +# +# Target to check for proper usage of UCHAR macro. +# -tkIntXlibStubs.o: $(GENERIC_DIR)/tkIntXlibStubs.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tkIntXlibStubs.c +checkuchar: + -egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR -tkStubLib.o: $(GENERIC_DIR)/tkStubLib.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tkStubLib.c +# +# Target to make sure that only symbols with "Tk" prefixes are +# exported. +# -.c.o: - $(CC) -c $(CC_SWITCHES) $< +checkexports: $(TK_LIB_FILE) + -nm -p $(TK_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]k' -# # Target to regenerate header files and stub files from the *.decls tables. # @@ -865,20 +884,7 @@ checkstubs: if [ $$match -eq 0 ]; then echo $$i; fi \ done -# -# Target to check for proper usage of UCHAR macro. -# -checkuchar: - -egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR - -# -# Target to make sure that only symbols with "Tk" prefixes are -# exported. -# - -checkexports: $(TK_LIB_FILE) - -nm -p $(TK_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]k' # # Target to create a proper Tk distribution from information in the @@ -918,7 +924,8 @@ dist: $(UNIX_DIR)/configure fi; \ done;) mkdir $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(DISTDIR)/generic + cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(GENERIC_DIR)/prolog.ps \ + $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(TOP_DIR)/changes $(TOP_DIR)/README $(TOP_DIR)/license.terms \ $(DISTDIR) @@ -955,7 +962,7 @@ dist: $(UNIX_DIR)/configure cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib/X11 mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ - $(TOP_DIR)/library/tclIndex $(TOP_DIR)/library/prolog.ps \ + $(TOP_DIR)/library/tclIndex \ $(DISTDIR)/library mkdir $(DISTDIR)/library/images @(cd $(TOP_DIR); for i in library/images/* ; do \ @@ -986,10 +993,8 @@ dist: $(UNIX_DIR)/configure $(TCLDIR)/doc/man.macros $(DISTDIR)/doc mkdir $(DISTDIR)/tests cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/tests/*.test \ - $(TOP_DIR)/tests/visual $(TOP_DIR)/tests/*.tcl \ - $(TOP_DIR)/tests/README $(TOP_DIR)/tests/all \ - $(TOP_DIR)/tests/defs $(TOP_DIR)/tests/option.file* \ - $(DISTDIR)/tests + $(TOP_DIR)/tests/*.tcl $(TOP_DIR)/tests/README \ + $(TOP_DIR)/tests/option.file* $(DISTDIR)/tests # # The following target can only be used for non-patch releases. Use @@ -1002,7 +1007,7 @@ alldist: dist $(DISTROOT)/$(ZIPNAME) cd $(DISTROOT); tar cf $(DISTNAME).tar $(DISTNAME); \ gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \ - compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) $(DISTNAME) + compress $(DISTNAME).tar; zip -qr8 $(ZIPNAME) $(DISTNAME) # # The target below is similar to "alldist" except it works for patch diff --git a/unix/README b/unix/README index 80c6fc3..14d3d40 100644 --- a/unix/README +++ b/unix/README @@ -10,14 +10,14 @@ SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for a PC running Windows, see the README file in the directory ../win. To compile for a Macintosh, see the README file in the directory ../mac. -RCS: @(#) $Id: README,v 1.3 1999/02/09 03:46:27 stanton Exp $ +RCS: @(#) $Id: README,v 1.4 1999/04/16 01:51:45 stanton Exp $ How To Compile And Install Tk: ------------------------------ -(a) Make sure that the Tcl 8.0 release is present in the directory - ../../tcl8.0 (or else use the "--with-tcl" switch described below). - This release of Tk will only work with Tcl 8.0. Also, be sure that +(a) Make sure that the Tcl 8.1 release is present in the directory + ../../tcl8.1a2 (or else use the "--with-tcl" switch described below). + This release of Tk will only work with Tcl 8.1. Also, be sure that you have configured Tcl before you configure Tk. (b) Check for patches as described in ../README. @@ -78,9 +78,9 @@ How To Compile And Install Tk: TCL_LIBRARY environment variable as well (see the Tcl README file for information on this). Note that installed versions of wish, libtk.a, libtk.so, and the Tk library have a version number in their - names, such as "wish8.0" or "libtk8.0.so"; to use the installed + names, such as "wish8.1" or "libtk8.1.so"; to use the installed versions, either specify the version number or create a symbolic - link (e.g. from "wish" to "wish8.0"). + link (e.g. from "wish" to "wish8.1"). If you have trouble compiling Tk, read through the file "porting.notes". It contains information that people have provided diff --git a/unix/configure.in b/unix/configure.in index 99b37c1..4e3f667 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,12 +3,12 @@ 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(../generic/tk.h) -# RCS: @(#) $Id: configure.in,v 1.29 1999/03/22 21:32:16 redman Exp $ +# RCS: @(#) $Id: configure.in,v 1.30 1999/04/16 01:51:45 stanton Exp $ -TK_VERSION=8.0 +TK_VERSION=8.1 TK_MAJOR_VERSION=8 -TK_MINOR_VERSION=0 -TK_PATCH_LEVEL=".5" +TK_MINOR_VERSION=1 +TK_PATCH_LEVEL=b3 VERSION=${TK_VERSION} if test "${prefix}" = "NONE"; then @@ -19,6 +19,10 @@ if test "${exec_prefix}" = "NONE"; then fi TK_SRC_DIR=`cd $srcdir/..; pwd` +# Most of the checks here are duplicated from Tcl's configure.in +# and should not be redone but rather simply used from the definitions +# found in tclConfig.sh + AC_PROG_RANLIB AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available], [tk_ok=$enableval], [tk_ok=no]) @@ -31,6 +35,25 @@ fi AC_C_CROSS AC_HAVE_HEADERS(unistd.h limits.h) +# Threads support +AC_ARG_ENABLE(threads,[ --enable-threads enable Threads support],,enableval="no") + +if test "$enableval" = "yes"; then + AC_MSG_RESULT(Will compile with Threads support) + AC_DEFINE(TCL_THREADS) + AC_DEFINE(_REENTRANT) + + AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthread" + else + AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...") + fi +else + AC_MSG_RESULT(Will compile without Threads support (normal)) +fi + # set the warning flags depending on whether or not we are using gcc if test "${GCC}" = "yes" ; then # leave -Wimplicit-int out, the X libs generate so many of these warnings @@ -61,10 +84,18 @@ fi #-------------------------------------------------------------------- # See if there was a command-line option for where Tcl is; if # not, assume that its top-level directory is a sibling of ours. +# Try the patch-level-specific directory first, then the general one. #-------------------------------------------------------------------- -AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR], - TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl8.0$TK_PATCH_LEVEL/unix; pwd`) + +if test -d ../../tcl8.1$TK_PATCH_LEVEL/unix; then + TCL_BIN_DEFAULT=../../tcl8.1$TK_PATCH_LEVEL/unix +else + TCL_BIN_DEFAULT=../../tcl8.1/unix +fi + +AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.1 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 doesn't exist) fi @@ -168,6 +199,18 @@ AC_UID_T AC_CHECK_HEADERS(sys/time.h) AC_HEADER_TIME +#------------------------------------------- +# In OS/390 struct pwd has no pw_gecos field +#------------------------------------------- + +AC_MSG_CHECKING([pw_gecos in struct pwd]) +AC_TRY_COMPILE([#include <pwd.h>], + [struct passwd pwd; pwd.pw_gecos;], tk_ok=yes, tk_ok=no) +AC_MSG_RESULT($tk_ok) +if test $tk_ok = yes; then + AC_DEFINE(HAVE_PW_GECOS) +fi + #-------------------------------------------------------------------- # Locate the X11 header files and the X11 library archive. Try # the ac_path_x macro first, but if it doesn't find the X stuff @@ -312,6 +355,10 @@ if test "$tk_checkBoth" = 1; then fi AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) +# Add the threads support libraries + +LIBS="$LIBS$THREADS_LIBS" + #-------------------------------------------------------------------- # One more check related to the X libraries. The standard releases # of Ultrix don't support the "xauth" mechanism, so send won't work @@ -354,13 +401,6 @@ AC_CHECK_FUNC(sin, , MATH_LIBS="-lm") AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"]) #-------------------------------------------------------------------- -# If this system doesn't have a memmove procedure, use memcpy -# instead. -#-------------------------------------------------------------------- - -AC_CHECK_FUNC(memmove, , [AC_DEFINE(memmove, memcpy)]) - -#-------------------------------------------------------------------- # Figure out whether "char" is unsigned. If so, set a # #define for __CHAR_UNSIGNED__. #-------------------------------------------------------------------- @@ -403,19 +443,23 @@ fi #-------------------------------------------------------------------- AC_ARG_ENABLE(shared, - [ --enable-shared build libtk as a shared library], - [ok=$enableval], [ok=no]) + [ --enable-shared build libtk as a shared library (on by default)], + [ok=$enableval], [ok=yes]) if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then TK_SHARED_BUILD=1 TK_SHLIB_CFLAGS="${SHLIB_CFLAGS}" TK_LIB_FILE=libtk${TCL_SHARED_LIB_SUFFIX} - MAKE_LIB='\${SHLIB_LD} -o \${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${SHLIB_LD_LIBS}' + MAKE_LIB="\${SHLIB_LD} -o \${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_BUILD_STUB_LIB_SPEC} \${LIBS}" RANLIB=":" + + TCL_STUB_FLAGS="-DUSE_TCL_STUBS" else TK_SHARED_BUILD=0 TK_SHLIB_CFLAGS="" TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX} - MAKE_LIB='ar cr \${TK_LIB_FILE} \${OBJS}' + MAKE_LIB="ar cr \${TK_LIB_FILE} \${OBJS}" + + TCL_STUB_FLAGS="" fi DBGX='${TK_DBGX}' @@ -449,35 +493,26 @@ fi # using tcl stub support. #-------------------------------------------------------------------- -# Linking to the Tcl stub library is not supported until Tk is a fully -# loadable extension. +# For now, linking to Tcl stubs is not supported with Tk. It causes +# too many problems with linking. When Tk is a fully loadable +# extension, linking the the Tcl stubs will be supported. -AC_MSG_RESULT(dynamic linking) -TCL_BUILD_STUB_LIB_SPEC="" -TCL_STUB_FLAGS="" -#-------------------------------------------------------------------- -# The statements below define various symbols relating to Tcl -# stub support. -#-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TK_VERSION} eval "STUB_LIB_FILE=libtkstub${TCL_UNSHARED_LIB_SUFFIX}" -# Replace DBGX with TCL_DBGX -eval "STUB_LIB_FILE=\"${STUB_LIB_FILE}\"" - MAKE_STUB_LIB="ar cr \${STUB_LIB_FILE} \${STUB_LIB_OBJS}" TK_STUB_LIB_FILE=${STUB_LIB_FILE} if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then - TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}\${TCL_DBGX}" + TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}\${TK_DBGX}" else - TK_STUB_LIB_FLAG="-ltkstub`echo ${TK_VERSION} | tr -d .`\${TCL_DBGX}" + TK_STUB_LIB_FLAG="-ltkstub`echo ${TK_VERSION} | tr -d .`\${TK_DBGX}" fi TK_BUILD_STUB_LIB_SPEC="-L`pwd` ${TK_STUB_LIB_FLAG}" -TL_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TK_STUB_LIB_FLAG}" +TK_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TK_STUB_LIB_FLAG}" TK_BUILD_STUB_LIB_PATH="`pwd`/${TK_STUB_LIB_FILE}" TK_STUB_LIB_PATH="${exec_prefix}/lib/${TK_STUB_LIB_FILE}" @@ -510,8 +545,8 @@ AC_SUBST(SHLIB_LD_LIBS) AC_SUBST(SHLIB_SUFFIX) AC_SUBST(SHLIB_VERSION) AC_SUBST(TCL_BIN_DIR) -AC_SUBST(TCL_BUILD_LIB_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_SPEC) +AC_SUBST(TCL_BUILD_LIB_SPEC) AC_SUBST(TCL_DBGX) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_SRC_DIR) @@ -521,8 +556,6 @@ AC_SUBST(TK_CC_SEARCH_FLAGS) AC_SUBST(TK_LD_SEARCH_FLAGS) AC_SUBST(TK_LIB_FILE) AC_SUBST(TK_LIB_FLAG) -AC_SUBST(TK_BUILD_EXP_FILE) -AC_SUBST(TK_EXP_FILE) AC_SUBST(TK_LIB_SPEC) AC_SUBST(TK_MAJOR_VERSION) AC_SUBST(TK_MINOR_VERSION) diff --git a/unix/mkLinks b/unix/mkLinks index d817703..5b326b6 100644 --- a/unix/mkLinks +++ b/unix/mkLinks @@ -43,6 +43,26 @@ if test -r 3DBorder.3; then rm -f Tk_3DVerticalBevel.3 ln 3DBorder.3 Tk_3DVerticalBevel.3 fi +if test -r 3DBorder.3; then + rm -f Tk_Alloc3DBorderFromObj.3 + ln 3DBorder.3 Tk_Alloc3DBorderFromObj.3 +fi +if test -r GetBitmap.3; then + rm -f Tk_AllocBitmapFromObj.3 + ln GetBitmap.3 Tk_AllocBitmapFromObj.3 +fi +if test -r GetColor.3; then + rm -f Tk_AllocColorFromObj.3 + ln GetColor.3 Tk_AllocColorFromObj.3 +fi +if test -r GetCursor.3; then + rm -f Tk_AllocCursorFromObj.3 + ln GetCursor.3 Tk_AllocCursorFromObj.3 +fi +if test -r GetFont.3; then + rm -f Tk_AllocFontFromObj.3 + ln GetFont.3 Tk_AllocFontFromObj.3 +fi if test -r WindowId.3; then rm -f Tk_Attributes.3 ln WindowId.3 Tk_Attributes.3 @@ -191,6 +211,10 @@ if test -r CrtItemType.3; then rm -f Tk_CreateItemType.3 ln CrtItemType.3 Tk_CreateItemType.3 fi +if test -r SetOptions.3; then + rm -f Tk_CreateOptionTable.3 + ln SetOptions.3 Tk_CreateOptionTable.3 +fi if test -r CrtPhImgFmt.3; then rm -f Tk_CreatePhotoImageFormat.3 ln CrtPhImgFmt.3 Tk_CreatePhotoImageFormat.3 @@ -243,6 +267,10 @@ if test -r DeleteImg.3; then rm -f Tk_DeleteImage.3 ln DeleteImg.3 Tk_DeleteImage.3 fi +if test -r SetOptions.3; then + rm -f Tk_DeleteOptionTable.3 + ln SetOptions.3 Tk_DeleteOptionTable.3 +fi if test -r CrtSelHdlr.3; then rm -f Tk_DeleteSelHandler.3 ln CrtSelHdlr.3 Tk_DeleteSelHandler.3 @@ -311,26 +339,50 @@ if test -r 3DBorder.3; then rm -f Tk_Free3DBorder.3 ln 3DBorder.3 Tk_Free3DBorder.3 fi +if test -r 3DBorder.3; then + rm -f Tk_Free3DBorderFromObj.3 + ln 3DBorder.3 Tk_Free3DBorderFromObj.3 +fi if test -r GetBitmap.3; then rm -f Tk_FreeBitmap.3 ln GetBitmap.3 Tk_FreeBitmap.3 fi +if test -r GetBitmap.3; then + rm -f Tk_FreeBitmapFromObj.3 + ln GetBitmap.3 Tk_FreeBitmapFromObj.3 +fi if test -r GetColor.3; then rm -f Tk_FreeColor.3 ln GetColor.3 Tk_FreeColor.3 fi +if test -r GetColor.3; then + rm -f Tk_FreeColorFromObj.3 + ln GetColor.3 Tk_FreeColorFromObj.3 +fi if test -r GetClrmap.3; then rm -f Tk_FreeColormap.3 ln GetClrmap.3 Tk_FreeColormap.3 fi +if test -r SetOptions.3; then + rm -f Tk_FreeConfigOptions.3 + ln SetOptions.3 Tk_FreeConfigOptions.3 +fi if test -r GetCursor.3; then rm -f Tk_FreeCursor.3 ln GetCursor.3 Tk_FreeCursor.3 fi +if test -r GetCursor.3; then + rm -f Tk_FreeCursorFromObj.3 + ln GetCursor.3 Tk_FreeCursorFromObj.3 +fi if test -r GetFont.3; then rm -f Tk_FreeFont.3 ln GetFont.3 Tk_FreeFont.3 fi +if test -r GetFont.3; then + rm -f Tk_FreeFontFromObj.3 + ln GetFont.3 Tk_FreeFontFromObj.3 +fi if test -r GetGC.3; then rm -f Tk_FreeGC.3 ln GetGC.3 Tk_FreeGC.3 @@ -347,6 +399,10 @@ if test -r GetPixmap.3; then rm -f Tk_FreePixmap.3 ln GetPixmap.3 Tk_FreePixmap.3 fi +if test -r SetOptions.3; then + rm -f Tk_FreeSavedOptions.3 + ln SetOptions.3 Tk_FreeSavedOptions.3 +fi if test -r TextLayout.3; then rm -f Tk_FreeTextLayout.3 ln TextLayout.3 Tk_FreeTextLayout.3 @@ -363,6 +419,10 @@ if test -r 3DBorder.3; then rm -f Tk_Get3DBorder.3 ln 3DBorder.3 Tk_Get3DBorder.3 fi +if test -r 3DBorder.3; then + rm -f Tk_Get3DBorderFromObj.3 + ln 3DBorder.3 Tk_Get3DBorderFromObj.3 +fi if test -r BindTable.3; then rm -f Tk_GetAllBindings.3 ln BindTable.3 Tk_GetAllBindings.3 @@ -371,6 +431,10 @@ if test -r GetAnchor.3; then rm -f Tk_GetAnchor.3 ln GetAnchor.3 Tk_GetAnchor.3 fi +if test -r GetAnchor.3; then + rm -f Tk_GetAnchorFromObj.3 + ln GetAnchor.3 Tk_GetAnchorFromObj.3 +fi if test -r InternAtom.3; then rm -f Tk_GetAtomName.3 ln InternAtom.3 Tk_GetAtomName.3 @@ -387,6 +451,10 @@ if test -r GetBitmap.3; then rm -f Tk_GetBitmapFromData.3 ln GetBitmap.3 Tk_GetBitmapFromData.3 fi +if test -r GetBitmap.3; then + rm -f Tk_GetBitmapFromObj.3 + ln GetBitmap.3 Tk_GetBitmapFromObj.3 +fi if test -r GetCapStyl.3; then rm -f Tk_GetCapStyle.3 ln GetCapStyl.3 Tk_GetCapStyle.3 @@ -399,6 +467,10 @@ if test -r GetColor.3; then rm -f Tk_GetColorByValue.3 ln GetColor.3 Tk_GetColorByValue.3 fi +if test -r GetColor.3; then + rm -f Tk_GetColorFromObj.3 + ln GetColor.3 Tk_GetColorFromObj.3 +fi if test -r GetClrmap.3; then rm -f Tk_GetColormap.3 ln GetClrmap.3 Tk_GetColormap.3 @@ -411,10 +483,18 @@ if test -r GetCursor.3; then rm -f Tk_GetCursorFromData.3 ln GetCursor.3 Tk_GetCursorFromData.3 fi +if test -r GetCursor.3; then + rm -f Tk_GetCursorFromObj.3 + ln GetCursor.3 Tk_GetCursorFromObj.3 +fi if test -r GetFont.3; then rm -f Tk_GetFont.3 ln GetFont.3 Tk_GetFont.3 fi +if test -r GetFont.3; then + rm -f Tk_GetFontFromObj.3 + ln GetFont.3 Tk_GetFontFromObj.3 +fi if test -r GetGC.3; then rm -f Tk_GetGC.3 ln GetGC.3 Tk_GetGC.3 @@ -439,14 +519,34 @@ if test -r GetJustify.3; then rm -f Tk_GetJustify.3 ln GetJustify.3 Tk_GetJustify.3 fi +if test -r GetJustify.3; then + rm -f Tk_GetJustifyFromObj.3 + ln GetJustify.3 Tk_GetJustifyFromObj.3 +fi +if test -r GetPixels.3; then + rm -f Tk_GetMMFromObj.3 + ln GetPixels.3 Tk_GetMMFromObj.3 +fi if test -r GetOption.3; then rm -f Tk_GetOption.3 ln GetOption.3 Tk_GetOption.3 fi +if test -r SetOptions.3; then + rm -f Tk_GetOptionInfo.3 + ln SetOptions.3 Tk_GetOptionInfo.3 +fi +if test -r SetOptions.3; then + rm -f Tk_GetOptionValue.3 + ln SetOptions.3 Tk_GetOptionValue.3 +fi if test -r GetPixels.3; then rm -f Tk_GetPixels.3 ln GetPixels.3 Tk_GetPixels.3 fi +if test -r GetPixels.3; then + rm -f Tk_GetPixelsFromObj.3 + ln GetPixels.3 Tk_GetPixelsFromObj.3 +fi if test -r GetPixmap.3; then rm -f Tk_GetPixmap.3 ln GetPixmap.3 Tk_GetPixmap.3 @@ -455,6 +555,10 @@ if test -r GetRelief.3; then rm -f Tk_GetRelief.3 ln GetRelief.3 Tk_GetRelief.3 fi +if test -r GetRelief.3; then + rm -f Tk_GetReliefFromObj.3 + ln GetRelief.3 Tk_GetReliefFromObj.3 +fi if test -r GetRootCrd.3; then rm -f Tk_GetRootCoords.3 ln GetRootCrd.3 Tk_GetRootCoords.3 @@ -499,6 +603,10 @@ if test -r ImgChanged.3; then rm -f Tk_ImageChanged.3 ln ImgChanged.3 Tk_ImageChanged.3 fi +if test -r SetOptions.3; then + rm -f Tk_InitOptions.3 + ln SetOptions.3 Tk_InitOptions.3 +fi if test -r InternAtom.3; then rm -f Tk_InternAtom.3 ln InternAtom.3 Tk_InternAtom.3 @@ -611,9 +719,9 @@ if test -r Name.3; then rm -f Tk_NameToWindow.3 ln Name.3 Tk_NameToWindow.3 fi -if test -r ConfigWidg.3; then +if test -r SetOptions.3; then rm -f Tk_Offset.3 - ln ConfigWidg.3 Tk_Offset.3 + ln SetOptions.3 Tk_Offset.3 fi if test -r OwnSelect.3; then rm -f Tk_OwnSelection.3 @@ -691,6 +799,10 @@ if test -r Restack.3; then rm -f Tk_RestackWindow.3 ln Restack.3 Tk_RestackWindow.3 fi +if test -r SetOptions.3; then + rm -f Tk_RestoreSavedOptions.3 + ln SetOptions.3 Tk_RestoreSavedOptions.3 +fi if test -r RestrictEv.3; then rm -f Tk_RestrictEvents.3 ln RestrictEv.3 Tk_RestrictEvents.3 @@ -723,6 +835,10 @@ if test -r GeomReq.3; then rm -f Tk_SetInternalBorder.3 ln GeomReq.3 Tk_SetInternalBorder.3 fi +if test -r SetOptions.3; then + rm -f Tk_SetOptions.3 + ln SetOptions.3 Tk_SetOptions.3 +fi if test -r ConfigWind.3; then rm -f Tk_SetWindowBackground.3 ln ConfigWind.3 Tk_SetWindowBackground.3 diff --git a/unix/tkAppInit.c b/unix/tkAppInit.c index 5591d98..cf283fb 100644 --- a/unix/tkAppInit.c +++ b/unix/tkAppInit.c @@ -5,15 +5,16 @@ * use in wish and similar Tk-based applications. * * Copyright (c) 1993 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkAppInit.c,v 1.3 1999/02/04 20:57:18 stanton Exp $ + * RCS: @(#) $Id: tkAppInit.c,v 1.4 1999/04/16 01:51:45 stanton Exp $ */ #include "tk.h" +#include "locale.h" /* * The following variable is a special hack that is needed in order for @@ -24,6 +25,7 @@ extern int matherr(); int *tclDummyMathPtr = (int *) matherr; #ifdef TK_TEST +extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); extern int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TK_TEST */ @@ -64,7 +66,7 @@ main(argc, argv) * * Results: * Returns a standard Tcl completion code, and leaves an error - * message in interp->result if an error occurs. + * message in the interp's result if an error occurs. * * Side effects: * Depends on the startup script. @@ -84,6 +86,11 @@ Tcl_AppInit(interp) } Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); #ifdef TK_TEST + if (Tcltest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, + (Tcl_PackageInitProc *) NULL); if (Tktest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } diff --git a/unix/tkUnix.c b/unix/tkUnix.c index b50ee42..769a0b7 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnix.c,v 1.3 1999/03/10 07:04:45 stanton Exp $ + * RCS: @(#) $Id: tkUnix.c,v 1.4 1999/04/16 01:51:45 stanton Exp $ */ #include <tkInt.h> @@ -40,7 +40,8 @@ TkGetServerInfo(interp, tkwin) Tk_Window tkwin; /* Token for window; this selects a * particular display and server. */ { - char buffer[50], buffer2[50]; + 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))); @@ -77,7 +78,6 @@ TkGetDefaultScreenName(interp, screenName) } return screenName; } - /* *---------------------------------------------------------------------- diff --git a/unix/tkUnixButton.c b/unix/tkUnixButton.c index 29570d3..2d4cb25 100644 --- a/unix/tkUnixButton.c +++ b/unix/tkUnixButton.c @@ -4,12 +4,12 @@ * This file implements the Unix specific portion of the button * widgets. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixButton.c,v 1.2 1998/09/14 18:23:55 stanton Exp $ + * RCS: @(#) $Id: tkUnixButton.c,v 1.3 1999/04/16 01:51:45 stanton Exp $ */ #include "tkButton.h" @@ -85,12 +85,11 @@ TkpDisplayButton(clientData) int x = 0; /* Initialization only needed to stop * compiler warning. */ int y, relief; - register Tk_Window tkwin = butPtr->tkwin; + Tk_Window tkwin = butPtr->tkwin; int width, height; - int offset; /* 0 means this is a label widget. 1 means - * it is a flavor of button, so we offset - * the text to make the button appear to - * move up and down as the relief changes. */ + int offset; /* 1 means this is a button widget, so we + * offset the text to make the button appear + * to move up and down as the relief changes. */ butPtr->flags &= ~REDRAW_PENDING; if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { @@ -98,16 +97,16 @@ TkpDisplayButton(clientData) } border = butPtr->normalBorder; - if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) { + if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { gc = butPtr->disabledGC; - } else if ((butPtr->state == tkActiveUid) + } else if ((butPtr->state == STATE_ACTIVE) && !Tk_StrictMotif(butPtr->tkwin)) { gc = butPtr->activeTextGC; border = butPtr->activeBorder; } else { gc = butPtr->normalTextGC; } - if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid) + if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE) && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) { border = butPtr->selectBorder; } @@ -141,7 +140,7 @@ TkpDisplayButton(clientData) * Display image or bitmap or text for button. */ - if (butPtr->image != None) { + if (butPtr->image != NULL) { Tk_SizeOfImage(butPtr->image, &width, &height); imageOrBitmap: @@ -213,7 +212,7 @@ TkpDisplayButton(clientData) y -= dim/2; if (dim > 2*butPtr->borderWidth) { Tk_Draw3DRectangle(tkwin, pixmap, border, x, y, dim, dim, - butPtr->borderWidth, + butPtr->borderWidth, (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED); x += butPtr->borderWidth; @@ -222,7 +221,7 @@ TkpDisplayButton(clientData) if (butPtr->flags & SELECTED) { GC gc; - gc = Tk_3DBorderGC(tkwin,(butPtr->selectBorder != NULL) + gc = Tk_3DBorderGC(tkwin, (butPtr->selectBorder != NULL) ? butPtr->selectBorder : butPtr->normalBorder, TK_3D_FLAT_GC); XFillRectangle(butPtr->display, pixmap, gc, x, y, @@ -269,7 +268,7 @@ TkpDisplayButton(clientData) * must temporarily modify the GC. */ - if ((butPtr->state == tkDisabledUid) + if ((butPtr->state == STATE_DISABLED) && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) { if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn && (butPtr->selectBorder != NULL)) { @@ -297,7 +296,8 @@ TkpDisplayButton(clientData) if (relief != TK_RELIEF_FLAT) { int inset = butPtr->highlightWidth; - if (butPtr->defaultState == tkActiveUid) { + + if (butPtr->defaultState == DEFAULT_ACTIVE) { /* * Draw the default ring with 2 pixels of space between the * default ring and the button and the default ring and the @@ -319,15 +319,14 @@ TkpDisplayButton(clientData) Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT); inset += 2; - } else if (butPtr->defaultState == tkNormalUid) { + } else if (butPtr->defaultState == DEFAULT_NORMAL) { /* * Leave room for the default ring and write over any text or * background color. */ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, - 0, Tk_Width(tkwin), - Tk_Height(tkwin), 5, TK_RELIEF_FLAT); + 0, Tk_Width(tkwin), Tk_Height(tkwin), 5, TK_RELIEF_FLAT); inset += 5; } @@ -339,7 +338,7 @@ TkpDisplayButton(clientData) Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset, butPtr->borderWidth, relief); } - if (butPtr->highlightWidth != 0) { + if (butPtr->highlightWidth > 0) { GC gc; if (butPtr->flags & GOT_FOCUS) { @@ -354,7 +353,7 @@ TkpDisplayButton(clientData) * padding space left for a default ring. */ - if (butPtr->defaultState == tkNormalUid) { + if (butPtr->defaultState == DEFAULT_NORMAL) { TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap, 5); } else { @@ -398,16 +397,13 @@ TkpComputeButtonGeometry(butPtr) int width, height, avgWidth; Tk_FontMetrics fm; - if (butPtr->highlightWidth < 0) { - butPtr->highlightWidth = 0; - } butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth; /* * Leave room for the default ring if needed. */ - if (butPtr->defaultState != tkDisabledUid) { + if (butPtr->defaultState != DEFAULT_DISABLED) { butPtr->inset += 5; } butPtr->indicatorSpace = 0; @@ -433,9 +429,10 @@ TkpComputeButtonGeometry(butPtr) goto imageOrBitmap; } else { Tk_FreeTextLayout(butPtr->textLayout); + butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, - butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0, - &butPtr->textWidth, &butPtr->textHeight); + Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength, + butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); width = butPtr->textWidth; height = butPtr->textHeight; diff --git a/unix/tkUnixConfig.c b/unix/tkUnixConfig.c new file mode 100644 index 0000000..26f7dd1 --- /dev/null +++ b/unix/tkUnixConfig.c @@ -0,0 +1,45 @@ +/* + * tkUnixConfig.c -- + * + * This module implements the Unix system defaults for + * the configuration package. + * + * Copyright (c) 1997 by Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkUnixConfig.c,v 1.2 1999/04/16 01:51:45 stanton Exp $ + */ + +#include "tk.h" +#include "tkInt.h" + + +/* + *---------------------------------------------------------------------- + * + * TkpGetSystemDefault -- + * + * Given a dbName and className for a configuration option, + * return a string representation of the option. + * + * Results: + * Returns a Tk_Uid that is the string identifier that identifies + * this option. Returns NULL if there are no system defaults + * that match this pair. + * + * Side effects: + * None, once the package is initialized. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkpGetSystemDefault(tkwin, dbName, className) + Tk_Window tkwin; /* A window to use. */ + char *dbName; /* The option database name. */ + char *className; /* The name of the option class. */ +{ + return NULL; +} diff --git a/unix/tkUnixCursor.c b/unix/tkUnixCursor.c index 876ea2d..8755a3c 100644 --- a/unix/tkUnixCursor.c +++ b/unix/tkUnixCursor.c @@ -3,12 +3,12 @@ * * This file contains X specific cursor manipulation routines. * - * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixCursor.c,v 1.3 1998/09/14 18:23:55 stanton Exp $ + * RCS: @(#) $Id: tkUnixCursor.c,v 1.4 1999/04/16 01:51:45 stanton Exp $ */ #include "tkPort.h" @@ -218,7 +218,7 @@ TkGetCursorByName(interp, tkwin, string) if (dispPtr->cursorFont == None) { dispPtr->cursorFont = XLoadFont(display, CURSORFONT); if (dispPtr->cursorFont == None) { - interp->result = "couldn't load cursor font"; + Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC); goto cleanup; } } @@ -282,8 +282,9 @@ TkGetCursorByName(interp, tkwin, string) goto cleanup; } if ((maskWidth != width) && (maskHeight != height)) { - interp->result = - "source and mask bitmaps have different sizes"; + Tcl_SetResult(interp, + "source and mask bitmaps have different sizes", + TCL_STATIC); goto cleanup; } if (XParseColor(display, Tk_Colormap(tkwin), argv[2], @@ -323,6 +324,9 @@ TkGetCursorByName(interp, tkwin, string) badString: + if (argv) { + ckfree((char *) argv); + } Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", (char *) NULL); return NULL; @@ -382,7 +386,7 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot, /* *---------------------------------------------------------------------- * - * TkFreeCursor -- + * TkpFreeCursor -- * * This procedure is called to release a cursor allocated by * TkGetCursorByName. @@ -397,11 +401,10 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot, */ void -TkFreeCursor(cursorPtr) +TkpFreeCursor(cursorPtr) TkCursor *cursorPtr; { TkUnixCursor *unixCursorPtr = (TkUnixCursor *) cursorPtr; XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor); Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor); - ckfree((char *) unixCursorPtr); } diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 2967207..04225ad 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixDefault.h,v 1.2 1998/09/14 18:23:55 stanton Exp $ + * RCS: @(#) $Id: tkUnixDefault.h,v 1.3 1999/04/16 01:51:45 stanton Exp $ */ #ifndef _TKUNIXDEFAULT @@ -59,7 +59,8 @@ #define DEF_CHKRAD_FG DEF_BUTTON_FG #define DEF_BUTTON_FONT "Helvetica -12 bold" #define DEF_BUTTON_HEIGHT "0" -#define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG +#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR +#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO #define DEF_BUTTON_HIGHLIGHT BLACK #define DEF_LABEL_HIGHLIGHT_WIDTH "0" #define DEF_BUTTON_HIGHLIGHT_WIDTH "1" @@ -282,7 +283,8 @@ #define DEF_MENUBUTTON_FONT "Helvetica -12 bold" #define DEF_MENUBUTTON_FG BLACK #define DEF_MENUBUTTON_HEIGHT "0" -#define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG +#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR +#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 @@ -341,14 +343,15 @@ #define DEF_SCALE_FG_COLOR BLACK #define DEF_SCALE_FG_MONO BLACK #define DEF_SCALE_FROM "0" -#define DEF_SCALE_HIGHLIGHT_BG NORMAL_BG +#define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR +#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO #define DEF_SCALE_HIGHLIGHT BLACK #define DEF_SCALE_HIGHLIGHT_WIDTH "1" #define DEF_SCALE_LABEL "" #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 diff --git a/unix/tkUnixEmbed.c b/unix/tkUnixEmbed.c index 2a8bac0..e996a0b 100644 --- a/unix/tkUnixEmbed.c +++ b/unix/tkUnixEmbed.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixEmbed.c,v 1.2 1998/09/14 18:23:56 stanton Exp $ + * RCS: @(#) $Id: tkUnixEmbed.c,v 1.3 1999/04/16 01:51:46 stanton Exp $ */ #include "tkInt.h" @@ -46,9 +46,11 @@ typedef struct Container { * this process. */ } Container; -static Container *firstContainerPtr = NULL; - /* First in list of all containers +typedef struct ThreadSpecificData { + Container *firstContainerPtr; /* First in list of all containers * managed by this process. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Prototypes for static procedures defined in this file: @@ -83,7 +85,7 @@ static void EmbedWindowDeleted _ANSI_ARGS_((TkWindow *winPtr)); * Results: * The return value is normally TCL_OK. If an error occurs (such * as string not being a valid window spec), then the return value - * is TCL_ERROR and an error message is left in interp->result if + * is TCL_ERROR and an error message is left in the interp's result if * interp is non-NULL. * * Side effects: @@ -108,6 +110,8 @@ TkpUseWindow(interp, tkwin, string) Tk_ErrorHandler handler; Container *containerPtr; XWindowAttributes parentAtts; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->window != None) { panic("TkUseWindow: X window already assigned"); @@ -157,7 +161,7 @@ TkpUseWindow(interp, tkwin, string) * app. are in the same process. */ - for (containerPtr = firstContainerPtr; containerPtr != NULL; + for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->parent == parent) { winPtr->flags |= TK_BOTH_HALVES; @@ -171,8 +175,8 @@ TkpUseWindow(interp, tkwin, string) containerPtr->parentRoot = parentAtts.root; containerPtr->parentPtr = NULL; containerPtr->wrapper = None; - containerPtr->nextPtr = firstContainerPtr; - firstContainerPtr = containerPtr; + containerPtr->nextPtr = tsdPtr->firstContainerPtr; + tsdPtr->firstContainerPtr = containerPtr; } containerPtr->embeddedPtr = winPtr; winPtr->flags |= TK_EMBEDDED; @@ -204,6 +208,8 @@ TkpMakeWindow(winPtr, parent) * which the window is to be created. */ { Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->flags & TK_EMBEDDED) { /* @@ -213,7 +219,7 @@ TkpMakeWindow(winPtr, parent) * into a wrapper window later. */ - for (containerPtr = firstContainerPtr; ; + for (containerPtr = tsdPtr->firstContainerPtr; ; containerPtr = containerPtr->nextPtr) { if (containerPtr == NULL) { panic("TkMakeWindow couldn't find container for window"); @@ -259,6 +265,8 @@ TkpMakeContainer(tkwin) { TkWindow *winPtr = (TkWindow *) tkwin; Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Register the window as a container so that, for example, we can @@ -272,8 +280,8 @@ TkpMakeContainer(tkwin) containerPtr->parentPtr = winPtr; containerPtr->wrapper = None; containerPtr->embeddedPtr = NULL; - containerPtr->nextPtr = firstContainerPtr; - firstContainerPtr = containerPtr; + containerPtr->nextPtr = tsdPtr->firstContainerPtr; + tsdPtr->firstContainerPtr = containerPtr; winPtr->flags |= TK_CONTAINER; /* @@ -383,6 +391,8 @@ ContainerEventProc(clientData, eventPtr) TkWindow *winPtr = (TkWindow *) clientData; Container *containerPtr; Tk_ErrorHandler errHandler; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Ignore any X protocol errors that happen in this procedure @@ -397,7 +407,7 @@ ContainerEventProc(clientData, eventPtr) * Find the Container structure associated with the parent window. */ - for (containerPtr = firstContainerPtr; + for (containerPtr = tsdPtr->firstContainerPtr; containerPtr->parent != eventPtr->xmaprequest.parent; containerPtr = containerPtr->nextPtr) { if (containerPtr == NULL) { @@ -697,8 +707,11 @@ TkpGetOtherWindow(winPtr) * embedded window. */ { Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - for (containerPtr = firstContainerPtr; containerPtr != NULL; + for (containerPtr = tsdPtr->firstContainerPtr; + containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->embeddedPtr == winPtr) { return containerPtr->parentPtr; @@ -741,6 +754,8 @@ TkpRedirectKeyEvent(winPtr, eventPtr) { Container *containerPtr; Window saved; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * First, find the top-level window corresponding to winPtr. @@ -769,7 +784,7 @@ TkpRedirectKeyEvent(winPtr, eventPtr) * application. Send the event back to the container. */ - for (containerPtr = firstContainerPtr; + for (containerPtr = tsdPtr->firstContainerPtr; containerPtr->embeddedPtr != winPtr; containerPtr = containerPtr->nextPtr) { /* Empty loop body. */ @@ -811,12 +826,14 @@ TkpClaimFocus(topLevelPtr, force) { XEvent event; Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!(topLevelPtr->flags & TK_EMBEDDED)) { return; } - for (containerPtr = firstContainerPtr; + for (containerPtr = tsdPtr->firstContainerPtr; containerPtr->embeddedPtr != topLevelPtr; containerPtr = containerPtr->nextPtr) { /* Empty loop body. */ @@ -861,6 +878,8 @@ TkpTestembedCmd(clientData, interp, argc, argv) Container *containerPtr; Tcl_DString dString; char buffer[50]; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if ((argc > 1) && (strcmp(argv[1], "all") == 0)) { all = 1; @@ -868,7 +887,7 @@ TkpTestembedCmd(clientData, interp, argc, argv) all = 0; } Tcl_DStringInit(&dString); - for (containerPtr = firstContainerPtr; containerPtr != NULL; + for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { Tcl_DStringStartSublist(&dString); if (containerPtr->parent == None) { @@ -933,6 +952,8 @@ EmbedWindowDeleted(winPtr) * was deleted. */ { Container *containerPtr, *prevPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Find the Container structure for this window work. Delete the @@ -941,7 +962,7 @@ EmbedWindowDeleted(winPtr) */ prevPtr = NULL; - containerPtr = firstContainerPtr; + containerPtr = tsdPtr->firstContainerPtr; while (1) { if (containerPtr->embeddedPtr == winPtr) { containerPtr->wrapper = None; @@ -958,7 +979,7 @@ EmbedWindowDeleted(winPtr) if ((containerPtr->embeddedPtr == NULL) && (containerPtr->parentPtr == NULL)) { if (prevPtr == NULL) { - firstContainerPtr = containerPtr->nextPtr; + tsdPtr->firstContainerPtr = containerPtr->nextPtr; } else { prevPtr->nextPtr = containerPtr->nextPtr; } @@ -989,9 +1010,11 @@ TkUnixContainerId(winPtr) TkWindow *winPtr; /* Tk's structure for an embedded window. */ { Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - for (containerPtr = firstContainerPtr; containerPtr != NULL; - containerPtr = containerPtr->nextPtr) { + for (containerPtr = tsdPtr->firstContainerPtr; + containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->embeddedPtr == winPtr) { return containerPtr->parent; } diff --git a/unix/tkUnixEvent.c b/unix/tkUnixEvent.c index 12e58f4..4353154 100644 --- a/unix/tkUnixEvent.c +++ b/unix/tkUnixEvent.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixEvent.c,v 1.2 1998/09/14 18:23:56 stanton Exp $ + * RCS: @(#) $Id: tkUnixEvent.c,v 1.3 1999/04/16 01:51:46 stanton Exp $ */ #include "tkInt.h" @@ -17,10 +17,14 @@ #include <signal.h> /* - * The following static indicates whether this module has been initialized. + * The following static indicates whether this module has been initialized + * in the current thread. */ -static int initialized = 0; +typedef struct ThreadSpecificData { + int initialized; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Prototypes for procedures that are referenced only in this file: @@ -34,6 +38,8 @@ static void DisplayFileProc _ANSI_ARGS_((ClientData clientData, int flags)); static void DisplaySetupProc _ANSI_ARGS_((ClientData clientData, int flags)); +static void TransferXEventsToTcl _ANSI_ARGS_((Display *display)); + /* *---------------------------------------------------------------------- @@ -55,8 +61,11 @@ static void DisplaySetupProc _ANSI_ARGS_((ClientData clientData, void TkCreateXEventSource() { - if (!initialized) { - initialized = 1; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (!tsdPtr->initialized) { + tsdPtr->initialized = 1; Tcl_CreateEventSource(DisplaySetupProc, DisplayCheckProc, NULL); Tcl_CreateExitHandler(DisplayExitHandler, NULL); } @@ -83,8 +92,11 @@ static void DisplayExitHandler(clientData) ClientData clientData; /* Not used. */ { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL); - initialized = 0; + tsdPtr->initialized = 0; } /* @@ -185,7 +197,7 @@ DisplaySetupProc(clientData, flags) return; } - for (dispPtr = tkDisplayList; dispPtr != NULL; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { /* @@ -196,7 +208,7 @@ DisplaySetupProc(clientData, flags) */ XFlush(dispPtr->display); - if (XQLength(dispPtr->display) > 0) { + if (QLength(dispPtr->display) > 0) { Tcl_SetMaxBlockTime(&blockTime); } } @@ -205,6 +217,43 @@ DisplaySetupProc(clientData, flags) /* *---------------------------------------------------------------------- * + * TransferXEventsToTcl + * + * Transfer events from the X event queue to the Tk event queue. + * + * Results: + * None. + * + * Side effects: + * Moves queued X events onto the Tcl event queue. + * + *---------------------------------------------------------------------- + */ + + +static void +TransferXEventsToTcl(display) + Display *display; +{ + int numFound; + XEvent event; + + numFound = QLength(display); + + /* + * Transfer events from the X event queue to the Tk event queue. + */ + + while (numFound > 0) { + XNextEvent(display, &event); + Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); + numFound--; + } +} + +/* + *---------------------------------------------------------------------- + * * DisplayCheckProc -- * * This procedure checks for events sitting in the X event @@ -225,29 +274,19 @@ DisplayCheckProc(clientData, flags) int flags; { TkDisplay *dispPtr; - XEvent event; - int numFound; if (!(flags & TCL_WINDOW_EVENTS)) { return; } - for (dispPtr = tkDisplayList; dispPtr != NULL; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XFlush(dispPtr->display); - numFound = XQLength(dispPtr->display); - - /* - * Transfer events from the X event queue to the Tk event queue. - */ - - while (numFound > 0) { - XNextEvent(dispPtr->display, &event); - Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); - numFound--; - } + TransferXEventsToTcl(dispPtr->display); } } + + /* *---------------------------------------------------------------------- @@ -273,7 +312,6 @@ DisplayFileProc(clientData, flags) { TkDisplay *dispPtr = (TkDisplay *) clientData; Display *display = dispPtr->display; - XEvent event; int numFound; XFlush(display); @@ -311,15 +349,7 @@ DisplayFileProc(clientData, flags) (void) signal(SIGPIPE, oldHandler); } - /* - * Transfer events from the X event queue to the Tk event queue. - */ - - while (numFound > 0) { - XNextEvent(display, &event); - Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); - numFound--; - } + TransferXEventsToTcl(display); } /* @@ -394,10 +424,10 @@ TkUnixDoOneXEvent(timePtr) */ memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask)); - for (dispPtr = tkDisplayList; dispPtr != NULL; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XFlush(dispPtr->display); - if (XQLength(dispPtr->display) > 0) { + if (QLength(dispPtr->display) > 0) { blockTime.tv_sec = 0; blockTime.tv_usec = 0; } @@ -425,12 +455,12 @@ TkUnixDoOneXEvent(timePtr) * Process any new events on the display connections. */ - for (dispPtr = tkDisplayList; dispPtr != NULL; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { fd = ConnectionNumber(dispPtr->display); index = fd/(NBBY*sizeof(fd_mask)); bit = 1 << (fd%(NBBY*sizeof(fd_mask))); - if ((readMask[index] & bit) || (XQLength(dispPtr->display) > 0)) { + if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) { DisplayFileProc((ClientData)dispPtr, TCL_READABLE); } } @@ -480,19 +510,11 @@ void TkpSync(display) Display *display; /* Display to sync. */ { - int numFound = 0; - XEvent event; - XSync(display, False); /* * Transfer events from the X event queue to the Tk event queue. */ + TransferXEventsToTcl(display); - numFound = XQLength(display); - while (numFound > 0) { - XNextEvent(display, &event); - Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); - numFound--; - } } diff --git a/unix/tkUnixFocus.c b/unix/tkUnixFocus.c index afab537..17dbb04 100644 --- a/unix/tkUnixFocus.c +++ b/unix/tkUnixFocus.c @@ -9,14 +9,13 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixFocus.c,v 1.2 1998/09/14 18:23:56 stanton Exp $ + * RCS: @(#) $Id: tkUnixFocus.c,v 1.3 1999/04/16 01:51:46 stanton Exp $ */ #include "tkInt.h" #include "tkPort.h" #include "tkUnixInt.h" -extern int tclFocusDebug; /* *---------------------------------------------------------------------- diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index 638db14..43312e9 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -4,96 +4,388 @@ * Contains the Unix implementation of the platform-independant * font package interface. * - * Copyright (c) 1996 Sun Microsystems, Inc. + * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixFont.c,v 1.5 1999/03/10 07:04:45 stanton Exp $ + * RCS: @(#) $Id: tkUnixFont.c,v 1.6 1999/04/16 01:51:46 stanton Exp $ */ -#include "tkPort.h" -#include "tkInt.h" #include "tkUnixInt.h" - #include "tkFont.h" -#ifndef ABS -#define ABS(n) (((n) < 0) ? -(n) : (n)) -#endif +/* + * The preferred font encodings. + */ + +static CONST char *encodingList[] = { + "iso8859-1", "jis0208", "jis0212", NULL +}; + +/* + * The following structure represents a font family. It is assumed that + * all screen fonts constructed from the same "font family" share certain + * properties; all screen fonts with the same "font family" point to a + * shared instance of this structure. The most important shared property + * is the character existence metrics, used to determine if a screen font + * can display a given Unicode character. + * + * Under Unix, there are three attributes that uniquely identify a "font + * family": the foundry, face name, and charset. + */ + +#define FONTMAP_SHIFT 10 + +#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT)) +#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT) + +typedef struct FontFamily { + struct FontFamily *nextPtr; /* Next in list of all known font families. */ + int refCount; /* How many SubFonts are referring to this + * FontFamily. When the refCount drops to + * zero, this FontFamily may be freed. */ + /* + * Key. + */ + + Tk_Uid foundry; /* Foundry key for this FontFamily. */ + Tk_Uid faceName; /* Face name key for this FontFamily. */ + Tcl_Encoding encoding; /* Encoding key for this FontFamily. */ + + /* + * Derived properties. + */ + + int isTwoByteFont; /* 1 if this is a double-byte font, 0 + * otherwise. */ + char *fontMap[FONTMAP_PAGES]; + /* Two-level sparse table used to determine + * quickly if the specified character exists. + * As characters are encountered, more pages + * in this table are dynamically alloced. The + * contents of each page is a bitmask + * consisting of FONTMAP_BITSPERPAGE bits, + * representing whether this font can be used + * to display the given character at the + * corresponding bit position. The high bits + * of the character are used to pick which + * page of the table is used. */ +} FontFamily; + +/* + * The following structure encapsulates an individual screen font. A font + * object is made up of however many SubFonts are necessary to display a + * stream of multilingual characters. + */ + +typedef struct SubFont { + char **fontMap; /* Pointer to font map from the FontFamily, + * cached here to save a dereference. */ + XFontStruct *fontStructPtr; /* The specific screen font that will be + * used when displaying/measuring chars + * belonging to the FontFamily. */ + FontFamily *familyPtr; /* The FontFamily for this SubFont. */ +} SubFont; /* - * The following structure represents Unix's implementation of a font. + * The following structure represents Unix's implementation of a font + * object. */ +#define SUBFONT_SPACE 3 +#define BASE_CHARS 256 + typedef struct UnixFont { TkFont font; /* Stuff used by generic font package. Must * be first in structure. */ - Display *display; /* The display to which font belongs. */ - XFontStruct *fontStructPtr; /* X information about font. */ - char types[256]; /* Array giving types of all characters in - * the font, used when displaying control - * characters. See below for definition. */ - int widths[256]; /* Array giving widths of all possible - * characters in the font. */ + SubFont staticSubFonts[SUBFONT_SPACE]; + /* Builtin space for a limited number of + * SubFonts. */ + int numSubFonts; /* Length of following array. */ + SubFont *subFontArray; /* Array of SubFonts that have been loaded + * in order to draw/measure all the characters + * encountered by this font so far. All fonts + * start off with one SubFont initialized by + * AllocFont() from the original set of font + * attributes. Usually points to + * staticSubFonts, but may point to malloced + * space if there are lots of SubFonts. */ + SubFont controlSubFont; /* Font to use to display control-character + * expansions. */ + + Display *display; /* Display that owns font. */ + int pixelSize; /* Original pixel size used when font was + * constructed. */ + TkXLFDAttributes xa; /* Additional attributes that specify the + * preferred foundry and encoding to use when + * constructing additional SubFonts. */ + int widths[BASE_CHARS]; /* Widths of first 256 chars in the base + * font, for handling common case. */ int underlinePos; /* Offset from baseline to origin of - * underline bar (used for simulating a native - * underlined font). */ + * underline bar (used when drawing underlined + * font) (pixels). */ int barHeight; /* Height of underline or overstrike bar - * (used for simulating a native underlined or - * strikeout font). */ + * (used when drawing underlined or strikeout + * font) (pixels). */ } UnixFont; /* - * Possible values for entries in the "types" field in a UnixFont structure, - * which classifies the types of all characters in the given font. This - * information is used when measuring and displaying characters. - * - * NORMAL: Standard character. - * REPLACE: This character doesn't print: instead of - * displaying character, display a replacement - * sequence like "\n" (for those characters where - * ANSI C defines such a sequence) or a sequence - * of the form "\xdd" where dd is the hex equivalent - * of the character. - * SKIP: Don't display anything for this character. This - * is only used where the font doesn't contain - * all the characters needed to generate - * replacement sequences. - */ - -#define NORMAL 0 -#define REPLACE 1 -#define SKIP 2 + * The following structure and definition is used to keep track of the + * alternative names for various encodings. Asking for an encoding that + * matches one of the alias patterns will result in actually getting the + * encoding by its real name. + */ + +typedef struct EncodingAlias { + 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 is acceptable to Tcl_StringMatch. */ +} EncodingAlias; /* - * Characters used when displaying control sequences. + * Just some utility structures used for passing around values in helper + * procedures. */ + +typedef struct FontAttributes { + TkFontAttributes fa; + TkXLFDAttributes xa; +} FontAttributes; + + +typedef struct ThreadSpecificData { + FontFamily *fontFamilyList; /* The list of font families that are + * currently loaded. As screen fonts + * are loaded, this list grows to hold + * information about what characters + * exist in each font family. */ + FontFamily controlFamily; /* FontFamily used to handle control + * character expansions. The encoding + * of this FontFamily converts UTF-8 to + * backslashed escape sequences. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; -static char hexChars[] = "0123456789abcdefxtnvr\\"; +/* + * The set of builtin encoding alises to convert the XLFD names for the + * encodings into the names expected by the Tcl encoding package. + */ + +static EncodingAlias encodingAliases[] = { + {"gb2312", "gb2312*"}, + {"big5", "big5*"}, + {"cns11643-1", "cns11643*-1"}, + {"cns11643-1", "cns11643*.1-0"}, + {"cns11643-2", "cns11643*-2"}, + {"cns11643-2", "cns11643*.2-0"}, + {"jis0201", "jisx0202*"}, + {"jis0208", "jisc6226*"}, + {"jis0208", "jisx0208*"}, + {"jis0212", "jisx0212*"}, + {"tis620", "tis620*"}, + {"ksc5601", "ksc5601*"}, + {"dingbats", "*dingbats"}, + {NULL, NULL} +}; /* - * The following table maps some control characters to sequences like '\n' - * rather than '\x10'. A zero entry in the table means no such mapping - * exists, and the table only maps characters less than 0x10. + * Procedures used only in this file. */ -static char mapChars[] = { - 0, 0, 0, 0, 0, 0, 0, - 'a', 'b', 't', 'n', 'v', 'f', 'r', - 0 -}; +static FontFamily * AllocFontFamily _ANSI_ARGS_((Display *display, + XFontStruct *fontStructPtr, int base)); +static SubFont * CanUseFallback _ANSI_ARGS_((UnixFont *fontPtr, + char *fallbackName, int ch)); +static SubFont * CanUseFallbackWithAliases _ANSI_ARGS_(( + UnixFont *fontPtr, char *fallbackName, + int ch, Tcl_DString *nameTriedPtr)); +static int ControlUtfProc _ANSI_ARGS_((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 _ANSI_ARGS_((Tk_Window tkwin, + CONST TkFontAttributes *faPtr, + CONST TkXLFDAttributes *xaPtr)); +static SubFont * FindSubFontForChar _ANSI_ARGS_((UnixFont *fontPtr, + int ch)); +static void FontMapInsert _ANSI_ARGS_((SubFont *subFontPtr, + int ch)); +static void FontMapLoadPage _ANSI_ARGS_((SubFont *subFontPtr, + int row)); +static int FontMapLookup _ANSI_ARGS_((SubFont *subFontPtr, + int ch)); +static void FreeFontFamily _ANSI_ARGS_((FontFamily *afPtr)); +static CONST char * GetEncodingAlias _ANSI_ARGS_((CONST char *name)); +static int GetFontAttributes _ANSI_ARGS_((Display *display, + XFontStruct *fontStructPtr, FontAttributes *faPtr)); +static XFontStruct * GetScreenFont _ANSI_ARGS_((Display *display, + FontAttributes *wantPtr, char **nameList, + int bestIdx[], unsigned int bestScore[])); +static XFontStruct * GetSystemFont _ANSI_ARGS_((Display *display)); +static int IdentifySymbolEncodings _ANSI_ARGS_(( + FontAttributes *faPtr)); +static void InitFont _ANSI_ARGS_((Tk_Window tkwin, + XFontStruct *fontStructPtr, UnixFont *fontPtr)); +static void InitSubFont _ANSI_ARGS_((Display *display, + XFontStruct *fontStructPtr, int base, + SubFont *subFontPtr)); +static char ** ListFonts _ANSI_ARGS_((Display *display, + CONST char *faceName, int *numNamesPtr)); +static char ** ListFontOrAlias _ANSI_ARGS_((Display *display, + CONST char *faceName, int *numNamesPtr)); +static unsigned int RankAttributes _ANSI_ARGS_((FontAttributes *wantPtr, + FontAttributes *gotPtr)); +static void ReleaseFont _ANSI_ARGS_((UnixFont *fontPtr)); +static void ReleaseSubFont _ANSI_ARGS_((Display *display, + SubFont *subFontPtr)); +static int SeenName _ANSI_ARGS_((CONST char *name, + Tcl_DString *dsPtr)); + +/* + *------------------------------------------------------------------------- + * + * TkpFontPkgInit -- + * + * This procedure is called when an application is created. It + * initializes all the structures that are used by the + * platform-dependent code on a per application basis. + * + * Results: + * None. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ -static UnixFont * AllocFont _ANSI_ARGS_((TkFont *tkFontPtr, - Tk_Window tkwin, XFontStruct *fontStructPtr, - CONST char *fontName)); -static void DrawChars _ANSI_ARGS_((Display *display, - Drawable drawable, GC gc, UnixFont *fontPtr, - CONST char *source, int numChars, int x, - int y)); -static int GetControlCharSubst _ANSI_ARGS_((int c, char buf[4])); +void +TkpFontPkgInit(mainPtr) + TkMainInfo *mainPtr; /* The application being created. */ +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_EncodingType type; + SubFont dummy; + int i; + + if (tsdPtr->controlFamily.encoding == NULL) { + type.encodingName = "X11ControlChars"; + type.toUtfProc = ControlUtfProc; + type.fromUtfProc = ControlUtfProc; + type.freeProc = NULL; + type.clientData = NULL; + type.nullSize = 0; + + tsdPtr->controlFamily.refCount = 2; + tsdPtr->controlFamily.encoding = Tcl_CreateEncoding(&type); + tsdPtr->controlFamily.isTwoByteFont = 0; + + dummy.familyPtr = &tsdPtr->controlFamily; + dummy.fontMap = tsdPtr->controlFamily.fontMap; + for (i = 0x00; i < 0x20; i++) { + FontMapInsert(&dummy, i); + FontMapInsert(&dummy, i + 0x80); + } + } +} + +/* + *------------------------------------------------------------------------- + * + * ControlUtfProc -- + * + * Convert from UTF-8 into the ASCII expansion of a control + * character. + * + * Results: + * Returns TCL_OK if conversion was successful. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ +static int +ControlUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, + srcReadPtr, dstWrotePtr, dstCharsPtr) + ClientData clientData; /* Not used. */ + 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 information used during a piecewise + * conversion. Contents of statePtr are + * initialized and/or reset by conversion + * routine under control of flags argument. */ + char *dst; /* Output buffer in which converted string + * is stored. */ + int dstLen; /* The maximum length of output buffer in + * bytes. */ + int *srcReadPtr; /* Filled with the number of bytes from the + * source string that were converted. This + * may be less than the original source length + * if there was a problem converting some + * source characters. */ + int *dstWrotePtr; /* Filled with the number of bytes that were + * stored in the output buffer as a result of + * the conversion. */ + int *dstCharsPtr; /* Filled with the number of characters that + * correspond to the bytes stored in the + * output buffer. */ +{ + CONST char *srcStart, *srcEnd; + char *dstStart, *dstEnd; + Tcl_UniChar ch; + int result; + static char hexChars[] = "0123456789abcdef"; + static char mapChars[] = { + 0, 0, 0, 0, 0, 0, 0, + 'a', 'b', 't', 'n', 'v', 'f', 'r' + }; + + result = TCL_OK; + + srcStart = src; + srcEnd = src + srcLen; + + dstStart = dst; + dstEnd = dst + dstLen - 6; + + for ( ; src < srcEnd; ) { + if (dst > dstEnd) { + result = TCL_CONVERT_NOSPACE; + break; + } + src += Tcl_UtfToUniChar(src, &ch); + dst[0] = '\\'; + if ((ch < sizeof(mapChars)) && (mapChars[ch] != 0)) { + dst[1] = mapChars[ch]; + dst += 2; + } else if (ch < 256) { + dst[1] = 'x'; + dst[2] = hexChars[(ch >> 4) & 0xf]; + dst[3] = hexChars[ch & 0xf]; + dst += 4; + } else { + dst[1] = 'u'; + dst[2] = hexChars[(ch >> 12) & 0xf]; + dst[3] = hexChars[(ch >> 8) & 0xf]; + dst[4] = hexChars[(ch >> 4) & 0xf]; + dst[5] = hexChars[ch & 0xf]; + dst += 6; + } + } + *srcReadPtr = src - srcEnd; + *dstWrotePtr = dst - dstStart; + *dstCharsPtr = dst - dstStart; + return result; +} /* *--------------------------------------------------------------------------- @@ -116,18 +408,20 @@ static int GetControlCharSubst _ANSI_ARGS_((int c, char buf[4])); * the contents of the generic TkFont before calling TkpDeleteFont(). * * Side effects: - * None. + * Memory allocated. * *--------------------------------------------------------------------------- */ - + TkFont * TkpGetNativeFont(tkwin, name) Tk_Window tkwin; /* For display where font will be used. */ CONST char *name; /* Platform-specific font name. */ { + UnixFont *fontPtr; XFontStruct *fontStructPtr; - char *p; + FontAttributes fa; + CONST char *p; int hasSpace, dashes, hasWild; /* @@ -141,7 +435,7 @@ TkpGetNativeFont(tkwin, name) */ hasSpace = dashes = hasWild = 0; - for (p = (char *) name; *p != '\0'; p++) { + for (p = name; *p != '\0'; p++) { if (*p == ' ') { if (p[1] == '-') { return NULL; @@ -159,10 +453,36 @@ TkpGetNativeFont(tkwin, name) fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name); if (fontStructPtr == NULL) { - return NULL; + /* + * Handle all names that look like XLFDs here. Otherwise, when + * TkpGetFontFromAttributes is called from generic code, any + * foundry or encoding information specified in the XLFD will have + * been parsed out and lost. But make sure we don't have an + * "-option value" string since TkFontParseXLFD would return a + * false success when attempting to parse it. + */ + + if (name[0] == '-') { + if (name[1] != '*') { + char *dash; + + dash = strchr(name + 1, '-'); + if ((dash == NULL) || (isspace(UCHAR(dash[-1])))) { + return NULL; + } + } + } else if (name[0] != '*') { + return NULL; + } + if (TkFontParseXLFD(name, &fa.fa, &fa.xa) != TCL_OK) { + return NULL; + } + fontStructPtr = CreateClosestFont(tkwin, &fa.fa, &fa.xa); } + fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont)); + InitFont(tkwin, fontStructPtr, fontPtr); - return (TkFont *) AllocFont(NULL, tkwin, fontStructPtr, name); + return (TkFont *) fontPtr; } /* @@ -189,7 +509,7 @@ TkpGetNativeFont(tkwin, name) * the contents of the generic TkFont before calling TkpDeleteFont(). * * Side effects: - * None. + * Memory allocated. * *--------------------------------------------------------------------------- */ @@ -202,249 +522,29 @@ TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr) * will be released. If NULL, a new TkFont * structure is allocated. */ Tk_Window tkwin; /* For display where font will be used. */ - CONST TkFontAttributes *faPtr; /* Set of attributes to match. */ + CONST TkFontAttributes *faPtr; + /* Set of attributes to match. */ { - int numNames, score, i, scaleable, pixelsize, xaPixelsize; - int bestIdx, bestScore, bestScaleableIdx, bestScaleableScore; - TkXLFDAttributes xa; - char buf[256]; UnixFont *fontPtr; - char **nameList; + TkXLFDAttributes xa; XFontStruct *fontStructPtr; - CONST char *fmt, *family; - double d; - - family = faPtr->family; - if (family == NULL) { - family = "*"; - } - - pixelsize = -faPtr->pointsize; - if (pixelsize < 0) { - d = -pixelsize * 25.4 / 72; - d *= WidthOfScreen(Tk_Screen(tkwin)); - d /= WidthMMOfScreen(Tk_Screen(tkwin)); - d += 0.5; - pixelsize = (int) d; - } - - /* - * Replace the standard Windows and Mac family names with the names that - * X likes. - */ - - if ((strcasecmp("Times New Roman", family) == 0) - || (strcasecmp("New York", family) == 0)) { - family = "Times"; - } else if ((strcasecmp("Courier New", family) == 0) - || (strcasecmp("Monaco", family) == 0)) { - family = "Courier"; - } else if ((strcasecmp("Arial", family) == 0) - || (strcasecmp("Geneva", family) == 0)) { - family = "Helvetica"; - } - - /* - * First try for the Q&D exact match. - */ - -#if 0 - sprintf(buf, "-*-%.200s-%s-%c-normal-*-*-%d-*-*-*-*-iso8859-1", family, - ((faPtr->weight > TK_FW_NORMAL) ? "bold" : "medium"), - ((faPtr->slant == TK_FS_ROMAN) ? 'r' : - (faPtr->slant == TK_FS_ITALIC) ? 'i' : 'o'), - faPtr->pointsize * 10); - fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf); -#else - fontStructPtr = NULL; -#endif - - if (fontStructPtr != NULL) { - goto end; - } - /* - * Couldn't find exact match. Now fall back to other available - * physical fonts. - */ - - fmt = "-*-%.240s-*-*-*-*-*-*-*-*-*-*-*-*"; - sprintf(buf, fmt, family); - nameList = XListFonts(Tk_Display(tkwin), buf, 10000, &numNames); - if (numNames == 0) { - /* - * Try getting some system font. - */ - - sprintf(buf, fmt, "fixed"); - nameList = XListFonts(Tk_Display(tkwin), buf, 10000, &numNames); - if (numNames == 0) { - getsystem: - fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), "fixed"); - if (fontStructPtr == NULL) { - fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), "*"); - if (fontStructPtr == NULL) { - panic("TkpGetFontFromAttributes: cannot get any font"); - } - } - goto end; - } - } - - /* - * Inspect each of the XLFDs and pick the one that most closely - * matches the desired attributes. - */ - - bestIdx = 0; - bestScore = INT_MAX; - bestScaleableIdx = 0; - bestScaleableScore = INT_MAX; - - for (i = 0; i < numNames; i++) { - score = 0; - scaleable = 0; - if (TkParseXLFD(nameList[i], &xa) != TCL_OK) { - continue; - } - xaPixelsize = -xa.fa.pointsize; - - /* - * Since most people used to use -adobe-* in their XLFDs, - * preserve the preference for "adobe" foundry. Otherwise - * some applications looks may change slightly if another foundry - * is chosen. - */ - - if (strcasecmp(xa.foundry, "adobe") != 0) { - score += 3000; - } - if (xa.fa.pointsize == 0) { - /* - * A scaleable font is almost always acceptable, but the - * corresponding bitmapped font would be better. - */ - - score += 10; - scaleable = 1; - } else { - /* - * A font that is too small is better than one that is too - * big. - */ - - if (xaPixelsize > pixelsize) { - score += (xaPixelsize - pixelsize) * 120; - } else { - score += (pixelsize - xaPixelsize) * 100; - } - } - - score += ABS(xa.fa.weight - faPtr->weight) * 30; - score += ABS(xa.fa.slant - faPtr->slant) * 25; - if (xa.slant == TK_FS_OBLIQUE) { - /* - * Italic fonts are preferred over oblique. */ - - score += 4; - } - - if (xa.setwidth != TK_SW_NORMAL) { - /* - * The normal setwidth is highly preferred. - */ - score += 2000; - } - if (xa.charset == TK_CS_OTHER) { - /* - * The standard character set is highly preferred over - * foreign languages charsets (because we don't support - * other languages yet). - */ - score += 11000; - } - if ((xa.charset == TK_CS_NORMAL) && (xa.encoding != 1)) { - /* - * The '1' encoding for the characters above 0x7f is highly - * preferred over the other encodings. - */ - score += 8000; - } - - if (scaleable) { - if (score < bestScaleableScore) { - bestScaleableIdx = i; - bestScaleableScore = score; - } - } else { - if (score < bestScore) { - bestIdx = i; - bestScore = score; - } - } - if (score == 0) { - break; - } - } - /* - * Now we know which is the closest matching scaleable font and the - * closest matching bitmapped font. If the scaleable font was a - * better match, try getting the scaleable font; however, if the - * scalable font was not actually available in the desired - * pointsize, fall back to the closest bitmapped font. - */ + TkInitXLFDAttributes(&xa); + fontStructPtr = CreateClosestFont(tkwin, faPtr, &xa); - fontStructPtr = NULL; - if (bestScaleableScore < bestScore) { - char *str, *rest; - - /* - * Fill in the desired pointsize info for this font. - */ - - tryscale: - str = nameList[bestScaleableIdx]; - for (i = 0; i < XLFD_PIXEL_SIZE - 1; i++) { - str = strchr(str + 1, '-'); - } - rest = str; - for (i = XLFD_PIXEL_SIZE - 1; i < XLFD_REGISTRY; i++) { - rest = strchr(rest + 1, '-'); - } - *str = '\0'; - sprintf(buf, "%.240s-*-%d-*-*-*-*-*%s", nameList[bestScaleableIdx], - pixelsize, rest); - *str = '-'; - fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf); - bestScaleableScore = INT_MAX; - } - if (fontStructPtr == NULL) { - strcpy(buf, nameList[bestIdx]); - fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf); - if (fontStructPtr == NULL) { - /* - * This shouldn't happen because the font name is one of the - * names that X gave us to use, but it does anyhow. - */ - - if (bestScaleableScore < INT_MAX) { - goto tryscale; - } else { - XFreeFontNames(nameList); - goto getsystem; - } - } + fontPtr = (UnixFont *) tkFontPtr; + if (fontPtr == NULL) { + fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont)); + } else { + ReleaseFont(fontPtr); } - XFreeFontNames(nameList); + InitFont(tkwin, fontStructPtr, fontPtr); - end: - fontPtr = AllocFont(tkFontPtr, tkwin, fontStructPtr, buf); - fontPtr->font.fa.underline = faPtr->underline; + fontPtr->font.fa.underline = faPtr->underline; fontPtr->font.fa.overstrike = faPtr->overstrike; return (TkFont *) fontPtr; } - /* *--------------------------------------------------------------------------- @@ -472,9 +572,7 @@ TkpDeleteFont(tkFontPtr) UnixFont *fontPtr; fontPtr = (UnixFont *) tkFontPtr; - - XFreeFont(fontPtr->display, fontPtr->fontStructPtr); - ckfree((char *) fontPtr); + ReleaseFont(fontPtr); } /* @@ -486,7 +584,7 @@ TkpDeleteFont(tkFontPtr) * on the display of the given window. * * Results: - * interp->result is modified to hold a list of all the available + * Modifies interp's result object to hold a list of all the available * font families. * * Side effects: @@ -494,52 +592,80 @@ TkpDeleteFont(tkFontPtr) * *--------------------------------------------------------------------------- */ - + void TkpGetFontFamilies(interp, tkwin) - Tcl_Interp *interp; - Tk_Window tkwin; + Tcl_Interp *interp; /* Interp to hold result. */ + Tk_Window tkwin; /* For display to query. */ { int i, new, numNames; - char *family, *end, *p; + char *family; Tcl_HashTable familyTable; Tcl_HashEntry *hPtr; Tcl_HashSearch search; char **nameList; + Tcl_Obj *resultPtr, *strPtr; - Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS); + resultPtr = Tcl_GetObjResult(interp); - nameList = XListFonts(Tk_Display(tkwin), "*", 10000, &numNames); + Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS); + nameList = ListFonts(Tk_Display(tkwin), "*", &numNames); for (i = 0; i < numNames; i++) { - if (nameList[i][0] != '-') { - continue; - } - family = strchr(nameList[i] + 1, '-'); - if (family == NULL) { - continue; - } - family++; - end = strchr(family, '-'); - if (end == NULL) { - continue; - } - *end = '\0'; - for (p = family; *p != '\0'; p++) { - if (isupper(UCHAR(*p))) { - *p = tolower(UCHAR(*p)); - } - } + family = strchr(nameList[i] + 1, '-') + 1; + strchr(family, '-')[0] = '\0'; Tcl_CreateHashEntry(&familyTable, family, &new); } + XFreeFontNames(nameList); hPtr = Tcl_FirstHashEntry(&familyTable, &search); while (hPtr != NULL) { - Tcl_AppendElement(interp, Tcl_GetHashKey(&familyTable, hPtr)); + strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&familyTable); - XFreeFontNames(nameList); +} + +/* + *------------------------------------------------------------------------- + * + * TkpGetSubFonts -- + * + * A function used by the testing package for querying the actual + * screen fonts that make up a font object. + * + * Results: + * Modifies interp's result object to hold a list containing the + * names of the screen fonts that make up the given font object. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +void +TkpGetSubFonts(interp, tkfont) + Tcl_Interp *interp; + Tk_Font tkfont; +{ + int i; + Tcl_Obj *objv[3]; + Tcl_Obj *resultPtr, *listPtr; + UnixFont *fontPtr; + FontFamily *familyPtr; + + resultPtr = Tcl_GetObjResult(interp); + fontPtr = (UnixFont *) tkfont; + for (i = 0; i < fontPtr->numSubFonts; i++) { + familyPtr = fontPtr->subFontArray[i].familyPtr; + objv[0] = Tcl_NewStringObj(familyPtr->faceName, -1); + objv[1] = Tcl_NewStringObj(familyPtr->foundry, -1); + objv[2] = Tcl_NewStringObj(Tcl_GetEncodingName(familyPtr->encoding), -1); + listPtr = Tcl_NewListObj(3, objv); + Tcl_ListObjAppendElement(NULL, resultPtr, listPtr); + } } /* @@ -553,7 +679,7 @@ TkpGetFontFamilies(interp, tkwin) * the characters. * * Results: - * The return value is the number of characters from source that + * The return value is the number of bytes from source that * fit into the span that extends from 0 to maxLength. *lengthPtr is * filled with the x-coordinate of the right edge of the last * character that did fit. @@ -563,18 +689,19 @@ TkpGetFontFamilies(interp, tkwin) * *--------------------------------------------------------------------------- */ + int -Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr) +Tk_MeasureChars(tkfont, source, numBytes, maxLength, flags, lengthPtr) Tk_Font tkfont; /* Font in which characters will be drawn. */ - CONST char *source; /* Characters to be displayed. Need not be + CONST char *source; /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ - int numChars; /* Maximum number of characters to consider + int numBytes; /* Maximum number of bytes to consider * from source string. */ - int maxLength; /* If > 0, maxLength specifies the longest - * permissible line length; don't consider any - * character that would cross this - * x-position. If <= 0, then line length is - * unbounded and the flags argument is + int maxLength; /* If >= 0, maxLength specifies the longest + * permissible line length in pixels; don't + * consider any character that would cross + * this x-position. If < 0, then line length + * is unbounded and the flags argument is * ignored. */ int flags; /* Various flag bits OR-ed together: * TK_PARTIAL_OK means include the last char @@ -587,99 +714,179 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr) * terminating character. */ { UnixFont *fontPtr; - CONST char *p; /* Current character. */ - CONST char *term; /* Pointer to most recent character that - * may legally be a terminating character. */ - int termX; /* X-position just after term. */ - int curX; /* X-position corresponding to p. */ - int newX; /* X-position corresponding to p+1. */ - int c, sawNonSpace; + SubFont *lastSubFontPtr; + int curX, curByte; - fontPtr = (UnixFont *) tkfont; + /* + * Unix does not use kerning or fractional character widths when + * displaying text on the screen. So that means we can safely measure + * individual characters or spans of characters and add up the widths + * w/o any "off-by-one-pixel" errors. + */ - if (numChars == 0) { - *lengthPtr = 0; - return 0; - } + fontPtr = (UnixFont *) tkfont; - if (maxLength <= 0) { - maxLength = INT_MAX; - } + lastSubFontPtr = &fontPtr->subFontArray[0]; - newX = curX = termX = 0; - p = term = source; - sawNonSpace = !isspace(UCHAR(*p)); + if (numBytes == 0) { + curX = 0; + curByte = 0; + } else if (maxLength < 0) { + CONST char *p, *end, *next; + Tcl_UniChar ch; + SubFont *thisSubFontPtr; + FontFamily *familyPtr; + Tcl_DString runString; - /* - * Scan the input string one character at a time, calculating width. - */ + /* + * A three step process: + * 1. Find a contiguous range of characters that can all be + * represented by a single screen font. + * 2. Convert those chars to the encoding of that font. + * 3. Measure converted chars. + */ - for (c = UCHAR(*p); ; ) { - newX += fontPtr->widths[c]; - if (newX > maxLength) { - break; + curX = 0; + end = source + numBytes; + for (p = source; p < end; ) { + next = p + Tcl_UtfToUniChar(p, &ch); + thisSubFontPtr = FindSubFontForChar(fontPtr, ch); + if (thisSubFontPtr != lastSubFontPtr) { + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, + p - source, &runString); + if (familyPtr->isTwoByteFont) { + curX += XTextWidth16(lastSubFontPtr->fontStructPtr, + (XChar2b *) Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) / 2); + } else { + curX += XTextWidth(lastSubFontPtr->fontStructPtr, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString)); + } + Tcl_DStringFree(&runString); + lastSubFontPtr = thisSubFontPtr; + source = p; + } + p = next; } - curX = newX; - numChars--; - p++; - if (numChars == 0) { - term = p; - termX = curX; - break; + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, + &runString); + if (familyPtr->isTwoByteFont) { + curX += XTextWidth16(lastSubFontPtr->fontStructPtr, + (XChar2b *) Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> 1); + } else { + curX += XTextWidth(lastSubFontPtr->fontStructPtr, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString)); } + Tcl_DStringFree(&runString); + curByte = numBytes; + } else { + CONST char *p, *end, *next, *term; + int newX, termX, sawNonSpace, dstWrote; + Tcl_UniChar ch; + FontFamily *familyPtr; + char buf[16]; + + /* + * How many chars will fit in the space allotted? + * This first version may be inefficient because it measures + * every character individually. + */ - c = UCHAR(*p); - if (isspace(c)) { - if (sawNonSpace) { - term = p; + next = source + Tcl_UtfToUniChar(source, &ch); + newX = curX = termX = 0; + + term = source; + end = source + numBytes; + + sawNonSpace = (ch > 255) || !isspace(ch); + familyPtr = lastSubFontPtr->familyPtr; + for (p = source; ; ) { + if ((ch < BASE_CHARS) && (fontPtr->widths[ch] != 0)) { + newX += fontPtr->widths[ch]; + } else { + lastSubFontPtr = FindSubFontForChar(fontPtr, ch); + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p, + 0, NULL, buf, sizeof(buf), NULL, &dstWrote, NULL); + if (familyPtr->isTwoByteFont) { + newX += XTextWidth16(lastSubFontPtr->fontStructPtr, + (XChar2b *) buf, dstWrote >> 1); + } else { + newX += XTextWidth(lastSubFontPtr->fontStructPtr, buf, + dstWrote); + } + } + if (newX > maxLength) { + break; + } + curX = newX; + p = next; + if (p >= end) { + term = end; termX = curX; - sawNonSpace = 0; + break; } - } else { - sawNonSpace = 1; - } - } - /* - * P points to the first character that doesn't fit in the desired - * span. Use the flags to figure out what to return. - */ + next += Tcl_UtfToUniChar(next, &ch); + if ((ch < 256) && isspace(ch)) { + if (sawNonSpace) { + term = p; + termX = curX; + sawNonSpace = 0; + } + } else { + sawNonSpace = 1; + } + } - if ((flags & TK_PARTIAL_OK) && (numChars > 0) && (curX < maxLength)) { /* - * Include the first character that didn't quite fit in the desired - * span. The width returned will include the width of that extra - * character. + * P points to the first character that doesn't fit in the desired + * span. Use the flags to figure out what to return. */ - numChars--; - curX = newX; - p++; - } - if ((flags & TK_AT_LEAST_ONE) && (term == source) && (numChars > 0)) { - term = p; - termX = curX; - if (term == source) { - term++; - termX = newX; + if ((flags & TK_PARTIAL_OK) && (p < end) && (curX < maxLength)) { + /* + * Include the first character that didn't quite fit in the desired + * span. The width returned will include the width of that extra + * character. + */ + + curX = newX; + p += Tcl_UtfToUniChar(p, &ch); + } + if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) { + term = p; + termX = curX; + if (term == source) { + term += Tcl_UtfToUniChar(term, &ch); + termX = newX; + } + } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) { + term = p; + termX = curX; } - } else if ((numChars == 0) || !(flags & TK_WHOLE_WORDS)) { - term = p; - termX = curX; + + curX = termX; + curByte = term - source; } - *lengthPtr = termX; - return term-source; + *lengthPtr = curX; + return curByte; } /* *--------------------------------------------------------------------------- * - * Tk_DrawChars, DrawChars -- + * Tk_DrawChars -- * * Draw a string of characters on the screen. Tk_DrawChars() - * expands control characters that occur in the string to \X or - * \xXX sequences. DrawChars() just draws the strings. + * expands control characters that occur in the string to + * \xNN sequences. * * Results: * None. @@ -691,255 +898,359 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr) */ void -Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) +Tk_DrawChars(display, drawable, gc, tkfont, source, numBytes, x, y) 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; /* Characters 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 * is passed to this function. If they are * not stripped out, they will be displayed as * regular printing characters. */ - int numChars; /* Number of characters in string. */ + int numBytes; /* Number of bytes in string. */ int x, y; /* Coordinates at which to place origin of * string when drawing. */ { UnixFont *fontPtr; - CONST char *p; - int i, type; - char buf[4]; + SubFont *thisSubFontPtr, *lastSubFontPtr; + Tcl_DString runString; + CONST char *p, *end, *next; + int xStart, needWidth; + Tcl_UniChar ch; + FontFamily *familyPtr; fontPtr = (UnixFont *) tkfont; - - p = source; - for (i = 0; i < numChars; i++) { - type = fontPtr->types[UCHAR(*p)]; - if (type != NORMAL) { - DrawChars(display, drawable, gc, fontPtr, source, p - source, x, y); - x += XTextWidth(fontPtr->fontStructPtr, source, p - source); - if (type == REPLACE) { - DrawChars(display, drawable, gc, fontPtr, buf, - GetControlCharSubst(UCHAR(*p), buf), x, y); - x += fontPtr->widths[UCHAR(*p)]; + lastSubFontPtr = &fontPtr->subFontArray[0]; + + xStart = x; + + end = source + numBytes; + for (p = source; p < end; ) { + next = p + Tcl_UtfToUniChar(p, &ch); + thisSubFontPtr = FindSubFontForChar(fontPtr, ch); + if (thisSubFontPtr != lastSubFontPtr) { + if (p > source) { + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, + p - source, &runString); + if (familyPtr->isTwoByteFont) { + XDrawString16(display, drawable, gc, x, y, + (XChar2b *) Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) / 2); + + x += XTextWidth16(lastSubFontPtr->fontStructPtr, + (XChar2b *) Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) / 2); + } else { + XDrawString(display, drawable, gc, x, y, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString)); + x += XTextWidth(lastSubFontPtr->fontStructPtr, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString)); + } + Tcl_DStringFree(&runString); } - source = p + 1; + lastSubFontPtr = thisSubFontPtr; + source = p; + XSetFont(display, gc, lastSubFontPtr->fontStructPtr->fid); } - p++; + p = next; } - DrawChars(display, drawable, gc, fontPtr, source, p - source, x, y); -} - -static void -DrawChars(display, drawable, gc, fontPtr, source, numChars, x, y) - Display *display; /* Display on which to draw. */ - Drawable drawable; /* Window or pixmap in which to draw. */ - GC gc; /* Graphics context for drawing characters. */ - UnixFont *fontPtr; /* Font in which characters will be drawn; - * must be the same as font used in GC. */ - CONST char *source; /* Characters 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 numChars; /* Number of characters in string. */ - int x, y; /* Coordinates at which to place origin of - * string when drawing. */ -{ - /* - * Perform a quick sanity check to ensure we won't overflow the X - * coordinate space. - */ - - if ((x + (fontPtr->fontStructPtr->max_bounds.width * numChars) > 0x7fff)) { - int length; - - /* - * The string we are being asked to draw is too big and would overflow - * the X coordinate space. Unfortunatley X servers aren't too bright - * and so they won't deal with this case cleanly. We need to truncate - * the string before sending it to X. - */ - - numChars = Tk_MeasureChars((Tk_Font) fontPtr, source, numChars, - 0x7fff - x, 0, &length); + needWidth = fontPtr->font.fa.underline + fontPtr->font.fa.overstrike; + if (p > source) { + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, + &runString); + if (familyPtr->isTwoByteFont) { + XDrawString16(display, drawable, gc, x, y, + (XChar2b *) Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> 1); + if (needWidth) { + x += XTextWidth16(lastSubFontPtr->fontStructPtr, + (XChar2b *) Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> 1); + } + } else { + XDrawString(display, drawable, gc, x, y, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString)); + if (needWidth) { + x += XTextWidth(lastSubFontPtr->fontStructPtr, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString)); + } + } + Tcl_DStringFree(&runString); } - XDrawString(display, drawable, gc, x, y, source, numChars); + if (lastSubFontPtr != &fontPtr->subFontArray[0]) { + XSetFont(display, gc, fontPtr->subFontArray[0].fontStructPtr->fid); + } if (fontPtr->font.fa.underline != 0) { - XFillRectangle(display, drawable, gc, x, + XFillRectangle(display, drawable, gc, xStart, y + fontPtr->underlinePos, - (unsigned) XTextWidth(fontPtr->fontStructPtr, source, numChars), - (unsigned) fontPtr->barHeight); + (unsigned) (x - xStart), (unsigned) fontPtr->barHeight); } if (fontPtr->font.fa.overstrike != 0) { y -= fontPtr->font.fm.descent + (fontPtr->font.fm.ascent) / 10; - XFillRectangle(display, drawable, gc, x, y, - (unsigned) XTextWidth(fontPtr->fontStructPtr, source, numChars), - (unsigned) fontPtr->barHeight); + XFillRectangle(display, drawable, gc, xStart, y, + (unsigned) (x - xStart), (unsigned) fontPtr->barHeight); } } /* - *--------------------------------------------------------------------------- + *------------------------------------------------------------------------- * - * AllocFont -- + * CreateClosestFont -- * * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). - * Allocates and intializes the memory for a new TkFont that - * wraps the platform-specific data. + * Given a set of font attributes, construct a close XFontStruct. + * If requested face name is not available, automatically + * substitutes an alias for requested face name. If encoding is + * not specified (or the requested one is not available), + * automatically chooses another encoding from the list of + * preferred encodings. If the foundry is not specified (or + * is not available) automatically prefers "adobe" foundry. + * For all other attributes, if the requested value was not + * available, the appropriate "close" value will be used. * * Results: - * Returns pointer to newly constructed TkFont. - * - * The caller is responsible for initializing the fields of the - * TkFont that are used exclusively by the generic TkFont code, and - * for releasing those fields before calling TkpDeleteFont(). + * Return value is the XFontStruct that best matched the + * requested attributes. The return value is never NULL; some + * font will always be returned. * * Side effects: - * Memory allocated. + * None. * - *--------------------------------------------------------------------------- - */ + *------------------------------------------------------------------------- + */ -static UnixFont * -AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName) - TkFont *tkFontPtr; /* If non-NULL, store the information in - * this existing TkFont structure, rather than - * allocating a new structure to hold the - * font; the existing contents of the font - * will be released. If NULL, a new TkFont - * structure is allocated. */ +static XFontStruct * +CreateClosestFont(tkwin, faPtr, xaPtr) Tk_Window tkwin; /* For display where font will be used. */ - XFontStruct *fontStructPtr; /* X information about font. */ - CONST char *fontName; /* The string passed to XLoadQueryFont() to - * construct the fontStructPtr. */ + CONST TkFontAttributes *faPtr; + /* Set of generic attributes to match. */ + CONST TkXLFDAttributes *xaPtr; + /* Set of X-specific attributes to match. */ { - UnixFont *fontPtr; - unsigned long value; - int i, width, firstChar, lastChar, n, replaceOK; - char *name, *p; - char buf[4]; - TkXLFDAttributes xa; - double d; - - if (tkFontPtr != NULL) { - fontPtr = (UnixFont *) tkFontPtr; - XFreeFont(fontPtr->display, fontPtr->fontStructPtr); - } else { - fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont)); + FontAttributes want; + char **nameList; + int numNames, nameIdx; + Display *display; + XFontStruct *fontStructPtr; + int bestIdx[2]; + unsigned int bestScore[2]; + + want.fa = *faPtr; + want.xa = *xaPtr; + + if (want.xa.foundry == NULL) { + want.xa.foundry = Tk_GetUid("adobe"); + } + if (want.fa.family == NULL) { + want.fa.family = Tk_GetUid("fixed"); + } + want.fa.size = -TkFontGetPixels(tkwin, faPtr->size); + if (want.xa.charset == NULL || *want.xa.charset == '\0') { + want.xa.charset = Tk_GetUid("iso8859-1"); /* locale. */ } + display = Tk_Display(tkwin); + /* - * Encapsulate the generic stuff in the TkFont. + * Algorithm to get the closest font to the name requested. + * + * try fontname + * try all aliases for fontname + * foreach fallback for fontname + * try the fallback + * try all aliases for the fallback */ - fontPtr->font.fid = fontStructPtr->fid; - - if (XGetFontProperty(fontStructPtr, XA_FONT, &value) && (value != 0)) { - name = Tk_GetAtomName(tkwin, (Atom) value); - TkInitFontAttributes(&xa.fa); - if (TkParseXLFD(name, &xa) == TCL_OK) { - goto ok; + nameList = ListFontOrAlias(display, want.fa.family, &numNames); + if (numNames == 0) { + char ***fontFallbacks; + int i, j; + char *fallback; + + fontFallbacks = TkFontGetFallbacks(); + for (i = 0; fontFallbacks[i] != NULL; i++) { + for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { + if (strcasecmp(want.fa.family, fallback) == 0) { + break; + } + } + if (fallback != NULL) { + for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { + nameList = ListFontOrAlias(display, fallback, &numNames); + if (numNames != 0) { + goto found; + } + } + } + } + nameList = ListFonts(display, "fixed", &numNames); + if (numNames == 0) { + nameList = ListFonts(display, "*", &numNames); + } + if (numNames == 0) { + return GetSystemFont(display); } } - TkInitFontAttributes(&xa.fa); - if (TkParseXLFD(fontName, &xa) != TCL_OK) { - TkInitFontAttributes(&fontPtr->font.fa); - fontPtr->font.fa.family = Tk_GetUid(fontName); - } else { - ok: - fontPtr->font.fa = xa.fa; + found: + bestIdx[0] = -1; + bestIdx[1] = -1; + bestScore[0] = (unsigned int) -1; + bestScore[1] = (unsigned int) -1; + for (nameIdx = 0; nameIdx < numNames; nameIdx++) { + FontAttributes got; + int scalable; + unsigned int score; + + if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) { + continue; + } + IdentifySymbolEncodings(&got); + scalable = (got.fa.size == 0); + score = RankAttributes(&want, &got); + if (score <= bestScore[scalable]) { + bestIdx[scalable] = nameIdx; + bestScore[scalable] = score; + } + if (score == 0) { + break; + } } - if (fontPtr->font.fa.pointsize < 0) { - d = -fontPtr->font.fa.pointsize * 72 / 25.4; - d *= WidthMMOfScreen(Tk_Screen(tkwin)); - d /= WidthOfScreen(Tk_Screen(tkwin)); - d += 0.5; - fontPtr->font.fa.pointsize = (int) d; + fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore); + XFreeFontNames(nameList); + + if (fontStructPtr == NULL) { + return GetSystemFont(display); } - - fontPtr->font.fm.ascent = fontStructPtr->ascent; - fontPtr->font.fm.descent = fontStructPtr->descent; - fontPtr->font.fm.maxWidth = fontStructPtr->max_bounds.width; - fontPtr->font.fm.fixed = 1; - fontPtr->display = Tk_Display(tkwin); - fontPtr->fontStructPtr = fontStructPtr; + return fontStructPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * InitFont -- + * + * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). + * Initializes the memory for a new UnixFont that wraps the + * platform-specific data. + * + * The caller is responsible for initializing the fields of the + * TkFont that are used exclusively by the generic TkFont code, and + * for releasing those fields before calling TkpDeleteFont(). + * + * Results: + * Fills the WinFont structure. + * + * Side effects: + * Memory allocated. + * + *--------------------------------------------------------------------------- + */ + +static void +InitFont(tkwin, fontStructPtr, fontPtr) + Tk_Window tkwin; /* For screen where font will be used. */ + XFontStruct *fontStructPtr; /* X information about font. */ + UnixFont *fontPtr; /* Filled with information constructed from + * the above arguments. */ +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + unsigned long value; + int minHi, maxHi, minLo, maxLo, fixed, width, limit, i, n; + FontAttributes fa; + TkFontAttributes *faPtr; + TkFontMetrics *fmPtr; + SubFont *controlPtr, *subFontPtr; + char *pageMap; + Display *display; /* - * Classify the characters. + * Get all font attributes and metrics. */ - - firstChar = fontStructPtr->min_char_or_byte2; - lastChar = fontStructPtr->max_char_or_byte2; - for (i = 0; i < 256; i++) { - if ((i == 0177) || (i < firstChar) || (i > lastChar)) { - fontPtr->types[i] = REPLACE; - } else { - fontPtr->types[i] = NORMAL; + + display = Tk_Display(tkwin); + GetFontAttributes(display, fontStructPtr, &fa); + + minHi = fontStructPtr->min_byte1; + maxHi = fontStructPtr->max_byte1; + minLo = fontStructPtr->min_char_or_byte2; + maxLo = fontStructPtr->max_char_or_byte2; + + fixed = 1; + if (fontStructPtr->per_char != NULL) { + width = 0; + limit = (maxHi - minHi + 1) * (maxLo - minLo + 1); + for (i = 0; i < limit; i++) { + n = fontStructPtr->per_char[i].width; + if (n != 0) { + if (width == 0) { + width = n; + } else if (width != n) { + fixed = 0; + break; + } + } } } - /* - * Compute the widths for all the normal characters. Any other - * characters are given an initial width of 0. Also, this determines - * if this is a fixed or variable width font, by comparing the widths - * of all the normal characters. - */ - - width = 0; + fontPtr->font.fid = fontStructPtr->fid; + + faPtr = &fontPtr->font.fa; + faPtr->family = fa.fa.family; + faPtr->size = TkFontGetPoints(tkwin, fa.fa.size); + faPtr->weight = fa.fa.weight; + faPtr->slant = fa.fa.slant; + faPtr->underline = 0; + faPtr->overstrike = 0; + + fmPtr = &fontPtr->font.fm; + fmPtr->ascent = fontStructPtr->ascent; + fmPtr->descent = fontStructPtr->descent; + fmPtr->maxWidth = fontStructPtr->max_bounds.width; + fmPtr->fixed = fixed; + + fontPtr->display = display; + fontPtr->pixelSize = TkFontGetPixels(tkwin, fa.fa.size); + fontPtr->xa = fa.xa; + + fontPtr->numSubFonts = 1; + fontPtr->subFontArray = fontPtr->staticSubFonts; + InitSubFont(display, fontStructPtr, 1, &fontPtr->subFontArray[0]); + + fontPtr->controlSubFont = fontPtr->subFontArray[0]; + subFontPtr = FindSubFontForChar(fontPtr, '0'); + controlPtr = &fontPtr->controlSubFont; + controlPtr->fontStructPtr = subFontPtr->fontStructPtr; + controlPtr->familyPtr = &tsdPtr->controlFamily; + controlPtr->fontMap = tsdPtr->controlFamily.fontMap; + + pageMap = fontPtr->subFontArray[0].fontMap[0]; for (i = 0; i < 256; i++) { - if (fontPtr->types[i] != NORMAL) { + if ((minHi > 0) || (i < minLo) || (i > maxLo) || + (((pageMap[i >> 3] >> (i & 7)) & 1) == 0)) { n = 0; } else if (fontStructPtr->per_char == NULL) { n = fontStructPtr->max_bounds.width; } else { - n = fontStructPtr->per_char[i - firstChar].width; + n = fontStructPtr->per_char[i - minLo].width; } fontPtr->widths[i] = n; - if (n != 0) { - if (width == 0) { - width = n; - } else if (width != n) { - fontPtr->font.fm.fixed = 0; - } - } - } - - /* - * Compute the widths of the characters that should be replaced with - * control character expansions. If the appropriate chars are not - * available in this font, then control character expansions will not - * be used; control chars will be invisible & zero-width. - */ - - replaceOK = 1; - for (p = hexChars; *p != '\0'; p++) { - if ((UCHAR(*p) < firstChar) || (UCHAR(*p) > lastChar)) { - replaceOK = 0; - break; - } - } - for (i = 0; i < 256; i++) { - if (fontPtr->types[i] == REPLACE) { - if (replaceOK) { - n = GetControlCharSubst(i, buf); - for ( ; --n >= 0; ) { - fontPtr->widths[i] += fontPtr->widths[UCHAR(buf[n])]; - } - } else { - fontPtr->types[i] = SKIP; - } - } } + if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_POSITION, &value)) { fontPtr->underlinePos = value; @@ -953,9 +1264,6 @@ AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName) } fontPtr->barHeight = 0; if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_THICKNESS, &value)) { - /* - * Sometimes this is 0 even though it shouldn't be. - */ fontPtr->barHeight = value; } if (fontPtr->barHeight == 0) { @@ -984,23 +1292,627 @@ AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName) fontPtr->barHeight = 1; } } +} + +/* + *------------------------------------------------------------------------- + * + * ReleaseFont -- + * + * Called to release the unix-specific contents of a TkFont. + * The caller is responsible for freeing the memory used by the + * font itself. + * + * Results: + * None. + * + * Side effects: + * Memory is freed. + * + *--------------------------------------------------------------------------- + */ + +static void +ReleaseFont(fontPtr) + UnixFont *fontPtr; /* The font to delete. */ +{ + int i; - return fontPtr; + for (i = 0; i < fontPtr->numSubFonts; i++) { + ReleaseSubFont(fontPtr->display, &fontPtr->subFontArray[i]); + } + if (fontPtr->subFontArray != fontPtr->staticSubFonts) { + ckfree((char *) fontPtr->subFontArray); + } } /* + *------------------------------------------------------------------------- + * + * InitSubFont -- + * + * Wrap a screen font and load the FontFamily that represents + * it. Used to prepare a SubFont so that characters can be mapped + * from UTF-8 to the charset of the font. + * + * Results: + * The subFontPtr is filled with information about the font. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +InitSubFont(display, fontStructPtr, base, subFontPtr) + Display *display; /* Display in which font will be used. */ + XFontStruct *fontStructPtr; /* The screen font. */ + int base; /* Non-zero if this SubFont is being used + * as the base font for a font object. */ + SubFont *subFontPtr; /* Filled with SubFont constructed from + * above attributes. */ +{ + subFontPtr->fontStructPtr = fontStructPtr; + subFontPtr->familyPtr = AllocFontFamily(display, fontStructPtr, base); + subFontPtr->fontMap = subFontPtr->familyPtr->fontMap; +} + +/* + *------------------------------------------------------------------------- + * + * ReleaseSubFont -- + * + * Called to release the contents of a SubFont. The caller is + * responsible for freeing the memory used by the SubFont itself. + * + * Results: + * None. + * + * Side effects: + * Memory and resources are freed. + * *--------------------------------------------------------------------------- + */ + +static void +ReleaseSubFont(display, subFontPtr) + Display *display; /* Display which owns screen font. */ + SubFont *subFontPtr; /* The SubFont to delete. */ +{ + XFreeFont(display, subFontPtr->fontStructPtr); + FreeFontFamily(subFontPtr->familyPtr); +} + +/* + *------------------------------------------------------------------------- + * + * AllocFontFamily -- * - * GetControlCharSubst -- + * Find the FontFamily structure associated with the given font + * name. The information should be stored by the caller in a + * SubFont and used when determining if that SubFont supports a + * character. * - * When displaying text in a widget, a backslashed escape sequence - * is substituted for control characters that occur in the text. - * Given a control character, fill in a buffer with the replacement - * string that should be displayed. + * Cannot use the string name used to construct the font as the + * key, because the capitalization may not be canonical. Therefore + * use the face name actually retrieved from the font metrics as + * the key. * * Results: - * The return value is the length of the substitute string. buf is - * filled with the substitute string; it is not '\0' terminated. + * A pointer to a FontFamily. The reference count in the FontFamily + * is automatically incremented. When the SubFont is released, the + * reference count is decremented. When no SubFont is using this + * FontFamily, it may be deleted. + * + * Side effects: + * A new FontFamily structure will be allocated if this font family + * has not been seen. TrueType character existence metrics are + * loaded into the FontFamily structure. + * + *------------------------------------------------------------------------- + */ + +static FontFamily * +AllocFontFamily(display, fontStructPtr, base) + Display *display; /* Display in which font will be used. */ + XFontStruct *fontStructPtr; /* Screen font whose FontFamily is to be + * returned. */ + int base; /* Non-zero if this font family is to be + * used in the base font of a font object. */ +{ + FontFamily *familyPtr; + FontAttributes fa; + Tcl_Encoding encoding; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + GetFontAttributes(display, fontStructPtr, &fa); + encoding = Tcl_GetEncoding(NULL, GetEncodingAlias(fa.xa.charset)); + + familyPtr = tsdPtr->fontFamilyList; + for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) { + if ((familyPtr->faceName == fa.fa.family) + && (familyPtr->foundry == fa.xa.foundry) + && (familyPtr->encoding == encoding)) { + Tcl_FreeEncoding(encoding); + familyPtr->refCount++; + return familyPtr; + } + } + + familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily)); + memset(familyPtr, 0, sizeof(FontFamily)); + familyPtr->nextPtr = tsdPtr->fontFamilyList; + tsdPtr->fontFamilyList = familyPtr; + + /* + * Set key for this FontFamily. + */ + + familyPtr->foundry = fa.xa.foundry; + familyPtr->faceName = fa.fa.family; + familyPtr->encoding = encoding; + + /* + * An initial refCount of 2 means that FontFamily information will + * persist even when the SubFont that loaded the FontFamily is released. + * Change it to 1 to cause FontFamilies to be unloaded when not in use. + */ + + familyPtr->refCount = 2; + familyPtr->isTwoByteFont = (fontStructPtr->min_byte1 > 0); + return familyPtr; +} + +/* + *------------------------------------------------------------------------- + * + * FreeFontFamily -- + * + * Called to free an FontFamily when the SubFont is finished using + * it. Frees the contents of the FontFamily and the memory used by + * the FontFamily itself. + * + * Results: + * None. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +FreeFontFamily(familyPtr) + FontFamily *familyPtr; /* The FontFamily to delete. */ +{ + FontFamily **familyPtrPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int i; + + if (familyPtr == NULL) { + return; + } + familyPtr->refCount--; + if (familyPtr->refCount > 0) { + return; + } + Tcl_FreeEncoding(familyPtr->encoding); + for (i = 0; i < FONTMAP_PAGES; i++) { + if (familyPtr->fontMap[i] != NULL) { + ckfree(familyPtr->fontMap[i]); + } + } + + /* + * Delete from list. + */ + + for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) { + if (*familyPtrPtr == familyPtr) { + *familyPtrPtr = familyPtr->nextPtr; + break; + } + familyPtrPtr = &(*familyPtrPtr)->nextPtr; + } + + ckfree((char *) familyPtr); +} + +/* + *------------------------------------------------------------------------- + * + * FindSubFontForChar -- + * + * Determine which screen font is necessary to use to + * display the given character. If the font object does not have + * a screen font that can display the character, another screen font + * may be loaded into the font object, following a set of preferred + * fallback rules. + * + * Results: + * The return value is the SubFont to use to display the given + * character. + * + * Side effects: + * The contents of fontPtr are modified to cache the results + * of the lookup and remember any SubFonts that were dynamically + * loaded. + * + *------------------------------------------------------------------------- + */ + +static SubFont * +FindSubFontForChar(fontPtr, ch) + UnixFont *fontPtr; /* The font object with which the character + * will be displayed. */ + int ch; /* The Unicode character to be displayed. */ +{ + int i, j, k, numNames; + char *faceName, *fallback; + char **aliases, **nameList, **anyFallbacks; + char ***fontFallbacks; + SubFont *subFontPtr; + Tcl_DString ds; + + if (FontMapLookup(&fontPtr->subFontArray[0], ch)) { + return &fontPtr->subFontArray[0]; + } + + for (i = 1; i < fontPtr->numSubFonts; i++) { + if (FontMapLookup(&fontPtr->subFontArray[i], ch)) { + return &fontPtr->subFontArray[i]; + } + } + + if (FontMapLookup(&fontPtr->controlSubFont, ch)) { + return &fontPtr->controlSubFont; + } + + /* + * Keep track of all face names that we check, so we don't check some + * name multiple times if it can be reached by multiple paths. + */ + + Tcl_DStringInit(&ds); + + /* + * Are there any other fonts with the same face name as the base + * font that could display this character, e.g., if the base font + * is adobe:fixed:iso8859-1, we could might be able to use + * misc:fixed:iso8859-8 or sony:fixed:jisx0208.1983-0 + */ + + faceName = fontPtr->font.fa.family; + if (SeenName(faceName, &ds) == 0) { + subFontPtr = CanUseFallback(fontPtr, faceName, ch); + if (subFontPtr != NULL) { + goto end; + } + } + + aliases = TkFontGetAliasList(faceName); + + subFontPtr = NULL; + fontFallbacks = TkFontGetFallbacks(); + for (i = 0; fontFallbacks[i] != NULL; i++) { + for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { + if (strcasecmp(fallback, faceName) == 0) { + /* + * If the base font has a fallback... + */ + + goto tryfallbacks; + } else if (aliases != NULL) { + /* + * Or if an alias for the base font has a fallback... + */ + + for (k = 0; aliases[k] != NULL; k++) { + if (strcasecmp(fallback, aliases[k]) == 0) { + goto tryfallbacks; + } + } + } + } + continue; + + tryfallbacks: + + /* + * ...then see if we can use one of the fallbacks, or an + * alias for one of the fallbacks. + */ + + for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { + subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds); + if (subFontPtr != NULL) { + goto end; + } + } + } + + /* + * See if we can use something from the global fallback list. + */ + + anyFallbacks = TkFontGetGlobalClass(); + for (i = 0; (fallback = anyFallbacks[i]) != NULL; i++) { + subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds); + if (subFontPtr != NULL) { + goto end; + } + } + + /* + * Try all face names available in the whole system until we + * find one that can be used. + */ + + nameList = ListFonts(fontPtr->display, "*", &numNames); + for (i = 0; i < numNames; i++) { + fallback = strchr(nameList[i] + 1, '-') + 1; + strchr(fallback, '-')[0] = '\0'; + if (SeenName(fallback, &ds) == 0) { + subFontPtr = CanUseFallback(fontPtr, fallback, ch); + if (subFontPtr != NULL) { + XFreeFontNames(nameList); + goto end; + } + } + } + XFreeFontNames(nameList); + + end: + Tcl_DStringFree(&ds); + + if (subFontPtr == NULL) { + /* + * No font can display this character, so it will be displayed as a + * control character expansion. + */ + + subFontPtr = &fontPtr->controlSubFont; + FontMapInsert(subFontPtr, ch); + } + return subFontPtr; +} + +/* + *------------------------------------------------------------------------- + * + * FontMapLookup -- + * + * See if the screen font can display the given character. + * + * Results: + * The return value is 0 if the screen font cannot display the + * character, non-zero otherwise. + * + * Side effects: + * New pages are added to the font mapping cache whenever the + * character belongs to a page that hasn't been seen before. + * When a page is loaded, information about all the characters on + * that page is stored, not just for the single character in + * question. + * + *------------------------------------------------------------------------- + */ + +static int +FontMapLookup(subFontPtr, ch) + SubFont *subFontPtr; /* Contains font mapping cache to be queried + * and possibly updated. */ + int ch; /* Character to be tested. */ +{ + int row, bitOffset; + + row = ch >> FONTMAP_SHIFT; + if (subFontPtr->fontMap[row] == NULL) { + FontMapLoadPage(subFontPtr, row); + } + bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); + return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1; +} + +/* + *------------------------------------------------------------------------- + * + * FontMapInsert -- + * + * Tell the font mapping cache that the given screen font should be + * used to display the specified character. This is called when no + * font on the system can be be found that can display that + * character; we lie to the font and tell it that it can display + * the character, otherwise we would end up re-searching the entire + * fallback hierarchy every time that character was seen. + * + * Results: + * None. + * + * Side effects: + * New pages are added to the font mapping cache whenever the + * character belongs to a page that hasn't been seen before. + * When a page is loaded, information about all the characters on + * that page is stored, not just for the single character in + * question. + * + *------------------------------------------------------------------------- + */ + +static void +FontMapInsert(subFontPtr, ch) + SubFont *subFontPtr; /* Contains font mapping cache to be + * updated. */ + int ch; /* Character to be added to cache. */ +{ + int row, bitOffset; + + row = ch >> FONTMAP_SHIFT; + if (subFontPtr->fontMap[row] == NULL) { + FontMapLoadPage(subFontPtr, row); + } + bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); + subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); +} + +/* + *------------------------------------------------------------------------- + * + * FontMapLoadPage -- + * + * Load information about all the characters on a given page. + * This information consists of one bit per character that indicates + * whether the associated screen font can (1) or cannot (0) display + * the characters on the page. + * + * Results: + * None. + * + * Side effects: + * Mempry allocated. + * + *------------------------------------------------------------------------- + */ +static void +FontMapLoadPage(subFontPtr, row) + SubFont *subFontPtr; /* Contains font mapping cache to be + * updated. */ + int row; /* Index of the page to be loaded into + * the cache. */ +{ + char src[TCL_UTF_MAX], buf[16]; + int minHi, maxHi, minLo, maxLo, scale, checkLo; + int i, end, bitOffset, isTwoByteFont, n; + Tcl_Encoding encoding; + XFontStruct *fontStructPtr; + XCharStruct *widths; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8); + memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8); + + if (subFontPtr->familyPtr == &tsdPtr->controlFamily) { + return; + } + + fontStructPtr = subFontPtr->fontStructPtr; + encoding = subFontPtr->familyPtr->encoding; + isTwoByteFont = subFontPtr->familyPtr->isTwoByteFont; + + widths = fontStructPtr->per_char; + minHi = fontStructPtr->min_byte1; + maxHi = fontStructPtr->max_byte1; + minLo = fontStructPtr->min_char_or_byte2; + maxLo = fontStructPtr->max_char_or_byte2; + scale = maxLo - minLo + 1; + checkLo = minLo; + + if (! isTwoByteFont) { + if (minLo < 32) { + checkLo = 32; + } + } + + end = (row + 1) << FONTMAP_SHIFT; + for (i = row << FONTMAP_SHIFT; i < end; i++) { + int hi, lo; + + if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src), + TCL_ENCODING_STOPONERROR, NULL, buf, sizeof(buf), NULL, + NULL, NULL) != TCL_OK) { + continue; + } + if (isTwoByteFont) { + hi = ((unsigned char *) buf)[0]; + lo = ((unsigned char *) buf)[1]; + } else { + hi = 0; + lo = ((unsigned char *) buf)[0]; + } + if ((hi < minHi) || (hi > maxHi) || (lo < checkLo) || (lo > maxLo)) { + continue; + } + n = (hi - minHi) * scale + lo - minLo; + if ((widths == NULL) || ((widths[n].width + widths[n].rbearing) != 0)) { + bitOffset = i & (FONTMAP_BITSPERPAGE - 1); + subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); + } + } +} + +/* + *--------------------------------------------------------------------------- + * + * CanUseFallbackWithAliases -- + * + * Helper function for FindSubFontForChar. Determine if the + * specified face name (or an alias of the specified face name) + * can be used to construct a screen font that can display the + * given character. + * + * Results: + * See CanUseFallback(). + * + * Side effects: + * If the name and/or one of its aliases was rejected, the + * rejected string is recorded in nameTriedPtr so that it won't + * be tried again. + * + *--------------------------------------------------------------------------- + */ + +static SubFont * +CanUseFallbackWithAliases(fontPtr, faceName, ch, nameTriedPtr) + UnixFont *fontPtr; /* The font object that will own the new + * screen font. */ + 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 tried. It is possible for the same + * face name to be queried multiple times when + * trying to find a suitable screen font. */ +{ + SubFont *subFontPtr; + char **aliases; + int i; + + if (SeenName(faceName, nameTriedPtr) == 0) { + subFontPtr = CanUseFallback(fontPtr, faceName, ch); + if (subFontPtr != NULL) { + return subFontPtr; + } + } + aliases = TkFontGetAliasList(faceName); + if (aliases != NULL) { + for (i = 0; aliases[i] != NULL; i++) { + if (SeenName(aliases[i], nameTriedPtr) == 0) { + subFontPtr = CanUseFallback(fontPtr, aliases[i], ch); + if (subFontPtr != NULL) { + return subFontPtr; + } + } + } + } + return NULL; +} + +/* + *--------------------------------------------------------------------------- + * + * SeenName -- + * + * Used to determine we have already tried and rejected the given + * face name when looking for a screen font that can support some + * Unicode character. + * + * Results: + * The return value is 0 if this face name has not already been seen, + * non-zero otherwise. * * Side effects: * None. @@ -1009,19 +1921,663 @@ AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName) */ static int -GetControlCharSubst(c, buf) - int c; /* The control character to be replaced. */ - char buf[4]; /* Buffer that gets replacement string. It - * only needs to be 4 characters long. */ +SeenName(name, dsPtr) + CONST char *name; /* The name to check. */ + Tcl_DString *dsPtr; /* Contains names that have already been + * seen. */ +{ + CONST char *seen, *end; + + seen = Tcl_DStringValue(dsPtr); + end = seen + Tcl_DStringLength(dsPtr); + while (seen < end) { + if (strcasecmp(seen, name) == 0) { + return 1; + } + seen += strlen(seen) + 1; + } + Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1)); + return 0; +} + +/* + *------------------------------------------------------------------------- + * + * CanUseFallback -- + * + * If the specified screen font has not already been loaded + * into the font object, determine if the specified screen + * font can display the given character. + * + * Results: + * The return value is a pointer to a newly allocated SubFont, + * owned by the font object. This SubFont can be used to display + * the given character. The SubFont represents the screen font + * with the base set of font attributes from the font object, but + * using the specified face name. NULL is returned if the font + * object already holds a reference to the specified font or if + * the specified font doesn't exist or cannot display the given + * character. + * + * Side effects: + * The font object's subFontArray is updated to contain a reference + * to the newly allocated SubFont. + * + *------------------------------------------------------------------------- + */ + +static SubFont * +CanUseFallback(fontPtr, faceName, ch) + UnixFont *fontPtr; /* The font object that will own the new + * screen font. */ + char *faceName; /* Desired face name for new screen font. */ + int ch; /* The Unicode character that the new + * screen font must be able to display. */ { - buf[0] = '\\'; - if ((c < sizeof(mapChars)) && (mapChars[c] != 0)) { - buf[1] = mapChars[c]; - return 2; + int i, nameIdx, numNames, srcLen; + Tk_Uid hateFoundry; + int bestIdx[2]; + CONST char *charset, *hateCharset; + unsigned int bestScore[2]; + char **nameList, **nameListOrig; + FontAttributes want, got; + char src[TCL_UTF_MAX]; + Display *display; + SubFont subFont; + XFontStruct *fontStructPtr; + Tcl_DString dsEncodings; + int numEncodings; + Tcl_Encoding *encodingCachePtr; + + /* + * Assume: the face name is times. + * Assume: adobe:times:iso8859-1 has already been used. + * + * Are there any versions of times that can display this + * character (e.g., perhaps linotype:times:iso8859-2)? + * a. Get list of all times fonts. + * b1. Cross out all names whose encodings we've already used. + * b2. Cross out all names whose foundry & encoding we've already seen. + * c. Cross out all names whose encoding cannot handle the character. + * d. Rank each name and pick the best match. + * e. If that font cannot actually display the character, cross + * out all names with the same foundry and encoding and go + * back to (c). + */ + + display = fontPtr->display; + nameList = ListFonts(display, faceName, &numNames); + if (numNames == 0) { + return NULL; + } + nameListOrig = nameList; + + srcLen = Tcl_UniCharToUtf(ch, src); + + want.fa = fontPtr->font.fa; + want.xa = fontPtr->xa; + + want.fa.family = Tk_GetUid(faceName); + want.fa.size = -fontPtr->pixelSize; + + hateFoundry = NULL; + hateCharset = NULL; + numEncodings = 0; + Tcl_DStringInit(&dsEncodings); + + charset = NULL; /* lint, since numNames must be > 0 to get here. */ + + retry: + bestIdx[0] = -1; + bestIdx[1] = -1; + bestScore[0] = (unsigned int) -1; + bestScore[1] = (unsigned int) -1; + for (nameIdx = 0; nameIdx < numNames; nameIdx++) { + Tcl_Encoding encoding; + char dst[16]; + int scalable, srcRead, dstWrote; + unsigned int score; + + if (nameList[nameIdx] == NULL) { + continue; + } + if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) { + goto crossout; + } + IdentifySymbolEncodings(&got); + charset = GetEncodingAlias(got.xa.charset); + if (hateFoundry != NULL) { + /* + * E. If the font we picked cannot actually display the + * character, cross out all names with the same foundry and + * encoding. + */ + + if ((hateFoundry == got.xa.foundry) + && (strcmp(hateCharset, charset) == 0)) { + goto crossout; + } + } else { + /* + * B. Cross out all names whose encodings we've already used. + */ + + for (i = 0; i < fontPtr->numSubFonts; i++) { + encoding = fontPtr->subFontArray[i].familyPtr->encoding; + if (strcmp(charset, Tcl_GetEncodingName(encoding)) == 0) { + goto crossout; + } + } + } + + /* + * C. Cross out all names whose encoding cannot handle the character. + */ + + encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings); + for (i = numEncodings; --i >= 0; encodingCachePtr++) { + encoding = *encodingCachePtr; + if (strcmp(Tcl_GetEncodingName(encoding), charset) == 0) { + break; + } + } + if (i < 0) { + encoding = Tcl_GetEncoding(NULL, charset); + if (encoding == NULL) { + goto crossout; + } + + Tcl_DStringAppend(&dsEncodings, (char *) &encoding, + sizeof(encoding)); + numEncodings++; + } + Tcl_UtfToExternal(NULL, encoding, src, srcLen, + TCL_ENCODING_STOPONERROR, NULL, dst, sizeof(dst), &srcRead, + &dstWrote, NULL); + if (dstWrote == 0) { + goto crossout; + } + + /* + * D. Rank each name and pick the best match. + */ + + scalable = (got.fa.size == 0); + score = RankAttributes(&want, &got); + if (score <= bestScore[scalable]) { + bestIdx[scalable] = nameIdx; + bestScore[scalable] = score; + } + if (score == 0) { + break; + } + continue; + + crossout: + if (nameList == nameListOrig) { + /* + * Not allowed to change pointers to memory that X gives you, + * so make a copy. + */ + + nameList = (char **) ckalloc(numNames * sizeof(char *)); + memcpy(nameList, nameListOrig, numNames * sizeof(char *)); + } + nameList[nameIdx] = NULL; + } + + fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore); + + encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings); + for (i = numEncodings; --i >= 0; encodingCachePtr++) { + Tcl_FreeEncoding(*encodingCachePtr); + } + Tcl_DStringFree(&dsEncodings); + numEncodings = 0; + + if (fontStructPtr == NULL) { + if (nameList != nameListOrig) { + ckfree((char *) nameList); + } + XFreeFontNames(nameListOrig); + return NULL; + } + + InitSubFont(display, fontStructPtr, 0, &subFont); + if (FontMapLookup(&subFont, ch) == 0) { + /* + * E. If the font we picked cannot actually display the character, + * cross out all names with the same foundry and encoding and pick + * another font. + */ + + hateFoundry = got.xa.foundry; + hateCharset = charset; + ReleaseSubFont(display, &subFont); + goto retry; + } + if (nameList != nameListOrig) { + ckfree((char *) nameList); + } + XFreeFontNames(nameListOrig); + + if (fontPtr->numSubFonts >= SUBFONT_SPACE) { + SubFont *newPtr; + + newPtr = (SubFont *) ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1)); + memcpy((char *) newPtr, fontPtr->subFontArray, + fontPtr->numSubFonts * sizeof(SubFont)); + if (fontPtr->subFontArray != fontPtr->staticSubFonts) { + ckfree((char *) fontPtr->subFontArray); + } + fontPtr->subFontArray = newPtr; + } + fontPtr->subFontArray[fontPtr->numSubFonts] = subFont; + fontPtr->numSubFonts++; + return &fontPtr->subFontArray[fontPtr->numSubFonts - 1]; +} + +/* + *--------------------------------------------------------------------------- + * + * RankAttributes -- + * + * Determine how close the attributes of the font in question match + * the attributes that we want. + * + * Results: + * The return value is the score; lower numbers are better. + * *scalablePtr is set to 0 if the font was not scalable, 1 otherwise. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static unsigned int +RankAttributes(wantPtr, gotPtr) + FontAttributes *wantPtr; /* The desired attributes. */ + FontAttributes *gotPtr; /* The attributes we have to live with. */ +{ + unsigned int penalty; + + penalty = 0; + if (gotPtr->xa.foundry != wantPtr->xa.foundry) { + penalty += 4500; + } + if (gotPtr->fa.family != wantPtr->fa.family) { + penalty += 9000; + } + if (gotPtr->fa.weight != wantPtr->fa.weight) { + penalty += 90; + } + if (gotPtr->fa.slant != wantPtr->fa.slant) { + penalty += 60; + } + if (gotPtr->xa.slant != wantPtr->xa.slant) { + penalty += 10; + } + if (gotPtr->xa.setwidth != wantPtr->xa.setwidth) { + penalty += 1000; + } + + if (gotPtr->fa.size == 0) { + /* + * A scalable font is almost always acceptable, but the + * corresponding bitmapped font would be better. + */ + + penalty += 10; } else { - buf[1] = 'x'; - buf[2] = hexChars[(c >> 4) & 0xf]; - buf[3] = hexChars[c & 0xf]; - return 4; + int diff; + + /* + * It's worse to be too large than to be too small. + */ + + diff = (-gotPtr->fa.size - -wantPtr->fa.size); + if (diff > 0) { + penalty += 600; + } else if (diff < 0) { + penalty += 150; + diff = -diff; + } + penalty += 150 * diff; } + if (gotPtr->xa.charset != wantPtr->xa.charset) { + int i; + CONST char *gotAlias, *wantAlias; + + penalty += 65000; + gotAlias = GetEncodingAlias(gotPtr->xa.charset); + wantAlias = GetEncodingAlias(wantPtr->xa.charset); + if (strcmp(gotAlias, wantAlias) != 0) { + penalty += 30000; + for (i = 0; encodingList[i] != NULL; i++) { + if (strcmp(gotAlias, encodingList[i]) == 0) { + penalty -= 30000; + break; + } + penalty += 20000; + } + } + } + return penalty; } + +/* + *--------------------------------------------------------------------------- + * + * GetScreenFont -- + * + * Given the names for the best scalable and best bitmapped font, + * actually construct an XFontStruct based on the best XLFD. + * This is where all the alias and fallback substitution bottoms + * out. + * + * Results: + * The screen font that best corresponds to the set of attributes. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static XFontStruct * +GetScreenFont(display, wantPtr, nameList, bestIdx, bestScore) + Display *display; /* Display for new XFontStruct. */ + FontAttributes *wantPtr; /* Contains desired actual pixel-size if the + * best font was scalable. */ + 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 font. XLFD corresponding to + * lowest score will be constructed. */ +{ + XFontStruct *fontStructPtr; + + if ((bestIdx[0] < 0) && (bestIdx[1] < 0)) { + return NULL; + } + + /* + * Now we know which is the closest matching scalable font and the + * closest matching bitmapped font. If the scalable font was a + * better match, try getting the scalable font; however, if the + * scalable font was not actually available in the desired + * pointsize, fall back to the closest bitmapped font. + */ + + fontStructPtr = NULL; + if (bestScore[1] < bestScore[0]) { + char *str, *rest; + char buf[256]; + int i; + + /* + * Fill in the desired pixel size for this font. + */ + + tryscale: + str = nameList[bestIdx[1]]; + for (i = 0; i < XLFD_PIXEL_SIZE; i++) { + str = strchr(str + 1, '-'); + } + rest = str; + for (i = XLFD_PIXEL_SIZE; i < XLFD_CHARSET; i++) { + rest = strchr(rest + 1, '-'); + } + *str = '\0'; + sprintf(buf, "%.200s-%d-*-*-*-*-*%s", nameList[bestIdx[1]], + -wantPtr->fa.size, rest); + *str = '-'; + fontStructPtr = XLoadQueryFont(display, buf); + bestScore[1] = INT_MAX; + } + if (fontStructPtr == NULL) { + fontStructPtr = XLoadQueryFont(display, nameList[bestIdx[0]]); + if (fontStructPtr == NULL) { + /* + * This shouldn't happen because the font name is one of the + * names that X gave us to use, but it does anyhow. + */ + + if (bestScore[1] < INT_MAX) { + goto tryscale; + } + return GetSystemFont(display); + } + } + return fontStructPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * GetSystemFont -- + * + * Absolute fallback mechanism, called when we need a font and no + * other font can be found and/or instantiated. + * + * Results: + * A pointer to a font. Never NULL. + * + * Side effects: + * If there are NO fonts installed on the system, this call will + * panic, but how did you get X running in that case? + * + *--------------------------------------------------------------------------- + */ + +static XFontStruct * +GetSystemFont(display) + Display *display; /* Display for new XFontStruct. */ +{ + XFontStruct *fontStructPtr; + + fontStructPtr = XLoadQueryFont(display, "fixed"); + if (fontStructPtr == NULL) { + fontStructPtr = XLoadQueryFont(display, "*"); + if (fontStructPtr == NULL) { + panic("TkpGetFontFromAttributes: cannot get any font"); + } + } + return fontStructPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * GetFontAttributes -- + * + * Given a screen font, determine its actual attributes, which are + * not necessarily the attributes that were used to construct it. + * + * Results: + * *faPtr is filled with the screen font's attributes. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +GetFontAttributes(display, fontStructPtr, faPtr) + Display *display; /* Display that owns the screen font. */ + XFontStruct *fontStructPtr; /* Screen font to query. */ + FontAttributes *faPtr; /* For storing attributes of screen font. */ +{ + unsigned long value; + char *p, *name; + + if ((XGetFontProperty(fontStructPtr, XA_FONT, &value) != False) && + (value != 0)) { + name = XGetAtomName(display, (Atom) value); + for (p = name; *p != '\0'; p++) { + if (isupper(UCHAR(*p))) { /* INTL: native text */ + *p = tolower(UCHAR(*p)); /* INTL: native text */ + } + } + if (TkFontParseXLFD(name, &faPtr->fa, &faPtr->xa) != TCL_OK) { + faPtr->fa.family = Tk_GetUid(name); + faPtr->xa.foundry = Tk_GetUid(""); + faPtr->xa.charset = Tk_GetUid(""); + } + XFree(name); + } else { + TkInitFontAttributes(&faPtr->fa); + TkInitXLFDAttributes(&faPtr->xa); + faPtr->fa.family = Tk_GetUid(""); + faPtr->xa.foundry = Tk_GetUid(""); + faPtr->xa.charset = Tk_GetUid(""); + } + return IdentifySymbolEncodings(faPtr); +} + +/* + *--------------------------------------------------------------------------- + * + * ListFonts -- + * + * Utility function to return the array of all XLFDs on the system + * with the specified face name. + * + * Results: + * The return value is an array of XLFDs, which should be freed with + * XFreeFontNames(), or NULL if no XLFDs matched the requested name. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static char ** +ListFonts(display, faceName, numNamesPtr) + Display *display; /* Display to query. */ + 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 buf[256]; + + sprintf(buf, "-*-%.80s-*-*-*-*-*-*-*-*-*-*-*-*", faceName); + return XListFonts(display, buf, 10000, numNamesPtr); +} + +static char ** +ListFontOrAlias(display, faceName, numNamesPtr) + Display *display; /* Display to query. */ + 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; + int i; + + nameList = ListFonts(display, faceName, numNamesPtr); + if (nameList != NULL) { + return nameList; + } + aliases = TkFontGetAliasList(faceName); + if (aliases != NULL) { + for (i = 0; aliases[i] != NULL; i++) { + nameList = ListFonts(display, aliases[i], numNamesPtr); + if (nameList != NULL) { + return nameList; + } + } + } + *numNamesPtr = 0; + return NULL; +} + +/* + *--------------------------------------------------------------------------- + * + * IdentifySymbolEncodings -- + * + * If the font attributes refer to a symbol font, update the + * charset field of the font attributes so that it reflects the + * encoding of that symbol font. In general, the raw value for + * the charset field parsed from an XLFD is meaningless for symbol + * fonts. + * + * Symbol fonts are all fonts whose name appears in the symbolClass. + * + * Results: + * The return value is non-zero if the font attributes specify a + * symbol font, or 0 otherwise. If a non-zero value is returned + * the charset field of the font attributes will be changed to + * the string that represents the actual encoding for the symbol font. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +IdentifySymbolEncodings(faPtr) + FontAttributes *faPtr; +{ + int i, j; + char **aliases, **symbolClass; + + symbolClass = TkFontGetSymbolClass(); + for (i = 0; symbolClass[i] != NULL; i++) { + if (strcasecmp(faPtr->fa.family, symbolClass[i]) == 0) { + faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(symbolClass[i])); + return 1; + } + aliases = TkFontGetAliasList(symbolClass[i]); + for (j = 0; (aliases != NULL) && (aliases[j] != NULL); j++) { + if (strcasecmp(faPtr->fa.family, aliases[j]) == 0) { + faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(aliases[j])); + return 1; + } + } + } + return 0; +} + +/* + *--------------------------------------------------------------------------- + * + * GetEncodingAlias -- + * + * Map the name of an encoding to another name that should be used + * when actually loading the encoding. For instance, the encodings + * "jisc6226.1978", "jisx0208.1983", "jisx0208.1990", and + * "jisx0208.1996" are well-known names for the same encoding and + * are represented by one encoding table: "jis0208". + * + * Results: + * As above. If the name has no alias, the original name is returned. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static CONST char * +GetEncodingAlias(name) + CONST char *name; /* The name to look up. */ +{ + EncodingAlias *aliasPtr; + + for (aliasPtr = encodingAliases; aliasPtr->aliasPattern != NULL; ) { + if (Tcl_StringMatch((char *) name, aliasPtr->aliasPattern)) { + return aliasPtr->realName; + } + aliasPtr++; + } + return name; +} + + diff --git a/unix/tkUnixInit.c b/unix/tkUnixInit.c index 158a2f6..5aa68ef 100644 --- a/unix/tkUnixInit.c +++ b/unix/tkUnixInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixInit.c,v 1.3 1998/09/14 18:23:57 stanton Exp $ + * RCS: @(#) $Id: tkUnixInit.c,v 1.4 1999/04/16 01:51:46 stanton Exp $ */ #include "tkInt.h" @@ -32,7 +32,7 @@ * * Results: * Returns a standard Tcl result. Leaves an error message or result - * in interp->result. + * in the interp's result. * * Side effects: * Sets "tk_library" Tcl variable, runs "tk.tcl" script. @@ -109,9 +109,9 @@ TkpDisplayWarning(msg, title) { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { - Tcl_Write(errChannel, title, -1); - Tcl_Write(errChannel, ": ", 2); - Tcl_Write(errChannel, msg, -1); - Tcl_Write(errChannel, "\n", 1); + Tcl_WriteChars(errChannel, title, -1); + Tcl_WriteChars(errChannel, ": ", 2); + Tcl_WriteChars(errChannel, msg, -1); + Tcl_WriteChars(errChannel, "\n", 1); } } diff --git a/unix/tkUnixInt.h b/unix/tkUnixInt.h index ade08ff..4a99d47 100644 --- a/unix/tkUnixInt.h +++ b/unix/tkUnixInt.h @@ -10,17 +10,20 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixInt.h,v 1.3 1999/03/10 07:04:46 stanton Exp $ + * RCS: @(#) $Id: tkUnixInt.h,v 1.4 1999/04/16 01:51:46 stanton Exp $ */ #ifndef _TKUNIXINT #define _TKUNIXINT +#ifndef _TKINT +#include "tkInt.h" +#endif + /* * Prototypes for procedures that are referenced in files other * than the ones they're defined in. */ - #include "tkIntPlatDecls.h" #endif /* _TKUNIXINT */ diff --git a/unix/tkUnixKey.c b/unix/tkUnixKey.c new file mode 100644 index 0000000..64b2218 --- /dev/null +++ b/unix/tkUnixKey.c @@ -0,0 +1,90 @@ +/* + * tkUnixKey.c -- + * + * This file contains routines for dealing with international keyboard + * input. + * + * Copyright (c) 1997 by Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkUnixKey.c,v 1.2 1999/04/16 01:51:46 stanton Exp $ + */ + +#include "tkInt.h" + + +/* + *---------------------------------------------------------------------- + * + * TkpGetString -- + * + * Retrieve the UTF string associated with a keyboard event. + * + * Results: + * Returns the UTF string. + * + * Side effects: + * Stores the input string in the specified Tcl_DString. Modifies + * the internal input state. This routine can only be called + * once for a given event. + * + *---------------------------------------------------------------------- + */ + +char * +TkpGetString(winPtr, eventPtr, dsPtr) + TkWindow *winPtr; /* Window where event occurred: needed to + * get input context. */ + XEvent *eventPtr; /* X keyboard event. */ + Tcl_DString *dsPtr; /* Uninitialized or empty string to hold + * result. */ +{ + int len; + Tcl_DString buf; + Status status; + + /* + * Overallocate the dstring to the maximum stack amount. + */ + + Tcl_DStringInit(&buf); + Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1); + +#ifdef TK_USE_INPUT_METHODS + if ((winPtr->inputContext != NULL) + && (eventPtr->type == KeyPress)) { + len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey, + Tcl_DStringValue(&buf), Tcl_DStringLength(&buf), + (KeySym *) NULL, &status); + /* + * If the buffer wasn't big enough, grow the buffer and try again. + */ + + if (status == XBufferOverflow) { + Tcl_DStringSetLength(&buf, len); + len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey, + Tcl_DStringValue(&buf), len, (KeySym *) NULL, &status); + } + if ((status != XLookupChars) + && (status != XLookupBoth)) { + len = 0; + } + } else { + len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf), + Tcl_DStringLength(&buf), (KeySym *) NULL, + (XComposeStatus *) NULL); + } +#else /* TK_USE_INPUT_METHODS */ + len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf), + Tcl_DStringLength(&buf), (KeySym *) NULL, + (XComposeStatus *) NULL); +#endif /* TK_USE_INPUT_METHODS */ + Tcl_DStringSetLength(&buf, len); + + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buf), len, dsPtr); + Tcl_DStringFree(&buf); + + return Tcl_DStringValue(dsPtr); +} diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index 0867844..1a499cc 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -3,12 +3,12 @@ * * This module implements the UNIX platform-specific features of menus. * - * Copyright (c) 1996-1997 by Sun Microsystems, Inc. + * Copyright (c) 1996-1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixMenu.c,v 1.2 1998/09/14 18:23:57 stanton Exp $ + * RCS: @(#) $Id: tkUnixMenu.c,v 1.3 1999/04/16 01:51:46 stanton Exp $ */ #include "tkPort.h" @@ -178,7 +178,7 @@ TkpDestroyMenuEntry(mEntryPtr) * * Results: * Returns standard TCL result. If TCL_ERROR is returned, then - * interp->result contains an error message. + * the interp's result contains an error message. * * Side effects: * Configuration information get set for mePtr; old resources @@ -198,11 +198,11 @@ TkpConfigureMenuEntry(mePtr) * see if the child menu is a help menu. */ - if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) { + if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) { TkMenuReferences *menuRefPtr; - menuRefPtr = TkFindMenuReferences(mePtr->menuPtr->interp, - mePtr->name); + menuRefPtr = TkFindMenuReferencesObj(mePtr->menuPtr->interp, + mePtr->namePtr); if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) { SetHelpMenu(menuRefPtr->menuPtr); } @@ -321,32 +321,46 @@ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr) int *widthPtr; /* The resulting width */ int *heightPtr; /* The resulting height */ { - if (!mePtr->hideMargin && mePtr->indicatorOn && - ((mePtr->type == CHECK_BUTTON_ENTRY) - || (mePtr->type == RADIO_BUTTON_ENTRY))) { - if ((mePtr->image != NULL) || (mePtr->bitmap != None)) { - *widthPtr = (14 * mePtr->height) / 10; - *heightPtr = mePtr->height; - if (mePtr->type == CHECK_BUTTON_ENTRY) { - mePtr->platformEntryData = - (TkMenuPlatformEntryData) ((65 * mePtr->height) / 100); + if ((mePtr->type == CHECK_BUTTON_ENTRY) + || (mePtr->type == RADIO_BUTTON_ENTRY)) { + if (!mePtr->hideMargin && mePtr->indicatorOn) { + if ((mePtr->image != NULL) || (mePtr->bitmapPtr != NULL)) { + *widthPtr = (14 * mePtr->height) / 10; + *heightPtr = mePtr->height; + if (mePtr->type == CHECK_BUTTON_ENTRY) { + mePtr->platformEntryData = + (TkMenuPlatformEntryData) ((65 * mePtr->height) + / 100); + } else { + mePtr->platformEntryData = + (TkMenuPlatformEntryData) ((75 * mePtr->height) + / 100); + } } else { - mePtr->platformEntryData = - (TkMenuPlatformEntryData) ((75 * mePtr->height) / 100); - } - } else { - *widthPtr = *heightPtr = mePtr->height; - if (mePtr->type == CHECK_BUTTON_ENTRY) { - mePtr->platformEntryData = (TkMenuPlatformEntryData) + *widthPtr = *heightPtr = mePtr->height; + if (mePtr->type == CHECK_BUTTON_ENTRY) { + mePtr->platformEntryData = (TkMenuPlatformEntryData) ((80 * mePtr->height) / 100); - } else { - mePtr->platformEntryData = (TkMenuPlatformEntryData) + } else { + mePtr->platformEntryData = (TkMenuPlatformEntryData) mePtr->height; + } } + } else { + int 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 = menuPtr->borderWidth; + *widthPtr = borderWidth; } } @@ -379,8 +393,11 @@ GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr) *heightPtr = fmPtr->linespace; if (mePtr->type == CASCADE_ENTRY) { *widthPtr = 2 * CASCADE_ARROW_WIDTH; - } else if ((menuPtr->menuType != MENUBAR) && (mePtr->accel != NULL)) { - *widthPtr = Tk_TextWidth(tkfont, mePtr->accel, mePtr->accelLength); + } else if ((menuPtr->menuType != MENUBAR) + && (mePtr->accelPtr != NULL)) { + char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + + *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength); } else { *widthPtr = 0; } @@ -416,8 +433,10 @@ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder, bgBorder, x, y, int width; /* Width of entry rect */ int height; /* Height of entry rect */ { - if (mePtr->state == tkActiveUid) { + if (mePtr->state == ENTRY_ACTIVE) { int relief; + int activeBorderWidth; + bgBorder = activeBorder; if ((menuPtr->menuType == MENUBAR) @@ -427,9 +446,11 @@ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder, bgBorder, x, y, } else { relief = TK_RELIEF_RAISED; } - + + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height, - menuPtr->activeBorderWidth, relief); + activeBorderWidth, relief); } else { Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height, 0, TK_RELIEF_FLAT); @@ -470,6 +491,7 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder, int drawArrow; /* Whether or not to draw arrow. */ { XPoint points[3]; + int borderWidth, activeBorderWidth; /* * Draw accelerator or cascade arrow. @@ -479,9 +501,13 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder, return; } + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, + &activeBorderWidth); if ((mePtr->type == CASCADE_ENTRY) && drawArrow) { - points[0].x = x + width - menuPtr->borderWidth - - menuPtr->activeBorderWidth - CASCADE_ARROW_WIDTH; + points[0].x = x + width - borderWidth - activeBorderWidth + - 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; @@ -491,13 +517,15 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder, DECORATION_BORDER_WIDTH, (menuPtr->postedCascade == mePtr) ? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED); - } else if (mePtr->accel != NULL) { - int left = x + mePtr->labelWidth + menuPtr->activeBorderWidth + } else if (mePtr->accelPtr != NULL) { + char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + int left = x + mePtr->labelWidth + activeBorderWidth + mePtr->indicatorSpace; + if (menuPtr->menuType == MENUBAR) { left += 5; } - Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel, + Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, mePtr->accelLength, left, (y + (height + fmPtr->ascent - fmPtr->descent) / 2)); } @@ -535,62 +563,67 @@ DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr, int width; /* Width of menu entry */ int height; /* Height of menu entry */ { - /* * Draw check-button indicator. */ - if ((mePtr->type == CHECK_BUTTON_ENTRY) - && mePtr->indicatorOn) { - int dim, top, left; + if ((mePtr->type == CHECK_BUTTON_ENTRY) && mePtr->indicatorOn) { + int dim, top, left; + int activeBorderWidth; + Tk_3DBorder border; dim = (int) mePtr->platformEntryData; - left = x + menuPtr->activeBorderWidth - + (mePtr->indicatorSpace - dim)/2; + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); + left = x + activeBorderWidth + (mePtr->indicatorSpace - dim)/2; if (menuPtr->menuType == MENUBAR) { left += 5; } - top = y + (height - dim)/2; - Tk_Fill3DRectangle(menuPtr->tkwin, d, menuPtr->border, left, top, dim, + top = y + (height - dim)/2; + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, + menuPtr->borderPtr); + Tk_Fill3DRectangle(menuPtr->tkwin, d, border, left, top, dim, dim, DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN); - left += DECORATION_BORDER_WIDTH; - top += DECORATION_BORDER_WIDTH; - dim -= 2*DECORATION_BORDER_WIDTH; - if ((dim > 0) && (mePtr->entryFlags - & ENTRY_SELECTED)) { + left += DECORATION_BORDER_WIDTH; + top += DECORATION_BORDER_WIDTH; + dim -= 2*DECORATION_BORDER_WIDTH; + if ((dim > 0) && (mePtr->entryFlags + & ENTRY_SELECTED)) { XFillRectangle(menuPtr->display, d, indicatorGC, left, top, (unsigned int) dim, (unsigned int) dim); - } + } } /* * Draw radio-button indicator. */ - if ((mePtr->type == RADIO_BUTTON_ENTRY) - && mePtr->indicatorOn) { - XPoint points[4]; - int radius; + if ((mePtr->type == RADIO_BUTTON_ENTRY) && mePtr->indicatorOn) { + XPoint points[4]; + int radius; + Tk_3DBorder border; + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, + menuPtr->borderPtr); radius = ((int) mePtr->platformEntryData)/2; - points[0].x = x + (mePtr->indicatorSpace + points[0].x = x + (mePtr->indicatorSpace - (int) mePtr->platformEntryData)/2; points[0].y = y + (height)/2; - points[1].x = points[0].x + radius; - points[1].y = points[0].y + radius; - points[2].x = points[1].x + radius; - points[2].y = points[0].y; - points[3].x = points[1].x; - points[3].y = points[0].y - radius; - if (mePtr->entryFlags & ENTRY_SELECTED) { - XFillPolygon(menuPtr->display, d, indicatorGC, points, 4, Convex, - CoordModeOrigin); - } else { - Tk_Fill3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 4, + points[1].x = points[0].x + radius; + points[1].y = points[0].y + radius; + points[2].x = points[1].x + radius; + points[2].y = points[0].y; + points[3].x = points[1].x; + points[3].y = points[0].y - radius; + if (mePtr->entryFlags & ENTRY_SELECTED) { + XFillPolygon(menuPtr->display, d, indicatorGC, points, 4, + Convex, CoordModeOrigin); + } else { + Tk_Fill3DPolygon(menuPtr->tkwin, d, border, points, 4, DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT); - } - Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 4, - DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN); + } + Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 4, + DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN); } } @@ -626,6 +659,7 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) { XPoint points[2]; int margin; + Tk_3DBorder border; if (menuPtr->menuType == MENUBAR) { return; @@ -636,7 +670,8 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) points[0].y = y + height/2; points[1].x = width - 1; points[1].y = points[0].y; - Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1, + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); + Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, TK_RELIEF_RAISED); } @@ -658,30 +693,27 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) */ static void -DrawMenuEntryLabel( - menuPtr, /* The menu we are drawing */ - mePtr, /* The entry we are drawing */ - d, /* What we are drawing into */ - gc, /* The gc we are drawing into */ - tkfont, /* The precalculated font */ - fmPtr, /* The precalculated font metrics */ - x, /* left edge */ - y, /* right edge */ - width, /* width of entry */ - height) /* height of entry */ - TkMenu *menuPtr; - TkMenuEntry *mePtr; - Drawable d; - GC gc; - Tk_Font tkfont; - CONST Tk_FontMetrics *fmPtr; - int x, y, width, height; +DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) + TkMenu *menuPtr; /* The menu we are drawing. */ + TkMenuEntry *mePtr; /* The entry we are drawing. */ + 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. */ + int x; /* Left edge. */ + int y; /* Top edge. */ + int width; /* width of entry. */ + int height; /* height of entry. */ { int baseline; int indicatorSpace = mePtr->indicatorSpace; - int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth; + int activeBorderWidth; + int leftEdge; int imageHeight, imageWidth; + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, + &activeBorderWidth); + leftEdge = x + indicatorSpace + activeBorderWidth; if (menuPtr->menuType == MENUBAR) { leftEdge += 5; } @@ -703,27 +735,25 @@ DrawMenuEntryLabel( imageHeight, d, leftEdge, (int) (y + (mePtr->height - imageHeight)/2)); } - } else if (mePtr->bitmap != None) { + } else if (mePtr->bitmapPtr != None) { int width, height; - - Tk_SizeOfBitmap(menuPtr->display, - mePtr->bitmap, &width, &height); - XCopyPlane(menuPtr->display, - mePtr->bitmap, d, - gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge, + Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display,bitmap, &width, &height); + XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0, (unsigned) width, + (unsigned) height, leftEdge, (int) (y + (mePtr->height - height)/2), 1); } else { if (mePtr->labelLength > 0) { - Tk_DrawChars(menuPtr->display, d, gc, - tkfont, mePtr->label, mePtr->labelLength, - leftEdge, baseline); + char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + Tk_DrawChars(menuPtr->display, d, gc, tkfont, label, + mePtr->labelLength, leftEdge, baseline); DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height); } } - if (mePtr->state == tkDisabledUid) { - if (menuPtr->disabledFg == NULL) { + if (mePtr->state == ENTRY_DISABLED) { + if (menuPtr->disabledFgPtr == NULL) { XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y, (unsigned) width, (unsigned) height); } else if ((mePtr->image != NULL) @@ -768,15 +798,24 @@ DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) int height; { int indicatorSpace = mePtr->indicatorSpace; + if (mePtr->underline >= 0) { - int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth; + int activeBorderWidth; + int leftEdge; + char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + char *start = Tcl_UtfAtIndex(label, mePtr->underline); + char *end = Tcl_UtfNext(start); + + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); + leftEdge = x + indicatorSpace + activeBorderWidth; if (menuPtr->menuType == MENUBAR) { leftEdge += 5; } - - Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, mePtr->label, + + Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, label, leftEdge, y + (height + fmPtr->ascent - fmPtr->descent) / 2, - mePtr->underline, mePtr->underline + 1); + start - label, end - label); } } @@ -866,7 +905,7 @@ GetTearoffEntryGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr) *widthPtr = 0; } else { *heightPtr = fmPtr->linespace; - *widthPtr = Tk_TextWidth(tkfont, "W", -1); + *widthPtr = Tk_TextWidth(tkfont, "W", 1); } } @@ -903,21 +942,32 @@ TkpComputeMenubarGeometry(menuPtr) int helpMenuIndex = -1; TkMenuEntry *mePtr; int lastEntry; + Tk_Font menuFont; + int borderWidth; + int activeBorderWidth; if (menuPtr->tkwin == NULL) { return; } + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, + &activeBorderWidth); maxWidth = 0; if (menuPtr->numEntries == 0) { height = 0; } else { + int borderWidth; + maxWindowWidth = Tk_Width(menuPtr->tkwin); if (maxWindowWidth == 1) { maxWindowWidth = 0x7ffffff; } currentRowHeight = 0; - x = y = menuPtr->borderWidth; + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); + x = y = borderWidth; lastRowBreak = 0; currentRowWidth = 0; @@ -929,21 +979,22 @@ TkpComputeMenubarGeometry(menuPtr) * and if an entry has a font set, we will measure it as we come * to it, and then we decide which set to give the geometry routines. */ - - Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics); + + menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(menuFont, &menuMetrics); for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; mePtr->entryFlags &= ~ENTRY_LAST_COLUMN; - tkfont = mePtr->tkfont; - if (tkfont == NULL) { - tkfont = menuPtr->tkfont; - fmPtr = &menuMetrics; - } else { + if (mePtr->fontPtr != NULL) { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; + } else { + tkfont = menuFont; + fmPtr = &menuMetrics; } - + /* * For every entry, we need to check to see whether or not we * wrap. If we do wrap, then we have to adjust all of the previous @@ -956,24 +1007,21 @@ TkpComputeMenubarGeometry(menuPtr) || (mePtr->type == TEAROFF_ENTRY)) { mePtr->height = mePtr->width = 0; } else { - - GetMenuLabelGeometry(mePtr, tkfont, fmPtr, - &width, &height); - mePtr->height = height + 2 * menuPtr->activeBorderWidth + 10; + GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width, &height); + mePtr->height = height + 2 * activeBorderWidth + 10; mePtr->width = width; - - GetMenuIndicatorGeometry(menuPtr, mePtr, - tkfont, fmPtr, &width, &height); + + GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, + &width, &height); mePtr->indicatorSpace = width; if (width > 0) { mePtr->width += width; } - mePtr->width += 2 * menuPtr->activeBorderWidth + 10; + mePtr->width += 2 * activeBorderWidth + 10; } if (mePtr->entryFlags & ENTRY_HELP_MENU) { helpMenuIndex = i; - } else if (x + mePtr->width + menuPtr->borderWidth - > maxWindowWidth) { + } else if (x + mePtr->width + borderWidth > maxWindowWidth) { if (i == lastRowBreak) { mePtr->y = y; @@ -982,7 +1030,7 @@ TkpComputeMenubarGeometry(menuPtr) y += mePtr->height; currentRowHeight = 0; } else { - x = menuPtr->borderWidth; + x = borderWidth; for (j = lastRowBreak; j < i; j++) { menuPtr->entries[j]->y = y + currentRowHeight - menuPtr->entries[j]->height; @@ -996,7 +1044,7 @@ TkpComputeMenubarGeometry(menuPtr) if (x > maxWidth) { maxWidth = x; } - x = menuPtr->borderWidth; + x = borderWidth; } else { x += mePtr->width; if (mePtr->height > currentRowHeight) { @@ -1010,11 +1058,10 @@ TkpComputeMenubarGeometry(menuPtr) lastEntry--; } if ((lastEntry >= 0) && (x + menuPtr->entries[lastEntry]->width - + menuPtr->borderWidth > maxWidth)) { - maxWidth = x + menuPtr->entries[lastEntry]->width - + menuPtr->borderWidth; + + borderWidth > maxWidth)) { + maxWidth = x + menuPtr->entries[lastEntry]->width + borderWidth; } - x = menuPtr->borderWidth; + x = borderWidth; for (j = lastRowBreak; j < menuPtr->numEntries; j++) { if (j == helpMenuIndex) { continue; @@ -1028,17 +1075,17 @@ TkpComputeMenubarGeometry(menuPtr) if (helpMenuIndex != -1) { mePtr = menuPtr->entries[helpMenuIndex]; - if (x + mePtr->width + menuPtr->borderWidth > maxWindowWidth) { + if (x + mePtr->width + borderWidth > maxWindowWidth) { y += currentRowHeight; currentRowHeight = mePtr->height; - x = menuPtr->borderWidth; + x = borderWidth; } else if (mePtr->height > currentRowHeight) { currentRowHeight = mePtr->height; } - mePtr->x = maxWindowWidth - menuPtr->borderWidth - mePtr->width; + mePtr->x = maxWindowWidth - borderWidth - mePtr->width; mePtr->y = y + currentRowHeight - mePtr->height; } - height = y + currentRowHeight + menuPtr->borderWidth; + height = y + currentRowHeight + borderWidth; } width = Tk_Width(menuPtr->tkwin); @@ -1089,6 +1136,7 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) { XPoint points[2]; int margin, segmentWidth, maxX; + Tk_3DBorder border; if (menuPtr->menuType != MASTER_MENU) { return; @@ -1100,15 +1148,16 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) points[1].y = points[0].y; segmentWidth = 6; maxX = width - 1; + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); while (points[0].x < maxX) { points[1].x = points[0].x + segmentWidth; if (points[1].x > maxX) { points[1].x = maxX; } - Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1, + Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, TK_RELIEF_RAISED); - points[0].x += 2*segmentWidth; + points[0].x += 2 * segmentWidth; } } @@ -1235,8 +1284,7 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height, * Choose the gc for drawing the foreground part of the entry. */ - if ((mePtr->state == tkActiveUid) - && !strictMotif) { + if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) { gc = mePtr->activeGC; if (gc == NULL) { gc = menuPtr->activeGC; @@ -1248,17 +1296,21 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height, for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr; cascadeEntryPtr != NULL; cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { - if (strcmp(cascadeEntryPtr->name, - Tk_PathName(menuPtr->tkwin)) == 0) { - if (cascadeEntryPtr->state == tkDisabledUid) { - parentDisabled = 1; + if (cascadeEntryPtr->namePtr != NULL) { + char *name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, + NULL); + + if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) { + if (cascadeEntryPtr->state == ENTRY_DISABLED) { + parentDisabled = 1; + } + break; } - break; } } - if (((parentDisabled || (mePtr->state == tkDisabledUid))) - && (menuPtr->disabledFg != NULL)) { + if (((parentDisabled || (mePtr->state == ENTRY_DISABLED))) + && (menuPtr->disabledFgPtr != NULL)) { gc = mePtr->disabledGC; if (gc == NULL) { gc = menuPtr->disabledGC; @@ -1274,24 +1326,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height, if (indicatorGC == NULL) { indicatorGC = menuPtr->indicatorGC; } - - bgBorder = mePtr->border; - if (bgBorder == NULL) { - bgBorder = menuPtr->border; - } + + bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->borderPtr == NULL) + ? menuPtr->borderPtr : mePtr->borderPtr); if (strictMotif) { activeBorder = bgBorder; } else { - activeBorder = mePtr->activeBorder; - if (activeBorder == NULL) { - activeBorder = menuPtr->activeBorder; - } + activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->activeBorderPtr == NULL) + ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr); } - if (mePtr->tkfont == NULL) { + if (mePtr->fontPtr == NULL) { fmPtr = menuMetricsPtr; } else { - tkfont = mePtr->tkfont; + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } @@ -1354,13 +1404,16 @@ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr) if (mePtr->image != NULL) { Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr); - } else if (mePtr->bitmap != (Pixmap) NULL) { - Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr); + } else if (mePtr->bitmapPtr != NULL) { + Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr); } else { *heightPtr = fmPtr->linespace; - if (mePtr->label != NULL) { - *widthPtr = Tk_TextWidth(tkfont, mePtr->label, mePtr->labelLength); + if (mePtr->labelPtr != NULL) { + char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + + *widthPtr = Tk_TextWidth(tkfont, label, mePtr->labelLength); } else { *widthPtr = 0; } @@ -1392,18 +1445,23 @@ TkpComputeStandardMenuGeometry( menuPtr) /* Structure describing menu. */ TkMenu *menuPtr; { - Tk_Font tkfont; + Tk_Font tkfont, menuFont; Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr; int x, y, height, width, indicatorSpace, labelWidth, accelWidth; int windowWidth, windowHeight, accelSpace; int i, j, lastColumnBreak = 0; TkMenuEntry *mePtr; + int borderWidth, activeBorderWidth; if (menuPtr->tkwin == NULL) { return; } - x = y = menuPtr->borderWidth; + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, + &activeBorderWidth); + x = y = borderWidth; indicatorSpace = labelWidth = accelWidth = 0; windowHeight = windowWidth = 0; @@ -1418,20 +1476,21 @@ TkpComputeStandardMenuGeometry( * give all of the geometry/drawing the entry's font and metrics. */ - Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics); - accelSpace = Tk_TextWidth(menuPtr->tkfont, "M", 1); + menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(menuFont, &menuMetrics); + accelSpace = Tk_TextWidth(menuFont, "M", 1); for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; - tkfont = mePtr->tkfont; - if (tkfont == NULL) { - tkfont = menuPtr->tkfont; - fmPtr = &menuMetrics; - } else { - Tk_GetFontMetrics(tkfont, &entryMetrics); - fmPtr = &entryMetrics; - } - + if (mePtr->fontPtr == NULL) { + tkfont = menuFont; + fmPtr = &menuMetrics; + } else { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); + Tk_GetFontMetrics(tkfont, &entryMetrics); + fmPtr = &entryMetrics; + } + if ((i > 0) && mePtr->columnBreak) { if (accelWidth != 0) { labelWidth += accelSpace; @@ -1440,16 +1499,16 @@ TkpComputeStandardMenuGeometry( menuPtr->entries[j]->indicatorSpace = indicatorSpace; menuPtr->entries[j]->labelWidth = labelWidth; menuPtr->entries[j]->width = indicatorSpace + labelWidth - + accelWidth + 2 * menuPtr->activeBorderWidth; + + accelWidth + 2 * activeBorderWidth; menuPtr->entries[j]->x = x; menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN; } x += indicatorSpace + labelWidth + accelWidth - + 2 * menuPtr->activeBorderWidth; + + 2 * activeBorderWidth; windowWidth = x; indicatorSpace = labelWidth = accelWidth = 0; lastColumnBreak = i; - y = menuPtr->borderWidth; + y = borderWidth; } if (mePtr->type == SEPARATOR_ENTRY) { @@ -1507,8 +1566,7 @@ TkpComputeStandardMenuGeometry( indicatorSpace = width; } - mePtr->height += 2 * menuPtr->activeBorderWidth + - MENU_DIVIDER_HEIGHT; + mePtr->height += 2 * activeBorderWidth + MENU_DIVIDER_HEIGHT; } mePtr->y = y; y += mePtr->height; @@ -1524,15 +1582,15 @@ TkpComputeStandardMenuGeometry( menuPtr->entries[j]->indicatorSpace = indicatorSpace; menuPtr->entries[j]->labelWidth = labelWidth; menuPtr->entries[j]->width = indicatorSpace + labelWidth - + accelWidth + 2 * menuPtr->activeBorderWidth; + + accelWidth + 2 * activeBorderWidth; menuPtr->entries[j]->x = x; menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN; } windowWidth = x + indicatorSpace + labelWidth + accelWidth - + 2 * menuPtr->activeBorderWidth + 2 * menuPtr->borderWidth; + + 2 * activeBorderWidth + 2 * borderWidth; - windowHeight += menuPtr->borderWidth; + windowHeight += borderWidth; /* * The X server doesn't like zero dimensions, so round up to at least @@ -1601,3 +1659,30 @@ TkpMenuInit() * Nothing to do. */ } + + +/* + *---------------------------------------------------------------------- + * + * TkpMenuThreadInit -- + * + * Does platform-specific initialization of thread-specific + * menu state. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TkpMenuThreadInit() +{ + /* + * Nothing to do. + */ +} + diff --git a/unix/tkUnixMenubu.c b/unix/tkUnixMenubu.c index 7c33033..d8cba87 100644 --- a/unix/tkUnixMenubu.c +++ b/unix/tkUnixMenubu.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixMenubu.c,v 1.2 1998/09/14 18:23:57 stanton Exp $ + * RCS: @(#) $Id: tkUnixMenubu.c,v 1.3 1999/04/16 01:51:47 stanton Exp $ */ #include "tkMenubutton.h" @@ -84,10 +84,11 @@ TkpDisplayMenuButton(clientData) return; } - if ((mbPtr->state == tkDisabledUid) && (mbPtr->disabledFg != NULL)) { + if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) { gc = mbPtr->disabledGC; border = mbPtr->normalBorder; - } else if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) { + } else if ((mbPtr->state == STATE_ACTIVE) + && !Tk_StrictMotif(mbPtr->tkwin)) { gc = mbPtr->activeTextGC; border = mbPtr->activeBorder; } else { @@ -142,8 +143,8 @@ TkpDisplayMenuButton(clientData) * foreground color, generate the stippled effect. */ - if ((mbPtr->state == tkDisabledUid) - && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) { + if (((mbPtr->state == STATE_DISABLED) + && (mbPtr->disabledFg == NULL)) || (mbPtr->image != NULL)) { XFillRectangle(mbPtr->display, pixmap, mbPtr->disabledGC, mbPtr->inset, mbPtr->inset, (unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset), @@ -248,7 +249,7 @@ TkpDestroyMenuButton(mbPtr) void TkpComputeMenuButtonGeometry(mbPtr) - register TkMenuButton *mbPtr; /* Widget record for menu button. */ + TkMenuButton *mbPtr; /* Widget record for menu button. */ { int width, height, mm, pixels; diff --git a/unix/tkUnixPort.h b/unix/tkUnixPort.h index 590e22a..242d127 100644 --- a/unix/tkUnixPort.h +++ b/unix/tkUnixPort.h @@ -7,12 +7,11 @@ * * Copyright (c) 1991-1993 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixPort.h,v 1.4 1999/03/10 07:04:46 stanton Exp $ + * RCS: @(#) $Id: tkUnixPort.h,v 1.5 1999/04/16 01:51:47 stanton Exp $ */ #ifndef _UNIXPORT @@ -176,9 +175,16 @@ extern int errno; #endif /* + * Declarations for various library procedures that may not be declared + * in any other header file. + */ + + +/* * These functions do nothing under Unix, so we just eliminate calls to them. */ +#define TkpButtonSetDefaults(specPtr) {} #define TkpDestroyButton(butPtr) {} #define TkSelUpdateClipboard(a,b) {} #define TkSetPixmapColormap(p,c) {} @@ -214,13 +220,12 @@ extern int errno; #define ALWAYS_SHOW_SELECTION /* - * tclInt.h is included to get declarations of the following functions. - * void panic _ANSI_ARGS_(TCL_VARARGS(char *,format)); - * void TclpGetTime _ANSI_ARGS_((Tcl_Time *time)); + * The following declaration is used to get access to a private Tcl interface + * that is needed for portability reasons. */ - + #ifndef _TCLINT -# include <tclInt.h> +#include <tclInt.h> #endif #endif /* _UNIXPORT */ diff --git a/unix/tkUnixScale.c b/unix/tkUnixScale.c index b61b99a..5d7e9a1 100644 --- a/unix/tkUnixScale.c +++ b/unix/tkUnixScale.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixScale.c,v 1.2 1998/09/14 18:23:57 stanton Exp $ + * RCS: @(#) $Id: tkUnixScale.c,v 1.3 1999/04/16 01:51:47 stanton Exp $ */ #include "tkScale.h" @@ -177,7 +177,7 @@ DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr) (unsigned) scalePtr->width, (unsigned) (Tk_Height(tkwin) - 2*scalePtr->inset - 2*scalePtr->borderWidth)); - if (scalePtr->state == tkActiveUid) { + if (scalePtr->state == STATE_ACTIVE) { sliderBorder = scalePtr->activeBorder; } else { sliderBorder = scalePtr->bgBorder; @@ -210,8 +210,9 @@ DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr) Tk_GetFontMetrics(scalePtr->tkfont, &fm); Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC, - scalePtr->tkfont, scalePtr->label, scalePtr->labelLength, - scalePtr->vertLabelX, scalePtr->inset + (3*fm.ascent)/2); + scalePtr->tkfont, Tcl_GetString(scalePtr->labelPtr), + scalePtr->labelLength, scalePtr->vertLabelX, + scalePtr->inset + (3*fm.ascent)/2); } } @@ -376,7 +377,7 @@ DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr) (unsigned) (Tk_Width(tkwin) - 2*scalePtr->inset - 2*scalePtr->borderWidth), (unsigned) scalePtr->width); - if (scalePtr->state == tkActiveUid) { + if (scalePtr->state == STATE_ACTIVE) { sliderBorder = scalePtr->activeBorder; } else { sliderBorder = scalePtr->bgBorder; @@ -409,8 +410,9 @@ DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr) Tk_GetFontMetrics(scalePtr->tkfont, &fm); Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC, - scalePtr->tkfont, scalePtr->label, scalePtr->labelLength, - scalePtr->inset + fm.ascent/2, scalePtr->horizLabelY + fm.ascent); + scalePtr->tkfont, Tcl_GetString(scalePtr->labelPtr), + scalePtr->labelLength, scalePtr->inset + fm.ascent/2, + scalePtr->horizLabelY + fm.ascent); } } @@ -512,10 +514,12 @@ TkpDisplayScale(clientData) Tcl_Preserve((ClientData) scalePtr); Tcl_Preserve((ClientData) interp); - if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) { + if ((scalePtr->flags & INVOKE_COMMAND) + && (scalePtr->commandPtr != NULL)) { sprintf(string, scalePtr->format, scalePtr->value); - result = Tcl_VarEval(interp, scalePtr->command, " ", string, - (char *) NULL); + + result = Tcl_VarEval(interp, Tcl_GetString(scalePtr->commandPtr), + " ", string, (char *) NULL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command executed by scale)"); Tcl_BackgroundError(interp); @@ -549,7 +553,7 @@ TkpDisplayScale(clientData) * different. */ - if (scalePtr->vertical) { + if (scalePtr->orient == ORIENT_VERTICAL) { DisplayVerticalScale(scalePtr, pixmap, &drawnArea); } else { DisplayHorizontalScale(scalePtr, pixmap, &drawnArea); @@ -575,7 +579,8 @@ TkpDisplayScale(clientData) if (scalePtr->flags & GOT_FOCUS) { gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap); } else { - gc = Tk_GCForColor(scalePtr->highlightBgColorPtr, pixmap); + gc = Tk_GCForColor( + Tk_3DBorderColor(scalePtr->highlightBorder), pixmap); } Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap); } @@ -621,7 +626,7 @@ TkpScaleElement(scalePtr, x, y) { int sliderFirst; - if (scalePtr->vertical) { + if (scalePtr->orient == ORIENT_VERTICAL) { if ((x < scalePtr->vertTroughX) || (x >= (scalePtr->vertTroughX + 2*scalePtr->borderWidth + scalePtr->width))) { @@ -712,11 +717,11 @@ TkpSetScaleValue(scalePtr, value, setVar, invokeCommand) } TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER); - if (setVar && (scalePtr->varName != NULL)) { + if (setVar && (scalePtr->varNamePtr != NULL)) { sprintf(string, scalePtr->format, scalePtr->value); scalePtr->flags |= SETTING_VAR; - Tcl_SetVar(scalePtr->interp, scalePtr->varName, string, - TCL_GLOBAL_ONLY); + Tcl_SetVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr), + string, TCL_GLOBAL_ONLY); scalePtr->flags &= ~SETTING_VAR; } } @@ -748,7 +753,7 @@ TkpPixelToValue(scalePtr, x, y) { double value, pixelRange; - if (scalePtr->vertical) { + if (scalePtr->orient == ORIENT_VERTICAL) { pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength - 2*scalePtr->inset - 2*scalePtr->borderWidth; value = y; @@ -809,7 +814,8 @@ TkpValueToPixel(scalePtr, value) double valueRange; valueRange = scalePtr->toValue - scalePtr->fromValue; - pixelRange = (scalePtr->vertical ? Tk_Height(scalePtr->tkwin) + pixelRange = (scalePtr->orient == ORIENT_VERTICAL + ? Tk_Height(scalePtr->tkwin) : Tk_Width(scalePtr->tkwin)) - scalePtr->sliderLength - 2*scalePtr->inset - 2*scalePtr->borderWidth; if (valueRange == 0) { diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index 1b27b70..2b79a70 100644 --- a/unix/tkUnixSelect.c +++ b/unix/tkUnixSelect.c @@ -4,12 +4,12 @@ * This file contains X specific routines for manipulating * selections. * - * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixSelect.c,v 1.2 1998/09/14 18:23:57 stanton Exp $ + * RCS: @(#) $Id: tkUnixSelect.c,v 1.3 1999/04/16 01:51:47 stanton Exp $ */ #include "tkInt.h" @@ -57,9 +57,12 @@ typedef struct IncrInfo { * retrievals currently pending. */ } IncrInfo; -static IncrInfo *pendingIncrs = NULL; - /* List of all incr structures + +typedef struct ThreadSpecificData { + IncrInfo *pendingIncrs; /* List of all incr structures * currently active. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Largest property that we'll accept when sending or receiving the @@ -98,7 +101,7 @@ static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData)); * Results: * The return value is a standard Tcl return value. * If an error occurs (such as no selection exists) - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * None. @@ -230,6 +233,8 @@ TkSelPropProc(eventPtr) int numItems; char *propPtr; Tk_ErrorHandler errorHandler; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * See if this event announces the deletion of a property being @@ -240,7 +245,7 @@ TkSelPropProc(eventPtr) if (eventPtr->xproperty.state != PropertyDelete) { return; } - for (incrPtr = pendingIncrs; incrPtr != NULL; + for (incrPtr = tsdPtr->pendingIncrs; incrPtr != NULL; incrPtr = incrPtr->nextPtr) { if (incrPtr->reqWindow != eventPtr->xproperty.window) { continue; @@ -269,12 +274,12 @@ TkSelPropProc(eventPtr) } else { TkSelInProgress ip; ip.selPtr = selPtr; - ip.nextPtr = pendingPtr; - pendingPtr = &ip; + ip.nextPtr = TkSelGetInProgress(); + TkSelSetInProgress(&ip); numItems = (*selPtr->proc)(selPtr->clientData, incrPtr->offsets[i], (char *) buffer, TK_SEL_BYTES_AT_ONCE); - pendingPtr = ip.nextPtr; + TkSelSetInProgress(ip.nextPtr); if (ip.selPtr == NULL) { /* * The selection handler deleted itself. @@ -422,9 +427,12 @@ TkSelEventProc(tkwin, eventPtr) if ((type == XA_STRING) || (type == dispPtr->textAtom) || (type == dispPtr->compoundTextAtom)) { if (format != 8) { - sprintf(retrPtr->interp->result, - "bad format for string selection: wanted \"8\", got \"%d\"", - format); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, + "bad format for string selection: wanted \"8\", got \"%d\"", + format); + Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); retrPtr->result = TCL_ERROR; return; } @@ -456,9 +464,12 @@ TkSelEventProc(tkwin, eventPtr) char *string; if (format != 32) { - sprintf(retrPtr->interp->result, - "bad format for selection: wanted \"32\", got \"%d\"", - format); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, + "bad format for selection: wanted \"32\", got \"%d\"", + format); + Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); retrPtr->result = TCL_ERROR; return; } @@ -580,6 +591,8 @@ ConvertSelection(winPtr, eventPtr) Tk_ErrorHandler errorHandler; TkSelectionInfo *infoPtr; TkSelInProgress ip; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1, (int (*)()) NULL, (ClientData) NULL); @@ -694,12 +707,12 @@ ConvertSelection(winPtr, eventPtr) } } else { ip.selPtr = selPtr; - ip.nextPtr = pendingPtr; - pendingPtr = &ip; + ip.nextPtr = TkSelGetInProgress(); + TkSelSetInProgress(&ip); type = selPtr->format; numItems = (*selPtr->proc)(selPtr->clientData, 0, (char *) buffer, TK_SEL_BYTES_AT_ONCE); - pendingPtr = ip.nextPtr; + TkSelSetInProgress(ip.nextPtr); if ((ip.selPtr == NULL) || (numItems < 0)) { incr.multAtoms[2*i + 1] = None; continue; @@ -761,8 +774,8 @@ ConvertSelection(winPtr, eventPtr) incr.idleTime = 0; incr.reqWindow = reply.requestor; incr.time = infoPtr->time; - incr.nextPtr = pendingIncrs; - pendingIncrs = &incr; + incr.nextPtr = tsdPtr->pendingIncrs; + tsdPtr->pendingIncrs = &incr; } if (multiple) { XChangeProperty(reply.display, reply.requestor, reply.property, @@ -798,10 +811,10 @@ ConvertSelection(winPtr, eventPtr) -1, -1,-1, (int (*)()) NULL, (ClientData) NULL); XSelectInput(reply.display, reply.requestor, 0L); Tk_DeleteErrorHandler(errorHandler); - if (pendingIncrs == &incr) { - pendingIncrs = incr.nextPtr; + if (tsdPtr->pendingIncrs == &incr) { + tsdPtr->pendingIncrs = incr.nextPtr; } else { - for (incrPtr2 = pendingIncrs; incrPtr2 != NULL; + for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL; incrPtr2 = incrPtr2->nextPtr) { if (incrPtr2->nextPtr == &incr) { incrPtr2->nextPtr = incr.nextPtr; @@ -891,10 +904,12 @@ SelRcvIncrProc(clientData, eventPtr) || (type == retrPtr->winPtr->dispPtr->textAtom) || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) { if (format != 8) { - Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC); - sprintf(retrPtr->interp->result, - "bad format for string selection: wanted \"8\", got \"%d\"", - format); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, + "bad format for string selection: wanted \"8\", got \"%d\"", + format); + Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); retrPtr->result = TCL_ERROR; goto done; } @@ -909,10 +924,12 @@ SelRcvIncrProc(clientData, eventPtr) char *string; if (format != 32) { - Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC); - sprintf(retrPtr->interp->result, - "bad format for selection: wanted \"32\", got \"%d\"", - format); + char buf[64 + TCL_INTEGER_SPACE]; + + sprintf(buf, + "bad format for selection: wanted \"32\", got \"%d\"", + format); + Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); retrPtr->result = TCL_ERROR; goto done; } @@ -964,8 +981,8 @@ SelectionSize(selPtr) size = TK_SEL_BYTES_AT_ONCE; ip.selPtr = selPtr; - ip.nextPtr = pendingPtr; - pendingPtr = &ip; + ip.nextPtr = TkSelGetInProgress(); + TkSelSetInProgress(&ip); do { chunkSize = (*selPtr->proc)(selPtr->clientData, size, (char *) buffer, TK_SEL_BYTES_AT_ONCE); @@ -975,7 +992,7 @@ SelectionSize(selPtr) } size += chunkSize; } while (chunkSize == TK_SEL_BYTES_AT_ONCE); - pendingPtr = ip.nextPtr; + TkSelSetInProgress(ip.nextPtr); return size; } diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c index 79d5e7a..597911f 100644 --- a/unix/tkUnixSend.c +++ b/unix/tkUnixSend.c @@ -7,11 +7,12 @@ * * Copyright (c) 1989-1994 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixSend.c,v 1.3 1999/02/04 21:00:36 stanton Exp $ + * RCS: @(#) $Id: tkUnixSend.c,v 1.4 1999/04/16 01:51:47 stanton Exp $ */ #include "tkPort.h" @@ -39,10 +40,6 @@ typedef struct RegisteredInterp { * NULL means end of list. */ } RegisteredInterp; -static RegisteredInterp *registry = NULL; - /* List of all interpreters - * registered by this process. */ - /* * A registry of all interpreters for a display is kept in a * property "InterpRegistry" on the root window of the display. @@ -109,9 +106,15 @@ typedef struct PendingCommand { * list. */ } PendingCommand; -static PendingCommand *pendingCommands = NULL; - /* List of all commands currently +typedef struct ThreadSpecificData { + PendingCommand *pendingCommands; + /* List of all commands currently * being waited for. */ + RegisteredInterp *interpListPtr; + /* List of all interpreters registered + * in the current process. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * The information below is used for communication between processes @@ -745,18 +748,15 @@ Tk_SetAppName(tkwin, name) RegisteredInterp *riPtr, *riPtr2; Window w; TkWindow *winPtr = (TkWindow *) tkwin; - TkDisplay *dispPtr; + TkDisplay *dispPtr = winPtr->dispPtr; NameRegistry *regPtr; Tcl_Interp *interp; char *actualName; Tcl_DString dString; int offset, i; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); -#ifdef __WIN32__ - return name; -#endif /* __WIN32__ */ - - dispPtr = winPtr->dispPtr; interp = winPtr->mainPtr->interp; if (dispPtr->commTkwin == NULL) { SendInit(interp, winPtr->dispPtr); @@ -768,7 +768,7 @@ Tk_SetAppName(tkwin, name) */ regPtr = RegOpen(interp, winPtr->dispPtr, 1); - for (riPtr = registry; ; riPtr = riPtr->nextPtr) { + for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) { if (riPtr == NULL) { /* @@ -780,9 +780,9 @@ Tk_SetAppName(tkwin, name) riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->dispPtr = winPtr->dispPtr; - riPtr->nextPtr = registry; + riPtr->nextPtr = tsdPtr->interpListPtr; + tsdPtr->interpListPtr = riPtr; riPtr->name = NULL; - registry = riPtr; Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { @@ -838,7 +838,8 @@ Tk_SetAppName(tkwin, name) */ if (w == Tk_WindowId(dispPtr->commTkwin)) { - for (riPtr2 = registry; riPtr2 != NULL; riPtr2 = riPtr2->nextPtr) { + for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL; + riPtr2 = riPtr2->nextPtr) { if ((riPtr2->interp != interp) && (strcmp(riPtr2->name, actualName) == 0)) { goto nextSuffix; @@ -901,7 +902,7 @@ Tk_SendCmd(clientData, interp, argc, argv) Window commWindow; PendingCommand pending; register RegisteredInterp *riPtr; - char *destName, buffer[30]; + char *destName; int result, c, async, i, firstArg; size_t length; Tk_RestrictProc *prevRestrictProc; @@ -910,6 +911,8 @@ Tk_SendCmd(clientData, interp, argc, argv) Tcl_Time timeout; NameRegistry *regPtr; Tcl_DString request; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_Interp *localInterp; /* Used when the interpreter to * send the command to is within * the same process. */ @@ -971,7 +974,8 @@ Tk_SendCmd(clientData, interp, argc, argv) * could be the same! */ - for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) { + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + riPtr = riPtr->nextPtr) { if ((riPtr->dispPtr != dispPtr) || (strcmp(riPtr->name, destName) != 0)) { continue; @@ -993,6 +997,7 @@ Tk_SendCmd(clientData, interp, argc, argv) } if (interp != localInterp) { if (result == TCL_ERROR) { + Tcl_Obj *errorObjPtr; /* * An error occurred, so transfer error information from the @@ -1006,17 +1011,11 @@ Tk_SendCmd(clientData, interp, argc, argv) Tcl_ResetResult(interp); Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp, "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY)); - Tcl_SetVar2(interp, "errorCode", (char *) NULL, - Tcl_GetVar2(localInterp, "errorCode", (char *) NULL, - TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY); + errorObjPtr = Tcl_GetVar2Ex(localInterp, "errorCode", NULL, + TCL_GLOBAL_ONLY); + Tcl_SetObjErrorCode(interp, errorObjPtr); } - if (localInterp->freeProc != TCL_STATIC) { - interp->result = localInterp->result; - interp->freeProc = localInterp->freeProc; - localInterp->freeProc = TCL_STATIC; - } else { - Tcl_SetResult(interp, localInterp->result, TCL_VOLATILE); - } + Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp)); Tcl_ResetResult(localInterp); } Tcl_Release((ClientData) riPtr); @@ -1047,6 +1046,8 @@ Tk_SendCmd(clientData, interp, argc, argv) Tcl_DStringAppend(&request, "\0c\0-n ", 6); Tcl_DStringAppend(&request, destName, -1); if (!async) { + char buffer[TCL_INTEGER_SPACE * 2]; + sprintf(buffer, "%x %d", (unsigned int) Tk_WindowId(dispPtr->commTkwin), tkSendSerial); @@ -1090,8 +1091,8 @@ Tk_SendCmd(clientData, interp, argc, argv) pending.errorInfo = NULL; pending.errorCode = NULL; pending.gotResponse = 0; - pending.nextPtr = pendingCommands; - pendingCommands = &pending; + pending.nextPtr = tsdPtr->pendingCommands; + tsdPtr->pendingCommands = &pending; /* * Enter a loop processing X events until the result comes @@ -1139,10 +1140,10 @@ Tk_SendCmd(clientData, interp, argc, argv) * and return the result. */ - if (pendingCommands != &pending) { + if (tsdPtr->pendingCommands != &pending) { panic("Tk_SendCmd: corrupted send stack"); } - pendingCommands = pending.nextPtr; + tsdPtr->pendingCommands = pending.nextPtr; if (pending.errorInfo != NULL) { /* * Special trick: must clear the interp's result before calling @@ -1156,8 +1157,9 @@ Tk_SendCmd(clientData, interp, argc, argv) ckfree(pending.errorInfo); } if (pending.errorCode != NULL) { - Tcl_SetVar2(interp, "errorCode", (char *) NULL, pending.errorCode, - TCL_GLOBAL_ONLY); + Tcl_Obj *errorObjPtr; + errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1); + Tcl_SetObjErrorCode(interp, errorObjPtr); ckfree(pending.errorCode); } Tcl_SetResult(interp, pending.result, TCL_DYNAMIC); @@ -1174,10 +1176,10 @@ Tk_SendCmd(clientData, interp, argc, argv) * of a particular window. * * Results: - * A standard Tcl return value. Interp->result will be set + * A standard Tcl return value. The interp's result will be set * to hold a list of all the interpreter names defined for * tkwin's display. If an error occurs, then TCL_ERROR - * is returned and interp->result will hold an error message. + * is returned and the interp's result will hold an error message. * * Side effects: * None. @@ -1342,6 +1344,8 @@ SendEventProc(clientData, eventPtr) unsigned long numItems, bytesAfter; Atom actualType; Tcl_Interp *remoteInterp; /* Interp in which to execute the command. */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if ((eventPtr->xproperty.atom != dispPtr->commProperty) || (eventPtr->xproperty.state != PropertyNewValue)) { @@ -1466,7 +1470,7 @@ SendEventProc(clientData, eventPtr) * Locate the application, then execute the script. */ - for (riPtr = registry; ; riPtr = riPtr->nextPtr) { + for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) { if (riPtr == NULL) { if (commWindow != None) { Tcl_DStringAppend(&reply, @@ -1501,7 +1505,8 @@ SendEventProc(clientData, eventPtr) */ if (commWindow != None) { - Tcl_DStringAppend(&reply, remoteInterp->result, -1); + Tcl_DStringAppend(&reply, Tcl_GetStringResult(remoteInterp), + -1); if (result == TCL_ERROR) { char *varValue; @@ -1532,7 +1537,7 @@ SendEventProc(clientData, eventPtr) returnResult: if (commWindow != None) { if (result != TCL_OK) { - char buffer[20]; + char buffer[TCL_INTEGER_SPACE]; sprintf(buffer, "%d", result); Tcl_DStringAppend(&reply, "\0-c ", 4); @@ -1607,7 +1612,7 @@ SendEventProc(clientData, eventPtr) * waiting for it. */ - for (pcPtr = pendingCommands; pcPtr != NULL; + for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL; pcPtr = pcPtr->nextPtr) { if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) { continue; @@ -1705,6 +1710,8 @@ AppendErrorProc(clientData, errorPtr) { PendingCommand *pendingPtr = (PendingCommand *) clientData; register PendingCommand *pcPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (pendingPtr == NULL) { return 0; @@ -1714,7 +1721,7 @@ AppendErrorProc(clientData, errorPtr) * Make sure this command is still pending. */ - for (pcPtr = pendingCommands; pcPtr != NULL; + for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL; pcPtr = pcPtr->nextPtr) { if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) { pcPtr->result = (char *) ckalloc((unsigned) @@ -1754,15 +1761,17 @@ DeleteProc(clientData) RegisteredInterp *riPtr = (RegisteredInterp *) clientData; register RegisteredInterp *riPtr2; NameRegistry *regPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1); RegDeleteName(regPtr, riPtr->name); RegClose(regPtr); - if (registry == riPtr) { - registry = riPtr->nextPtr; + if (tsdPtr->interpListPtr == riPtr) { + tsdPtr->interpListPtr = riPtr->nextPtr; } else { - for (riPtr2 = registry; riPtr2 != NULL; + for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL; riPtr2 = riPtr2->nextPtr) { if (riPtr2->nextPtr == riPtr) { riPtr2->nextPtr = riPtr->nextPtr; @@ -1806,7 +1815,8 @@ SendRestrictProc(clientData, eventPtr) if (eventPtr->type != PropertyNotify) { return TK_DEFER_EVENT; } - for (dispPtr = tkDisplayList; dispPtr != NULL; dispPtr = dispPtr->nextPtr) { + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; + dispPtr = dispPtr->nextPtr) { if ((eventPtr->xany.display == dispPtr->display) && (eventPtr->xproperty.window == Tk_WindowId(dispPtr->commTkwin))) { @@ -1841,9 +1851,12 @@ UpdateCommWindow(dispPtr) { Tcl_DString names; RegisteredInterp *riPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_DStringInit(&names); - for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) { + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + riPtr = riPtr->nextPtr) { Tcl_DStringAppendElement(&names, riPtr->name); } XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin), diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 1caf65d..c87fe53 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -8,12 +8,11 @@ * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixWm.c,v 1.3 1998/09/30 23:46:17 rjohnson Exp $ + * RCS: @(#) $Id: tkUnixWm.c,v 1.4 1999/04/16 01:51:47 stanton Exp $ */ #include "tkPort.h" @@ -267,21 +266,10 @@ typedef struct TkWmInfo { /* * This module keeps a list of all top-level windows, primarily to - * simplify the job of Tk_CoordsToWindow. + * simplify the job of Tk_CoordsToWindow. The list is called + * firstWmPtr and is stored in the TkDisplay structure. */ -static WmInfo *firstWmPtr = NULL; /* Points to first top-level window. */ - - -/* - * The variable below is used to enable or disable tracing in this - * module. If tracing is enabled, then information is printed on - * standard output about interesting interactions with the window - * manager. - */ - -static int wmTracing = 0; - /* * The following structures are the official type records for geometry * management of top-level and menubar windows. @@ -337,6 +325,7 @@ static void ReparentEvent _ANSI_ARGS_((WmInfo *wmPtr, XReparentEvent *eventPtr)); static void TopLevelReqProc _ANSI_ARGS_((ClientData dummy, Tk_Window tkwin)); +static void UpdateCommand _ANSI_ARGS_((TkWindow *winPtr)); static void UpdateGeometryInfo _ANSI_ARGS_(( ClientData clientData)); static void UpdateHints _ANSI_ARGS_((TkWindow *winPtr)); @@ -378,6 +367,7 @@ TkWmNewWindow(winPtr) TkWindow *winPtr; /* Newly-created top-level window. */ { register WmInfo *wmPtr; + TkDisplay *dispPtr = winPtr->dispPtr; wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo)); wmPtr->winPtr = winPtr; @@ -433,8 +423,8 @@ TkWmNewWindow(winPtr) wmPtr->cmdArgv = NULL; wmPtr->clientMachine = NULL; wmPtr->flags = WM_NEVER_MAPPED; - wmPtr->nextPtr = firstWmPtr; - firstWmPtr = wmPtr; + wmPtr->nextPtr = (WmInfo *) dispPtr->firstWmPtr; + dispPtr->firstWmPtr = wmPtr; winPtr->wmInfoPtr = wmPtr; UpdateVRootGeometry(wmPtr); @@ -480,6 +470,8 @@ TkWmMapWindow(winPtr) char *string; if (wmPtr->flags & WM_NEVER_MAPPED) { + Tcl_DString ds; + wmPtr->flags &= ~WM_NEVER_MAPPED; /* @@ -498,16 +490,22 @@ TkWmMapWindow(winPtr) */ string = (wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid; - if (XStringListToTextProperty(&string, 1, &textProp) != 0) { + Tcl_UtfToExternalDString(NULL, string, -1, &ds); + string = Tcl_DStringValue(&ds); + if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, + &textProp) != 0) { XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); } - + Tcl_DStringFree(&ds); + TkWmSetClass(winPtr); if (wmPtr->iconName != NULL) { + Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds); XSetIconName(winPtr->display, wmPtr->wrapperPtr->window, - wmPtr->iconName); + Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); } if (wmPtr->master != None) { @@ -519,16 +517,17 @@ TkWmMapWindow(winPtr) UpdateHints(winPtr); UpdateWmProtocols(wmPtr); if (wmPtr->cmdArgv != NULL) { - XSetCommand(winPtr->display, wmPtr->wrapperPtr->window, - wmPtr->cmdArgv, wmPtr->cmdArgc); + UpdateCommand(winPtr); } if (wmPtr->clientMachine != NULL) { - if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp) - != 0) { + Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds); + if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, + &textProp) != 0) { XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); } + Tcl_DStringFree(&ds); } } if (wmPtr->hints.initial_state == WithdrawnState) { @@ -630,12 +629,13 @@ TkWmDeadWindow(winPtr) if (wmPtr == NULL) { return; } - if (firstWmPtr == wmPtr) { - firstWmPtr = wmPtr->nextPtr; + if ((WmInfo *) winPtr->dispPtr->firstWmPtr == wmPtr) { + winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr; } else { register WmInfo *prevPtr; - for (prevPtr = firstWmPtr; ; prevPtr = prevPtr->nextPtr) { + for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ; + prevPtr = prevPtr->nextPtr) { if (prevPtr == NULL) { panic("couldn't unlink window in TkWmDeadWindow"); } @@ -740,13 +740,18 @@ TkWmSetClass(winPtr) if (winPtr->classUid != NULL) { XClassHint *classPtr; + Tcl_DString name, class; + Tcl_UtfToExternalDString(NULL, winPtr->nameUid, -1, &name); + Tcl_UtfToExternalDString(NULL, winPtr->classUid, -1, &class); classPtr = XAllocClassHint(); - classPtr->res_name = winPtr->nameUid; - classPtr->res_class = winPtr->classUid; + classPtr->res_name = Tcl_DStringValue(&name); + classPtr->res_class = Tcl_DStringValue(&class); XSetClassHint(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window, classPtr); XFree((char *) classPtr); + Tcl_DStringFree(&name); + Tcl_DStringFree(&class); } } @@ -781,6 +786,7 @@ Tk_WmCmd(clientData, interp, argc, argv) register WmInfo *wmPtr; int c; size_t length; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; if (argc < 2) { wrongNumArgs: @@ -798,10 +804,11 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 2) { - interp->result = (wmTracing) ? "on" : "off"; + Tcl_SetResult(interp, ((dispPtr->wmTracing) ? "on" : "off"), + TCL_STATIC); return TCL_OK; } - return Tcl_GetBoolean(interp, argv[2], &wmTracing); + return Tcl_GetBoolean(interp, argv[2], &dispPtr->wmTracing); } if (argc < 3) { @@ -828,9 +835,12 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x, + char buf[TCL_INTEGER_SPACE * 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); } return TCL_OK; } @@ -845,7 +855,8 @@ Tk_WmCmd(clientData, interp, argc, argv) } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - interp->result = "aspect number can't be <= 0"; + Tcl_SetResult(interp, "aspect number can't be <= 0", + TCL_STATIC); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -866,7 +877,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->clientMachine != NULL) { - interp->result = wmPtr->clientMachine; + Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); } return TCL_OK; } @@ -890,12 +901,16 @@ Tk_WmCmd(clientData, interp, argc, argv) strcpy(wmPtr->clientMachine, argv[3]); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XTextProperty textProp; - if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp) - != 0) { + Tcl_DString ds; + + Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds); + if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, + &textProp) != 0) { XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); } + Tcl_DStringFree(&ds); } } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0) && (length >= 3)) { @@ -985,8 +1000,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->cmdArgv != NULL) { - interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - interp->freeProc = TCL_DYNAMIC; + Tcl_SetResult(interp, + Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), + TCL_DYNAMIC); } return TCL_OK; } @@ -1010,8 +1026,7 @@ Tk_WmCmd(clientData, interp, argc, argv) wmPtr->cmdArgc = cmdArgc; wmPtr->cmdArgv = cmdArgv; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XSetCommand(winPtr->display, wmPtr->wrapperPtr->window, - cmdArgv, cmdArgc); + UpdateCommand(winPtr); } } else if ((c == 'd') && (strncmp(argv[1], "deiconify", length) == 0)) { if (argc != 3) { @@ -1041,7 +1056,8 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - interp->result = wmPtr->hints.input ? "passive" : "active"; + Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), + TCL_STATIC); return TCL_OK; } c = argv[3][0]; @@ -1059,6 +1075,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0) && (length >= 2)) { Window window; + char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: must be \"", @@ -1069,7 +1086,8 @@ Tk_WmCmd(clientData, interp, argc, argv) if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } - sprintf(interp->result, "0x%x", (unsigned int) window); + sprintf(buf, "0x%x", (unsigned int) window); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0) && (length >= 2)) { char xSign, ySign; @@ -1082,6 +1100,8 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { + char buf[16 + TCL_INTEGER_SPACE * 4]; + xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -1093,8 +1113,9 @@ Tk_WmCmd(clientData, interp, argc, argv) width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(interp->result, "%dx%d%c%d%c%d", width, height, - xSign, wmPtr->x, ySign, wmPtr->y); + sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, + ySign, wmPtr->y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if (*argv[3] == '\0') { @@ -1115,9 +1136,12 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth, + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, wmPtr->reqGridHeight, wmPtr->widthInc, wmPtr->heightInc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } @@ -1144,19 +1168,19 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (reqWidth < 0) { - interp->result = "baseWidth can't be < 0"; + Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); return TCL_ERROR; } if (reqHeight < 0) { - interp->result = "baseHeight can't be < 0"; + Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); return TCL_ERROR; } if (widthInc < 0) { - interp->result = "widthInc can't be < 0"; + Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC); return TCL_ERROR; } if (heightInc < 0) { - interp->result = "heightInc can't be < 0"; + Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, @@ -1177,7 +1201,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - interp->result = wmPtr->leaderName; + Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); } return TCL_OK; } @@ -1222,8 +1246,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - interp->result = Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap); + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), + TCL_STATIC); } return TCL_OK; } @@ -1277,8 +1302,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } else { if (XIconifyWindow(winPtr->display, wmPtr->wrapperPtr->window, winPtr->screenNum) == 0) { - interp->result = - "couldn't send iconify message to window manager"; + Tcl_SetResult(interp, + "couldn't send iconify message to window manager", + TCL_STATIC); return TCL_ERROR; } WaitForMapNotify(winPtr, 0); @@ -1295,8 +1321,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - interp->result = Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_mask); + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), + TCL_STATIC); } return TCL_OK; } @@ -1322,17 +1349,20 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : ""; + Tcl_SetResult(interp, + ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), + TCL_STATIC); return TCL_OK; } else { - if (wmPtr->iconName != NULL) { - ckfree(wmPtr->iconName); - } wmPtr->iconName = ckalloc((unsigned) (strlen(argv[3]) + 1)); strcpy(wmPtr->iconName, argv[3]); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + Tcl_DString ds; + + Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds); XSetIconName(winPtr->display, wmPtr->wrapperPtr->window, - wmPtr->iconName); + Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); } } } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0) @@ -1347,8 +1377,11 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - sprintf(interp->result, "%d %d", wmPtr->hints.icon_x, + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", wmPtr->hints.icon_x, wmPtr->hints.icon_y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } @@ -1378,7 +1411,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->icon != NULL) { - interp->result = Tk_PathName(wmPtr->icon); + Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); } return TCL_OK; } @@ -1447,8 +1480,9 @@ Tk_WmCmd(clientData, interp, argc, argv) if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(wmPtr2->wrapperPtr), Tk_ScreenNumber(tkwin2)) == 0) { - interp->result = - "couldn't send withdraw message to window manager"; + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); return TCL_ERROR; } WaitForMapNotify((TkWindow *) tkwin2, 0); @@ -1464,8 +1498,11 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + GetMaxSize(wmPtr, &width, &height); - sprintf(interp->result, "%d %d", width, height); + sprintf(buf, "%d %d", width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) @@ -1485,8 +1522,10 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - sprintf(interp->result, "%d %d", wmPtr->minWidth, - wmPtr->minHeight); + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) @@ -1510,9 +1549,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - interp->result = "1"; + Tcl_SetResult(interp, "1", TCL_STATIC); } else { - interp->result = "0"; + Tcl_SetResult(interp, "0", TCL_STATIC); } return TCL_OK; } @@ -1537,9 +1576,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & USPosition) { - interp->result = "user"; + Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PPosition) { - interp->result = "program"; + Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } @@ -1593,7 +1632,7 @@ Tk_WmCmd(clientData, interp, argc, argv) for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - interp->result = protPtr->command; + Tcl_SetResult(interp, protPtr->command, TCL_STATIC); return TCL_OK; } } @@ -1640,9 +1679,12 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - sprintf(interp->result, "%d %d", + char buf[TCL_INTEGER_SPACE * 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); return TCL_OK; } if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK) @@ -1671,9 +1713,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & USSize) { - interp->result = "user"; + Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PSize) { - interp->result = "program"; + Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } @@ -1705,15 +1747,15 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - interp->result = "icon"; + Tcl_SetResult(interp, "icon", TCL_STATIC); } else if (wmPtr->withdrawn) { - interp->result = "withdrawn"; + Tcl_SetResult(interp, "withdrawn", TCL_STATIC); } else if (Tk_IsMapped((Tk_Window) winPtr) || ((wmPtr->flags & WM_NEVER_MAPPED) && (wmPtr->hints.initial_state == NormalState))) { - interp->result = "normal"; + Tcl_SetResult(interp, "normal", TCL_STATIC); } else { - interp->result = "iconic"; + Tcl_SetResult(interp, "iconic", TCL_STATIC); } } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0) && (length >= 2)) { @@ -1723,24 +1765,25 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - interp->result = (wmPtr->title != NULL) ? wmPtr->title - : winPtr->nameUid; + Tcl_SetResult(interp, + ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), + TCL_STATIC); return TCL_OK; } else { - if (wmPtr->title != NULL) { - ckfree(wmPtr->title); - } wmPtr->title = ckalloc((unsigned) (strlen(argv[3]) + 1)); strcpy(wmPtr->title, argv[3]); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XTextProperty textProp; + Tcl_DString ds; - if (XStringListToTextProperty(&wmPtr->title, 1, + Tcl_UtfToExternalDString(NULL, wmPtr->title, -1, &ds); + if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, &textProp) != 0) { XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); } + Tcl_DStringFree(&ds); } } } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0) @@ -1755,7 +1798,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->master != None) { - interp->result = wmPtr->masterWindowName; + Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC); } return TCL_OK; } @@ -1810,8 +1853,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window, winPtr->screenNum) == 0) { - interp->result = - "couldn't send withdraw message to window manager"; + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); return TCL_ERROR; } WaitForMapNotify(winPtr, 0); @@ -2029,6 +2073,7 @@ ConfigureEvent(wmPtr, configEventPtr) { TkWindow *wrapperPtr = wmPtr->wrapperPtr; TkWindow *winPtr = wmPtr->winPtr; + TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; /* * Update size information from the event. There are a couple of @@ -2046,7 +2091,7 @@ ConfigureEvent(wmPtr, configEventPtr) if (((wrapperPtr->changes.width != configEventPtr->width) || (wrapperPtr->changes.height != configEventPtr->height)) && !(wmPtr->flags & WM_SYNC_PENDING)){ - if (wmTracing) { + if (dispPtr->wmTracing) { printf("TopLevelEventProc: user changed %s size to %dx%d\n", winPtr->pathName, configEventPtr->width, configEventPtr->height); @@ -2110,7 +2155,7 @@ ConfigureEvent(wmPtr, configEventPtr) wmPtr->configHeight = configEventPtr->height; } - if (wmTracing) { + if (dispPtr->wmTracing) { printf("ConfigureEvent: %s x = %d y = %d, width = %d, height = %d", winPtr->pathName, configEventPtr->x, configEventPtr->y, configEventPtr->width, configEventPtr->height); @@ -2213,6 +2258,7 @@ ReparentEvent(wmPtr, reparentEventPtr) unsigned long numItems, bytesAfter; unsigned int dummy; Tk_ErrorHandler handler; + TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; /* * Identify the root window for wrapperPtr. This is tricky because of @@ -2238,7 +2284,7 @@ ReparentEvent(wmPtr, reparentEventPtr) && (actualType == XA_WINDOW))) { if ((actualFormat == 32) && (numItems == 1)) { vRoot = wmPtr->vRoot = *virtualRootPtr; - } else if (wmTracing) { + } else if (dispPtr->wmTracing) { printf("%s format %d numItems %ld\n", "ReparentEvent got bogus VROOT property:", actualFormat, numItems); @@ -2247,7 +2293,7 @@ ReparentEvent(wmPtr, reparentEventPtr) } Tk_DeleteErrorHandler(handler); - if (wmTracing) { + if (dispPtr->wmTracing) { printf("ReparentEvent: %s reparented to 0x%x, vRoot = 0x%x\n", wmPtr->winPtr->pathName, (unsigned int) reparentEventPtr->parent, (unsigned int) vRoot); @@ -2344,6 +2390,7 @@ ComputeReparentGeometry(wmPtr) Window dummy2; Status status; Tk_ErrorHandler handler; + TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL); @@ -2410,7 +2457,7 @@ ComputeReparentGeometry(wmPtr) wmPtr->wrapperPtr->changes.x = x + wmPtr->xInParent; wmPtr->wrapperPtr->changes.y = y + wmPtr->yInParent; - if (wmTracing) { + if (dispPtr->wmTracing) { printf("wrapperPtr coords %d,%d, wmPtr coords %d,%d, offsets %d %d\n", wrapperPtr->changes.x, wrapperPtr->changes.y, wmPtr->x, wmPtr->y, wmPtr->xInParent, wmPtr->yInParent); @@ -2443,6 +2490,7 @@ WrapperEventProc(clientData, eventPtr) { WmInfo *wmPtr = (WmInfo *) clientData; XEvent mapEvent; + TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; wmPtr->flags |= WM_VROOT_OFFSET_STALE; if (eventPtr->type == DestroyNotify) { @@ -2462,7 +2510,7 @@ WrapperEventProc(clientData, eventPtr) Tk_DestroyWindow((Tk_Window) wmPtr->winPtr); Tk_DeleteErrorHandler(handler); } - if (wmTracing) { + if (dispPtr->wmTracing) { printf("TopLevelEventProc: %s deleted\n", wmPtr->winPtr->pathName); } } else if (eventPtr->type == ConfigureNotify) { @@ -2725,7 +2773,7 @@ UpdateGeometryInfo(clientData) } wmPtr->configWidth = width; wmPtr->configHeight = height; - if (wmTracing) { + if (winPtr->dispPtr->wmTracing) { printf("UpdateGeometryInfo moving to %d %d, resizing to %d x %d,\n", x, y, width, height); } @@ -2746,7 +2794,7 @@ UpdateGeometryInfo(clientData) } wmPtr->configWidth = width; wmPtr->configHeight = height; - if (wmTracing) { + if (winPtr->dispPtr->wmTracing) { printf("UpdateGeometryInfo resizing to %d x %d\n", width, height); } XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, @@ -2947,7 +2995,7 @@ WaitForConfigureNotify(winPtr, serial) ConfigureNotify, &event); wmPtr->flags &= ~WM_SYNC_PENDING; if (code != TCL_OK) { - if (wmTracing) { + if (winPtr->dispPtr->wmTracing) { printf("WaitForConfigureNotify giving up on %s\n", winPtr->pathName); } @@ -2959,7 +3007,7 @@ WaitForConfigureNotify(winPtr, serial) } } wmPtr->flags &= ~WM_MOVE_PENDING; - if (wmTracing) { + if (winPtr->dispPtr->wmTracing) { printf("WaitForConfigureNotify finished with %s, serial %ld\n", winPtr->pathName, serial); } @@ -3135,14 +3183,14 @@ WaitForMapNotify(winPtr, mapped) * just quit. */ - if (wmTracing) { + if (winPtr->dispPtr->wmTracing) { printf("WaitForMapNotify giving up on %s\n", winPtr->pathName); } break; } } wmPtr->flags &= ~WM_MOVE_PENDING; - if (wmTracing) { + if (winPtr->dispPtr->wmTracing) { printf("WaitForMapNotify finished with %s\n", winPtr->pathName); } } @@ -3188,7 +3236,7 @@ UpdateHints(winPtr) * * Results: * A standard Tcl return value, plus an error message in - * interp->result if an error occurs. + * the interp's result if an error occurs. * * Side effects: * The size and/or location of winPtr may change. @@ -3441,6 +3489,7 @@ Tk_CoordsToWindow(rootX, rootY, tkwin) int x, y, childX, childY, tmpx, tmpy, bd; WmInfo *wmPtr; TkWindow *winPtr, *childPtr, *nextPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; /* * Step 1: scan the list of toplevel windows to see if there is a @@ -3452,7 +3501,7 @@ Tk_CoordsToWindow(rootX, rootY, tkwin) parent = window = RootWindowOfScreen(Tk_Screen(tkwin)); x = rootX; y = rootY; - for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { + for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { if (Tk_Screen(wmPtr->winPtr) != Tk_Screen(tkwin)) { continue; } @@ -3487,7 +3536,8 @@ Tk_CoordsToWindow(rootX, rootY, tkwin) if (child == None) { return NULL; } - for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { + for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; + wmPtr = wmPtr->nextPtr) { if (wmPtr->reparent == child) { goto gotToplevel; } @@ -3644,7 +3694,7 @@ UpdateVRootGeometry(wmPtr) (unsigned int *) &wmPtr->vRootWidth, (unsigned int *) &wmPtr->vRootHeight, (unsigned int *) &bd, &dummy); - if (wmTracing) { + if (winPtr->dispPtr->wmTracing) { printf("UpdateVRootGeometry: x = %d, y = %d, width = %d, ", wmPtr->vRootX, wmPtr->vRootY, wmPtr->vRootWidth); printf("height = %d, status = %d\n", wmPtr->vRootHeight, status); @@ -4818,3 +4868,63 @@ TkpGetWrapperWindow(winPtr) return wmPtr->wrapperPtr; } + +/* + *---------------------------------------------------------------------- + * + * UpdateCommand -- + * + * Update the WM_COMMAND property, taking care to translate + * the command strings into the external encoding. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateCommand(winPtr) + TkWindow *winPtr; +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Tcl_DString cmds, ds; + int i, *offsets; + char **cmdArgv; + + /* + * Translate the argv strings into the external encoding. To avoid + * allocating lots of memory, the strings are appended to a buffer + * with nulls between each string. + * + * This code is tricky because we need to pass and array of pointers + * to XSetCommand. However, we can't compute the pointers as we go + * because the DString buffer space could get reallocated. So, store + * offsets for each element as we go, then compute pointers from the + * offsets once the entire DString is done. + */ + + cmdArgv = (char **) ckalloc(sizeof(char *) * wmPtr->cmdArgc); + offsets = (int *) ckalloc( sizeof(int) * wmPtr->cmdArgc); + Tcl_DStringInit(&cmds); + for (i = 0; i < wmPtr->cmdArgc; i++) { + Tcl_UtfToExternalDString(NULL, wmPtr->cmdArgv[i], -1, &ds); + offsets[i] = Tcl_DStringLength(&cmds); + Tcl_DStringAppend(&cmds, Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)+1); + Tcl_DStringFree(&ds); + } + cmdArgv[0] = Tcl_DStringValue(&cmds); + for (i = 1; i < wmPtr->cmdArgc; i++) { + cmdArgv[i] = cmdArgv[0] + offsets[i]; + } + + XSetCommand(winPtr->display, wmPtr->wrapperPtr->window, + cmdArgv, wmPtr->cmdArgc); + Tcl_DStringFree(&cmds); + ckfree((char *) cmdArgv); + ckfree((char *) offsets); +} diff --git a/unix/tkUnixXId.c b/unix/tkUnixXId.c index 65dc5e0..833011c 100644 --- a/unix/tkUnixXId.c +++ b/unix/tkUnixXId.c @@ -12,12 +12,12 @@ * George C. Kaplan and Michael Hoegeman. * * Copyright (c) 1993 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixXId.c,v 1.2 1998/09/14 18:23:58 stanton Exp $ + * RCS: @(#) $Id: tkUnixXId.c,v 1.3 1999/04/16 01:51:48 stanton Exp $ */ /* @@ -28,9 +28,8 @@ #define XLIB_ILLEGAL_ACCESS 1 -#include "tkInt.h" -#include "tkPort.h" #include "tkUnixInt.h" +#include "tkPort.h" /* * A structure of the following type is used to hold one or more @@ -1,10 +1,10 @@ -Tk 8.0.5 for Windows +Tk 8.1 for Windows by Scott Stanton Scriptics Corporation scott.stanton@scriptics.com -RCS: @(#) $Id: README,v 1.8 1999/02/09 03:46:27 stanton Exp $ +RCS: @(#) $Id: README,v 1.9 1999/04/16 01:51:48 stanton Exp $ 1. Introduction --------------- @@ -17,25 +17,25 @@ contains information specific to the Windows version of Tk. 2. Distribution notes --------------------- -Tk 8.0 for Windows is distributed in binary form in addition to the +Tk 8.1 for Windows is distributed in binary form in addition to the common source release. The binary distribution is a self-extracting archive with a built-in installation script. Look for the binary release in the same location as the source release -(ftp.scriptics.com:/pub/tcl/tcl8_0 or any of the mirror sites). For -most users, the binary release will be much easier to install and use. -You only need the source release if you plan to modify the core of -Tcl, or if you need to compile with a different compiler. With the -addition of the dynamic loading interface, it is no longer necessary -to have the source distribution in order to build and use extensions. +(ftp.scriptics.com:/pub/tcl/tcl8_1 or any of the mirror sites). For most users, +the binary release will be much easier to install and use. You only +need the source release if you plan to modify the core of Tcl, or if +you need to compile with a different compiler. With the addition of +the dynamic loading interface, it is no longer necessary to have the +source distribution in order to build and use extensions. 3. Compiling Tk ---------------- In order to compile Tk for Windows, you need the following items: - Tcl 8.0 Source Distribution (plus any patches) - Tk 8.0 Source Distribution (plus any patches) + Tcl 8.1 Source Distribution (plus any patches) + Tk 8.1 Source Distribution (plus any patches) The latest Win32 SDK header files @@ -43,7 +43,7 @@ In order to compile Tk for Windows, you need the following items: or Visual C++ 2.x or later -In practice, 8.0.5 was built with Visual C++ 5.0 +In practice, 8.1 was built with Visual C++ 5.0 In the "win" subdirectory of the source release, you will find two files called "makefile.bc" and "makefile.vc". These are the makefiles @@ -59,19 +59,20 @@ find them. Tk looks in one of two places for the library files: 1) The environment variable "TK_LIBRARY". - 2) In the lib\tk8.0 directory under the Tcl installation directory + 2) In the lib\tk8.1 directory under the Tcl installation directory as specified in the registry: - HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.0 - Value Name is "Root" + HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.1\ 2) Relative to the directory containing the current .exe. - Tk will look for a directory "..\lib\tk8.0" relative to the + Tk will look for a directory "..\lib\tk8.1" relative to the directory containing the currently running .exe. -Note that in order to run wish80.exe, you must ensure that tcl80.dll, -tclpip80.dll, and tk80.dll are on your path, in the system directory, -or in the directory containing wish80.exe. +Note that in order to run wish81.exe, you must ensure that tcl81.dll, +tclpip81.dll, and tk81.dll are on your path, in the system directory, +or in the directory containing wish81.exe. + +Note that Tk no longer supports Win32s. 4. Test suite ------------- @@ -102,15 +103,14 @@ Windows beta version of Tk: - Tk_dialog appears in the upper left corner. This is a symptom of a larger problem with "wm geometry" when applied to unmapped or iconified windows. -- Some keys don't work on international keyboards. - PPM images are using the wrong translation mode for writing to files, resulting in CR/LF terminated PPM files. - Tk crashes if the display depth changes while it is running. Tk also doesn't consistently track changes in the system colors. If you have comments or bug reports for the Windows version of Tk, -please direct them to: +please use our on-line bug form at: -<bugs@scriptics.com> +http://www.scriptics.com/support/bugForm.html or post them to the newsgroup comp.lang.tcl. diff --git a/win/makefile.bc b/win/makefile.bc index 57642d9..46814e6 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -1,11 +1,11 @@ # Borland C++ 4.5 makefile for Tk # -# Copyright (c) 1995-1996 by Sun Microsystems, Inc. +# Copyright (c) 1995-1997 by Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: makefile.bc,v 1.8 1999/02/04 21:02:58 stanton Exp $ +# RCS: @(#) $Id: makefile.bc,v 1.9 1999/04/16 01:51:48 stanton Exp $ # @@ -19,7 +19,7 @@ ROOT = .. TMPDIR = . TOOLS = c:\bc45 -TCLDIR = ..\..\tcl8.0.5 +TCLDIR = ..\..\tcl8.1b3 # uncomment the following line to compile with symbols #DEBUG=1 @@ -104,6 +104,7 @@ TKOBJS = \ $(TMPDIR)\tkWinButton.obj \ $(TMPDIR)\tkWinClipboard.obj \ $(TMPDIR)\tkWinColor.obj \ + $(TMPDIR)\tkWinConfig.obj \ $(TMPDIR)\tkWinCursor.obj \ $(TMPDIR)\tkWinDialog.obj \ $(TMPDIR)\tkWinDraw.obj \ @@ -118,6 +119,7 @@ TKOBJS = \ $(TMPDIR)\tkWinRegion.obj \ $(TMPDIR)\tkWinScrlbr.obj \ $(TMPDIR)\tkWinSend.obj \ + $(TMPDIR)\tkWinTest.obj \ $(TMPDIR)\tkWinWindow.obj \ $(TMPDIR)\tkWinWm.obj \ $(TMPDIR)\tkWinX.obj \ @@ -168,6 +170,8 @@ TKOBJS = \ $(TMPDIR)\tkMenubutton.obj \ $(TMPDIR)\tkMenuDraw.obj \ $(TMPDIR)\tkMessage.obj \ + $(TMPDIR)\tkObj.obj \ + $(TMPDIR)\tkOldConfig.obj \ $(TMPDIR)\tkOption.obj \ $(TMPDIR)\tkPack.obj \ $(TMPDIR)\tkPlace.obj \ @@ -189,11 +193,11 @@ TKOBJS = \ $(TMPDIR)\tkVisual.obj \ $(TMPDIR)\tkWindow.obj -TCLDLL = tcl80.dll -TCLLIB = tcl80.lib -TKDLL = tk80.dll -TKLIB = tk80.lib -WISH = wish80.exe +TCLDLL = tcl81.dll +TCLLIB = tcl81.lib +TKDLL = tk81.dll +TKLIB = tk81.lib +WISH = wish81.exe TKTEST = tktest.exe # diff --git a/win/makefile.vc b/win/makefile.vc index 99eaece..508d260 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -3,8 +3,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# Copyright (c) 1995-1996 Sun Microsystems, Inc. -# RCS: @(#) $Id: makefile.vc,v 1.21 1999/04/16 01:25:56 stanton Exp $ +# Copyright (c) 1995-1997 Sun Microsystems, Inc. +# RCS: @(#) $Id: makefile.vc,v 1.22 1999/04/16 01:51:48 stanton Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -28,12 +28,15 @@ ROOT = .. TOOLS32 = c:\program files\devstudio\vc TOOLS32_rc = c:\program files\devstudio\sharedide -TCLDIR = ..\..\tcl8.0.5 -INSTALLDIR = c:\program files\tcl +TCLDIR = ..\..\tcl8.1b3 +INSTALLDIR = c:\program files\tcl # Set this to the appropriate value of /MACHINE: for your platform MACHINE = IX86 +# Uncomment the following line to compile with thread support +#THREADDEFINES = -DTCL_THREADS=1 + # Set NODEBUG to 0 to compile with symbols NODEBUG = 1 @@ -46,11 +49,13 @@ NODEBUG = 1 TCLNAMEPREFIX = tcl TKNAMEPREFIX = tk -TCLSTUBPREFIX = $(TCLNAMEPREFIX)stub -TKSTUBPREFIX = $(TKNAMEPREFIX)stub WISHNAMEPREFIX = wish -VERSION = 80 -DOTVERSION = 8.0 +VERSION = 81 +DOTVERSION = 8.1 + +TCLSTUBPREFIX = $(TCLNAMEPREFIX)stub +TKSTUBPREFIX = $(TKNAMEPREFIX)stub + BINROOT = . !IF "$(NODEBUG)" == "1" @@ -69,7 +74,7 @@ TCLPLUGINLIB = $(TCLNAMEPREFIX)$(VERSION)p.lib TCLSTUBLIB = $(TCLSTUBPREFIX)$(VERSION)$(DBGX).lib TKDLLNAME = $(TKNAMEPREFIX)$(VERSION)$(DBGX).dll TKDLL = $(OUTDIR)\$(TKDLLNAME) -TKLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib +TKLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib TKSTUBLIBNAME = $(TKSTUBPREFIX)$(VERSION)$(DBGX).lib TKSTUBLIB = $(OUTDIR)\$(TKSTUBLIBNAME) TKPLUGINDLLNAME = $(TKNAMEPREFIX)$(VERSION)p$(DBG).dll @@ -77,9 +82,11 @@ TKPLUGINDLL = $(OUTDIR)\$(TKPLUGINDLLNAME) TKPLUGINLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)p$(DBGX).lib WISH = $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe +WISHC = $(OUTDIR)\$(WISHNAMEPREFIX)c$(VERSION)$(DBGX).exe WISHP = $(OUTDIR)\$(WISHNAMEPREFIX)p$(VERSION)$(DBGX).exe TKTEST = $(OUTDIR)\$(TKNAMEPREFIX)test.exe DUMPEXTS = $(TMPDIR)\dumpexts.exe +CAT32 = $(TMPDIR)\cat32.exe BIN_INSTALL_DIR = $(INSTALLDIR)\bin INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include @@ -92,7 +99,9 @@ WISHOBJS = \ TKTESTOBJS = \ $(TMPDIR)\tkTest.obj \ $(TMPDIR)\tkSquare.obj \ - $(TMPDIR)\testMain.obj + $(TMPDIR)\testMain.obj \ +# the tkThreadTest.c file has not been checked it yet. +# $(TMPDIR)\tkThreadTest.obj XLIBOBJS = \ $(TMPDIR)\xcolors.obj \ @@ -111,6 +120,7 @@ TKOBJS = \ $(TMPDIR)\tkWinButton.obj \ $(TMPDIR)\tkWinClipboard.obj \ $(TMPDIR)\tkWinColor.obj \ + $(TMPDIR)\tkWinConfig.obj \ $(TMPDIR)\tkWinCursor.obj \ $(TMPDIR)\tkWinDialog.obj \ $(TMPDIR)\tkWinDraw.obj \ @@ -125,6 +135,7 @@ TKOBJS = \ $(TMPDIR)\tkWinRegion.obj \ $(TMPDIR)\tkWinScrlbr.obj \ $(TMPDIR)\tkWinSend.obj \ + $(TMPDIR)\tkWinTest.obj \ $(TMPDIR)\tkWinWindow.obj \ $(TMPDIR)\tkWinWm.obj \ $(TMPDIR)\tkWinX.obj \ @@ -175,6 +186,8 @@ TKOBJS = \ $(TMPDIR)\tkMenubutton.obj \ $(TMPDIR)\tkMenuDraw.obj \ $(TMPDIR)\tkMessage.obj \ + $(TMPDIR)\tkObj.obj \ + $(TMPDIR)\tkOldConfig.obj \ $(TMPDIR)\tkOption.obj \ $(TMPDIR)\tkPack.obj \ $(TMPDIR)\tkPlace.obj \ @@ -195,14 +208,11 @@ TKOBJS = \ $(TMPDIR)\tkUtil.obj \ $(TMPDIR)\tkVisual.obj \ $(TMPDIR)\tkStubInit.obj \ + $(TMPDIR)\tkStubLib.obj \ $(TMPDIR)\tkWindow.obj -TKSTUBOBJS = \ - $(TMPDIR)\tkStubLib.obj \ - $(TMPDIR)\tkStubs.obj \ - $(TMPDIR)\tkPlatStubs.obj \ - $(TMPDIR)\tkIntStubs.obj \ - $(TMPDIR)\tkIntPlatStubs.obj +TKSTUBOBJS = $(TMPDIR)\tkStubLib.obj \ + cc32 = "$(TOOLS32)\bin\cl.exe" link32 = "$(TOOLS32)\bin\link.exe" @@ -222,7 +232,7 @@ TK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \ TK_DEFINES = $(DEBUGDEFINES) TK_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \ - $(TK_INCLUDES) $(TK_DEFINES) + $(TK_INCLUDES) $(TK_DEFINES) -DUSE_TCL_STUBS WISH_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \ $(TK_INCLUDES) $(TK_DEFINES) @@ -263,7 +273,7 @@ libcdll = msvcrt$(DBGX).lib oldnames.lib baselibs = kernel32.lib $(optlibs) advapi32.lib winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib guilibs = $(libc) $(winlibs) - +conlibs = $(libc) $(baselibs) guilibsdll = $(libcdll) $(winlibs) ###################################################################### @@ -317,11 +327,23 @@ CON_CFLAGS = $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE # Project specific targets ###################################################################### -all: setup $(WISH) -test: setup $(TKTEST) +all: setup $(WISH) $(CAT32) install: install-binaries install-libraries plugin: setup $(TKPLUGINDLL) $(WISHP) -tktest: setup $(TKTEST) +tktest: setup $(TKTEST) $(CAT32) +test: setup $(TKTEST) $(TKLIB) $(CAT32) + set TCL_LIBRARY=$(TCLDIR)/library + set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH) + $(TKTEST) $(ROOT)/tests/all.tcl | $(CAT32) + +# copy $(TCLDIR)\bin\pkgIndex.tcl $(OUTDIR) + +console-wish : all $(WISHC) + +stubs: + $(TCLDIR)\win\$(TMPDIRNAME)\tclsh$(VERSION)$(DBGX) \ + $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \ + $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls setup: @mkd $(TMPDIR) @@ -334,15 +356,6 @@ install-binaries: @mkd "$(LIB_INSTALL_DIR)" copy $(TKLIB) "$(LIB_INSTALL_DIR)" -# -# Regenerate the stubs files. -# - -stubs: - $(TCLDIR)\win\$(TMPDIRNAME)\tclsh$(VERSION)$(DBGX) \ - $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \ - $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls - install-libraries: @mkd "$(INCLUDE_INSTALL_DIR)" @mkd "$(INCLUDE_INSTALL_DIR)\X11" @@ -357,19 +370,19 @@ install-libraries: xcopy "$(ROOT)\library\demos" "$(SCRIPT_INSTALL_DIR)\demos" xcopy "$(ROOT)\library\demos\images" "$(SCRIPT_INSTALL_DIR)\demos\images" -$(TKLIB): $(TKDLL) +$(TKLIB): $(TKDLL) $(TKSTUBLIB) + +$(TKSTUBLIB): $(TKSTUBOBJS) + $(lib32) /out:$@ $(TKSTUBOBJS) $(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\tk.def set LIB=$(TOOLS32)\lib $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\tk.def \ - -out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLLIB) \ + -out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLSTUBLIB) \ $(guilibsdll) @<< $(TKOBJS) << -$(TKSTUBLIB): $(TKSTUBOBJS) - $(lib32) /out:$@ $(TKSTUBOBJS) - $(TKPLUGINLIB): $(TKPLUGINDLL) $(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\plugin.def @@ -380,23 +393,25 @@ $(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\plugin.def $(TKOBJS) << -$(WISH): $(WISHOBJS) $(TKSTUBLIB) $(TKLIB) $(TMPDIR)\wish.res +$(WISH): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res set LIB=$(TOOLS32)\lib - $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -stack:2300000 \ - -out:$@ \ + $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \ + $(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(WISHOBJS) + +$(WISHC): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res + set LIB=$(TOOLS32)\lib + $(link32) $(ldebug) $(conlflags) $(TMPDIR)\wish.res -out:$@ \ $(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(WISHOBJS) $(WISHP): $(WISHOBJS) $(TKPLUGINLIB) $(TMPDIR)\wish.res set LIB=$(TOOLS32)\lib - $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -stack:2300000 \ - -out:$@ \ + $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \ $(guilibsdll) $(TCLLIBDIR)\$(TCLPLUGINLIB) \ $(TKPLUGINLIB) $(WISHOBJS) -$(TKTEST): $(TKTESTOBJS) $(TKSTUBLIB) $(TMPDIR)\wish.res +$(TKTEST): $(TKTESTOBJS) $(TKLIB) $(TMPDIR)\wish.res set LIB=$(TOOLS32)\lib - $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -stack:2300000 \ - -out:$@ \ + $(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \ $(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(TKTESTOBJS) $(TMPDIR)\tk.def: $(DUMPEXTS) $(TKOBJS) @@ -415,6 +430,11 @@ $(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \ $(TMPDIR)\winDumpExts.obj +$(CAT32): $(TCLDIR)\win\cat.c + $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $? + set LIB=$(TOOLS32)\lib + $(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs) + # # Regenerate the stubs files. # @@ -428,13 +448,13 @@ genstubs: # $(TMPDIR)\testMain.obj: $(ROOT)\win\winMain.c - $(cc32) $(TK_CFLAGS) -DTK_TEST -Fo$@ $? + $(cc32) $(WISH_CFLAGS) -DTK_TEST -Fo$@ $? $(TMPDIR)\tkTest.obj: $(ROOT)\generic\tkTest.c - $(cc32) $(TK_CFLAGS) -Fo$@ $? + $(cc32) $(WISH_CFLAGS) -Fo$@ $? $(TMPDIR)\tkSquare.obj: $(ROOT)\generic\tkSquare.c - $(cc32) $(TK_CFLAGS) -Fo$@ $? + $(cc32) $(WISH_CFLAGS) -Fo$@ $? $(TMPDIR)\winMain.obj: $(ROOT)\win\winMain.c $(cc32) $(WISH_CFLAGS) -Fo$@ $? @@ -456,7 +476,8 @@ $(TMPDIR)\winMain.obj: $(ROOT)\win\winMain.c $(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -Fo$(TMPDIR)\ $< {$(RCDIR)}.rc{$(TMPDIR)}.res: - $(rc32) -fo $@ -r -i $(GENERICDIR) $< + $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TOOLS32)\include" \ + -i "$(TCLDIR)\generic" $< clean: -@del $(OUTDIR)\*.exp diff --git a/win/rc/tk.rc b/win/rc/tk.rc index bab7515..3960c3e 100644 --- a/win/rc/tk.rc +++ b/win/rc/tk.rc @@ -1,8 +1,9 @@ -// RCS: @(#) $Id: tk.rc,v 1.2 1998/09/14 18:24:02 stanton Exp $ +// RCS: @(#) $Id: tk.rc,v 1.3 1999/04/16 01:51:55 stanton Exp $ // // Version // +#include <windows.h> #define RESOURCE_INCLUDED #include <tk.h> @@ -37,6 +38,36 @@ BEGIN END END +#include <dlgs.h> +FILEOPENORD DIALOG DISCARDABLE 36, 24, 218, 138 +STYLE DS_MODALFRAME | DS_3DLOOK | WS_POPUP | WS_CAPTION | WS_SYSMENU +CAPTION "Choose Directory" +FONT 8, "Helv" +BEGIN + LTEXT "Directory &name:",-1,8,6,118,9 + EDITTEXT edt10,8,26,144,12, WS_TABSTOP | ES_AUTOHSCROLL + LISTBOX lst2,8,40,144,64,LBS_SORT | LBS_OWNERDRAWFIXED | + LBS_HASSTRINGS | LBS_NOINTEGRALHEIGHT | + LBS_DISABLENOSCROLL | WS_VSCROLL | WS_TABSTOP + LTEXT "Dri&ves:",stc4,8,106,92,9 + COMBOBOX cmb2,8,115,144,68,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | + CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | + WS_VSCROLL | WS_TABSTOP + DEFPUSHBUTTON "OK",1,160,6,50,14,WS_GROUP + PUSHBUTTON "Cancel",2,160,24,50,14,WS_GROUP + PUSHBUTTON "&Help",psh15,160,42,50,14,WS_GROUP + CHECKBOX "&Read only",chx1,160,66,50,12,WS_GROUP + PUSHBUTTON "Net&work...",psh14,160,115,50,14,WS_GROUP + + LTEXT "a",stc3,9,143,114,15 + EDITTEXT edt1,7,158,135,20,NOT WS_TABSTOP + LISTBOX lst1,8,205,134,42,LBS_NOINTEGRALHEIGHT + COMBOBOX cmb1,8,253,135,21,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | + CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | + WS_VSCROLL + +END + // // Icons // diff --git a/win/tkWin.h b/win/tkWin.h index 191ceea..c9fc84c 100644 --- a/win/tkWin.h +++ b/win/tkWin.h @@ -4,12 +4,12 @@ * Declarations of public types and interfaces that are only * available under Windows. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWin.h,v 1.5 1999/03/10 07:04:46 stanton Exp $ + * RCS: @(#) $Id: tkWin.h,v 1.6 1999/04/16 01:51:48 stanton Exp $ */ #ifndef _TKWIN @@ -28,7 +28,6 @@ # define TCL_STORAGE_CLASS DLLEXPORT #endif - /* * The following messages are use to communicate between a Tk toplevel * and its container window. @@ -47,6 +46,7 @@ * *-------------------------------------------------------------- */ + #include "tkPlatDecls.h" # undef TCL_STORAGE_CLASS diff --git a/win/tkWin32Dll.c b/win/tkWin32Dll.c index bfbdad2..7b43d99 100644 --- a/win/tkWin32Dll.c +++ b/win/tkWin32Dll.c @@ -8,12 +8,13 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWin32Dll.c,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWin32Dll.c,v 1.3 1999/04/16 01:51:48 stanton Exp $ */ -#include "tkPort.h" #include "tkWinInt.h" +static int tkPlatformId; + /* * The following declaration is for the VC++ DLL entry point. */ @@ -70,6 +71,8 @@ DllMain(hInstance, reason, reserved) DWORD reason; LPVOID reserved; { + OSVERSIONINFO os; + /* * If we are attaching to the DLL from a new process, tell Tk about * the hInstance to use. If we are detaching then clean up any @@ -77,9 +80,40 @@ DllMain(hInstance, reason, reserved) */ if (reason == DLL_PROCESS_ATTACH) { + os.dwOSVersionInfoSize = sizeof(os); + GetVersionEx(&os); + tkPlatformId = os.dwPlatformId; + TkWinXInit(hInstance); } else if (reason == DLL_PROCESS_DETACH) { TkWinXCleanup(hInstance); } return(TRUE); } + +/* + *---------------------------------------------------------------------- + * + * TkWinGetPlatformId -- + * + * Determines whether running under NT, 95, or Win32s, to allow + * runtime conditional code. + * + * 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 + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TkWinGetPlatformId() +{ + return tkPlatformId; +} + diff --git a/win/tkWin3d.c b/win/tkWin3d.c index 9b95c63..5f90e60 100644 --- a/win/tkWin3d.c +++ b/win/tkWin3d.c @@ -9,11 +9,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWin3d.c,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWin3d.c,v 1.3 1999/04/16 01:51:49 stanton Exp $ */ -#include <tk3d.h> -#include <tkWinInt.h> +#include "tkWinInt.h" +#include "tk3d.h" /* * This structure is used to keep track of the extra colors used by diff --git a/win/tkWinButton.c b/win/tkWinButton.c index ee9b29e..16fcf9e 100644 --- a/win/tkWinButton.c +++ b/win/tkWinButton.c @@ -4,12 +4,12 @@ * This file implements the Windows specific portion of the button * widgets. * - * Copyright (c) 1996 by Sun Microsystems, Inc. + * Copyright (c) 1996-1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinButton.c,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWinButton.c,v 1.3 1999/04/16 01:51:49 stanton Exp $ */ #define OEMRESOURCE @@ -65,26 +65,20 @@ enum { }; /* - * Set to non-zero if this module is initialized. + * Cached information about the boxes bitmap, and the default border + * width for a button in string form for use in Tk_OptionSpecs for + * the various button widget classes. */ -static int initialized = 0; - -/* - * Variables for the cached information about the boxes bitmap. - */ - -static BITMAPINFOHEADER *boxesPtr = NULL; /* Information about the bitmap. */ -static DWORD *boxesPalette = NULL; /* Pointer to color palette. */ -static LPSTR boxesBits = NULL; /* Pointer to bitmap data. */ -static DWORD boxHeight = 0, boxWidth = 0; /* Size of each sub-image. */ - -/* - * This variable holds the default border width for a button in string - * form for use in a Tk_ConfigSpec. - */ - -static char defWidth[8]; +typedef struct ThreadSpecificData { + BITMAPINFOHEADER *boxesPtr; /* Information about the bitmap. */ + DWORD *boxesPalette; /* Pointer to color palette. */ + LPSTR boxesBits; /* Pointer to bitmap data. */ + DWORD boxHeight; /* Height of each sub-image. */ + DWORD boxWidth ; /* Width of each sub-image. */ + char defWidth[TCL_INTEGER_SPACE]; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Declarations for functions defined in this file. @@ -99,7 +93,6 @@ static DWORD ComputeStyle _ANSI_ARGS_((WinButton* butPtr)); static Window CreateProc _ANSI_ARGS_((Tk_Window tkwin, Window parent, ClientData instanceData)); static void InitBoxes _ANSI_ARGS_((void)); -static void UpdateButtonDefaults _ANSI_ARGS_((void)); /* * The class procedure table for the button widgets. @@ -146,65 +139,75 @@ InitBoxes() HGLOBAL hblk; LPBITMAPINFOHEADER newBitmap; DWORD size; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); hrsrc = FindResource(module, "buttons", RT_BITMAP); if (hrsrc) { hblk = LoadResource(module, hrsrc); - boxesPtr = (LPBITMAPINFOHEADER)LockResource(hblk); + tsdPtr->boxesPtr = (LPBITMAPINFOHEADER)LockResource(hblk); } /* * Copy the DIBitmap into writable memory. */ - if (boxesPtr != NULL && !(boxesPtr->biWidth % 4) - && !(boxesPtr->biHeight % 2)) { - size = boxesPtr->biSize + (1 << boxesPtr->biBitCount) * sizeof(RGBQUAD) - + boxesPtr->biSizeImage; + if (tsdPtr->boxesPtr != NULL && !(tsdPtr->boxesPtr->biWidth % 4) + && !(tsdPtr->boxesPtr->biHeight % 2)) { + size = tsdPtr->boxesPtr->biSize + (1 << tsdPtr->boxesPtr->biBitCount) + * sizeof(RGBQUAD) + tsdPtr->boxesPtr->biSizeImage; newBitmap = (LPBITMAPINFOHEADER) ckalloc(size); - memcpy(newBitmap, boxesPtr, size); - boxesPtr = newBitmap; - boxWidth = boxesPtr->biWidth / 4; - boxHeight = boxesPtr->biHeight / 2; - boxesPalette = (DWORD*) (((LPSTR)boxesPtr) + boxesPtr->biSize); - boxesBits = ((LPSTR)boxesPalette) - + ((1 << boxesPtr->biBitCount) * sizeof(RGBQUAD)); + memcpy(newBitmap, tsdPtr->boxesPtr, size); + tsdPtr->boxesPtr = newBitmap; + tsdPtr->boxWidth = tsdPtr->boxesPtr->biWidth / 4; + tsdPtr->boxHeight = tsdPtr->boxesPtr->biHeight / 2; + tsdPtr->boxesPalette = (DWORD*) (((LPSTR) tsdPtr->boxesPtr) + + tsdPtr->boxesPtr->biSize); + tsdPtr->boxesBits = ((LPSTR) tsdPtr->boxesPalette) + + ((1 << tsdPtr->boxesPtr->biBitCount) * sizeof(RGBQUAD)); } else { - boxesPtr = NULL; + tsdPtr->boxesPtr = NULL; } } /* *---------------------------------------------------------------------- * - * UpdateButtonDefaults -- + * TkpButtonSetDefaults -- * - * This function retrieves the current system defaults for - * the button widgets. + * This procedure is invoked before option tables are created for + * buttons. It modifies some of the default values to match the + * current values defined for this platform. * * Results: - * None. + * Some of the default values in *specPtr are modified. * * Side effects: - * Updates the configuration defaults for buttons. + * Updates some of. * *---------------------------------------------------------------------- */ void -UpdateButtonDefaults() +TkpButtonSetDefaults(specPtr) + Tk_OptionSpec *specPtr; /* Points to an array of option specs, + * terminated by one with type + * TK_OPTION_END. */ { - Tk_ConfigSpec *specPtr; - int width = GetSystemMetrics(SM_CXEDGE); - - if (width == 0) { - width = 1; + int width; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tsdPtr->defWidth[0] == 0) { + width = GetSystemMetrics(SM_CXEDGE); + if (width == 0) { + width = 1; + } + sprintf(tsdPtr->defWidth, "%d", width); } - sprintf(defWidth, "%d", width); - for (specPtr = tkpButtonConfigSpecs; specPtr->type != TK_CONFIG_END; - specPtr++) { - if (specPtr->offset == Tk_Offset(TkButton, borderWidth)) { - specPtr->defValue = defWidth; + for ( ; specPtr->type != TK_OPTION_END; specPtr++) { + if (specPtr->internalOffset == Tk_Offset(TkButton, borderWidth)) { + specPtr->defValue = tsdPtr->defWidth; } } } @@ -231,11 +234,6 @@ TkpCreateButton(tkwin) { WinButton *butPtr; - if (!initialized) { - UpdateButtonDefaults(); - initialized = 1; - } - butPtr = (WinButton *)ckalloc(sizeof(WinButton)); butPtr->hwnd = NULL; return (TkButton *) butPtr; @@ -354,23 +352,28 @@ TkpDisplayButton(clientData) * it is a flavor of button, so we offset * the text to make the button appear to * move up and down as the relief changes. */ + DWORD *boxesPalette; + + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + boxesPalette= tsdPtr->boxesPalette; butPtr->flags &= ~REDRAW_PENDING; if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { return; } border = butPtr->normalBorder; - if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) { + if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { gc = butPtr->disabledGC; - } else if ((butPtr->state == tkActiveUid) + } else if ((butPtr->state == STATE_ACTIVE) && !Tk_StrictMotif(butPtr->tkwin)) { gc = butPtr->activeTextGC; border = butPtr->activeBorder; } else { gc = butPtr->normalTextGC; } - if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid) + if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE) && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) { border = butPtr->selectBorder; } @@ -391,7 +394,7 @@ TkpDisplayButton(clientData) */ if (butPtr->type == TYPE_BUTTON) { - defaultWidth = ((butPtr->defaultState == tkActiveUid) + defaultWidth = ((butPtr->defaultState == DEFAULT_ACTIVE) ? butPtr->highlightWidth : 0); offset = 1; } else { @@ -500,17 +503,17 @@ TkpDisplayButton(clientData) */ if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn - && boxesPtr) { + && tsdPtr->boxesPtr) { int xSrc, ySrc; x -= butPtr->indicatorSpace; y -= butPtr->indicatorDiameter / 2; - xSrc = (butPtr->flags & SELECTED) ? boxWidth : 0; - if (butPtr->state == tkActiveUid) { - xSrc += boxWidth*2; + xSrc = (butPtr->flags & SELECTED) ? tsdPtr->boxWidth : 0; + if (butPtr->state == STATE_ACTIVE) { + xSrc += tsdPtr->boxWidth*2; } - ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : boxHeight; + ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : tsdPtr->boxHeight; /* * Update the palette in the boxes bitmap to reflect the current @@ -530,7 +533,7 @@ TkpDisplayButton(clientData) border, TK_3D_LIGHT2)); boxesPalette[PAL_BOTTOM_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin, border, TK_3D_LIGHT_GC)); - if (butPtr->state == tkDisabledUid) { + if (butPtr->state == STATE_DISABLED) { boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin, border, TK_3D_LIGHT2)); } else if (butPtr->selectBorder != NULL) { @@ -543,9 +546,10 @@ TkpDisplayButton(clientData) border, TK_3D_FLAT_GC)); dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state); - StretchDIBits(dc, x, y, boxWidth, boxHeight, xSrc, ySrc, - boxWidth, boxHeight, boxesBits, (LPBITMAPINFO)boxesPtr, - DIB_RGB_COLORS, SRCCOPY); + StretchDIBits(dc, x, y, tsdPtr->boxWidth, tsdPtr->boxHeight, + xSrc, ySrc, tsdPtr->boxWidth, tsdPtr->boxHeight, + tsdPtr->boxesBits, (LPBITMAPINFO) tsdPtr->boxesPtr, + DIB_RGB_COLORS, SRCCOPY); TkWinReleaseDrawableDC(pixmap, dc, &state); } @@ -556,7 +560,7 @@ TkpDisplayButton(clientData) * must temporarily modify the GC. */ - if ((butPtr->state == tkDisabledUid) + if ((butPtr->state == STATE_DISABLED) && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) { if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn && (butPtr->selectBorder != NULL)) { @@ -636,6 +640,8 @@ TkpComputeButtonGeometry(butPtr) { int width, height, avgWidth; Tk_FontMetrics fm; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (butPtr->highlightWidth < 0) { butPtr->highlightWidth = 0; @@ -643,7 +649,7 @@ TkpComputeButtonGeometry(butPtr) butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth; butPtr->indicatorSpace = 0; - if (!boxesPtr) { + if (!tsdPtr->boxesPtr) { InitBoxes(); } @@ -657,8 +663,8 @@ TkpComputeButtonGeometry(butPtr) height = butPtr->height; } if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) { - butPtr->indicatorSpace = boxWidth * 2; - butPtr->indicatorDiameter = boxHeight; + butPtr->indicatorSpace = tsdPtr->boxWidth * 2; + butPtr->indicatorDiameter = tsdPtr->boxHeight; } } else if (butPtr->bitmap != None) { Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); @@ -666,8 +672,8 @@ TkpComputeButtonGeometry(butPtr) } else { Tk_FreeTextLayout(butPtr->textLayout); butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, - butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0, - &butPtr->textWidth, &butPtr->textHeight); + Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength, + butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); width = butPtr->textWidth; height = butPtr->textHeight; @@ -682,7 +688,7 @@ TkpComputeButtonGeometry(butPtr) } if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) { - butPtr->indicatorDiameter = boxHeight; + butPtr->indicatorDiameter = tsdPtr->boxHeight; butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth; } @@ -788,7 +794,7 @@ ButtonProc(hwnd, message, wParam, lParam) case BN_CLICKED: { int code; Tcl_Interp *interp = butPtr->info.interp; - if (butPtr->info.state != tkDisabledUid) { + if (butPtr->info.state != STATE_DISABLED) { Tcl_Preserve((ClientData)interp); code = TkInvokeButton((TkButton*)butPtr); if (code != TCL_OK && code != TCL_CONTINUE diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c index 8bf9e2b..de0b40c 100644 --- a/win/tkWinClipboard.c +++ b/win/tkWinClipboard.c @@ -3,12 +3,12 @@ * * This file contains functions for managing the clipboard. * - * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinClipboard.c,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWinClipboard.c,v 1.3 1999/04/16 01:51:49 stanton Exp $ */ #include "tkWinInt.h" @@ -27,7 +27,7 @@ * Results: * The return value is a standard Tcl return value. * If an error occurs (such as no selection exists) - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * None. @@ -50,6 +50,7 @@ TkSelGetSelection(interp, tkwin, selection, target, proc, clientData) ClientData clientData; /* Arbitrary value to pass to proc. */ { char *data, *buffer, *destPtr; + Tcl_DString ds; HGLOBAL handle; int result, length; @@ -72,8 +73,10 @@ TkSelGetSelection(interp, tkwin, selection, target, proc, clientData) *destPtr = '\0'; GlobalUnlock(handle); CloseClipboard(); - result = (*proc)(clientData, interp, buffer); + Tcl_ExternalToUtfDString(NULL, buffer, -1, &ds); ckfree(buffer); + result = (*proc)(clientData, interp, Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); return result; } CloseClipboard(); @@ -119,7 +122,7 @@ XSetSelectionOwner(display, selection, owner, time) * It expects a Tk_Window, even though it only needs a Tk_Display. */ - tkwin = (Tk_Window)tkMainWindowList->winPtr; + tkwin = (Tk_Window) TkGetMainInfoList()->winPtr; if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) { @@ -162,8 +165,9 @@ TkWinClipboardRender(dispPtr, format) TkClipboardTarget *targetPtr; TkClipboardBuffer *cbPtr; HGLOBAL handle; - char *buffer, *p, *endPtr; + char *buffer, *p, *rawText, *endPtr; int length; + Tcl_DString ds; for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL; targetPtr = targetPtr->nextPtr) { @@ -183,11 +187,7 @@ TkWinClipboardRender(dispPtr, format) } } } - handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, length+1); - if (!handle) { - return; - } - buffer = GlobalLock(handle); + buffer = rawText = ckalloc(length + 1); if (targetPtr != NULL) { for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL; cbPtr = cbPtr->nextPtr) { @@ -201,7 +201,18 @@ TkWinClipboardRender(dispPtr, format) } } *buffer = '\0'; + Tcl_UtfToExternalDString(NULL, rawText, -1, &ds); + ckfree(rawText); + handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, + Tcl_DStringLength(&ds)+1); + if (!handle) { + Tcl_DStringFree(&ds); + return; + } + buffer = GlobalLock(handle); + memcpy(buffer, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds) + 1); GlobalUnlock(handle); + Tcl_DStringFree(&ds); SetClipboardData(CF_TEXT, handle); return; } diff --git a/win/tkWinColor.c b/win/tkWinColor.c index 2c941ba..febf0cb 100644 --- a/win/tkWinColor.c +++ b/win/tkWinColor.c @@ -9,11 +9,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinColor.c,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWinColor.c,v 1.3 1999/04/16 01:51:49 stanton Exp $ */ -#include <tkColor.h> -#include <tkWinInt.h> +#include "tkWinInt.h" +#include "tkColor.h" /* * The following structure is used to keep track of each color that is @@ -27,12 +27,6 @@ typedef struct WinColor { } WinColor; /* - * colorTable is a hash table used to look up X colors by name. - */ - -static Tcl_HashTable colorTable; - -/* * The sysColors array contains the names and index values for the * Windows indirect system color names. In use, all of the names * will have the string "System" prepended, but we omit it in the table @@ -75,7 +69,10 @@ static SystemColorEntry sysColors[] = { NULL, 0 }; -static int ncolors = 0; +typedef struct ThreadSpecificData { + int ncolors; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations for functions defined later in this file. @@ -111,13 +108,15 @@ FindSystemColor(name, colorPtr, indexPtr) 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 (ncolors == 0) { + if (tsdPtr->ncolors == 0) { SystemColorEntry *ePtr; int version; @@ -130,7 +129,7 @@ FindSystemColor(name, colorPtr, indexPtr) ePtr->index = COLOR_BTNHIGHLIGHT; } } - ncolors++; + tsdPtr->ncolors++; } } @@ -139,7 +138,7 @@ FindSystemColor(name, colorPtr, indexPtr) */ l = 0; - u = ncolors - 1; + u = tsdPtr->ncolors - 1; while (l <= u) { i = (l + u) / 2; r = strcasecmp(name, sysColors[i].name); diff --git a/win/tkWinConfig.c b/win/tkWinConfig.c new file mode 100644 index 0000000..1b4f0a3 --- /dev/null +++ b/win/tkWinConfig.c @@ -0,0 +1,60 @@ +/* + * tkWinConfig.c -- + * + * This module implements the Windows system defaults for + * the configuration package. + * + * Copyright (c) 1997 by Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkWinConfig.c,v 1.2 1999/04/16 01:51:50 stanton Exp $ + */ + +#include "tk.h" +#include "tkInt.h" +#include "tkWinInt.h" + + +/* + *---------------------------------------------------------------------- + * + * TkpGetSystemDefault -- + * + * Given a dbName and className for a configuration option, + * return a string representation of the option. + * + * Results: + * Returns a Tk_Uid that is the string identifier that identifies + * this option. Returns NULL if there are no system defaults + * that match this pair. + * + * Side effects: + * None, once the package is initialized. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkpGetSystemDefault( + Tk_Window tkwin, /* A window to use. */ + char *dbName, /* The option database name. */ + char *className) /* The name of the option class. */ +{ + Tcl_Obj *valueObjPtr; + Tk_Uid classUid; + + if (tkwin == NULL) { + return NULL; + } + + valueObjPtr = NULL; + classUid = Tk_Class(tkwin); + + if (strcmp(classUid, "Menu") == 0) { + valueObjPtr = TkWinGetMenuSystemDefault(tkwin, dbName, className); + } + + return valueObjPtr; +} diff --git a/win/tkWinCursor.c b/win/tkWinCursor.c index 4c26500..2dfba03 100644 --- a/win/tkWinCursor.c +++ b/win/tkWinCursor.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinCursor.c,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWinCursor.c,v 1.3 1999/04/16 01:51:50 stanton Exp $ */ #include "tkWinInt.h" @@ -152,7 +152,7 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot, /* *---------------------------------------------------------------------- * - * TkFreeCursor -- + * TkpFreeCursor -- * * This procedure is called to release a cursor allocated by * TkGetCursorByName. @@ -167,11 +167,10 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot, */ void -TkFreeCursor(cursorPtr) +TkpFreeCursor(cursorPtr) TkCursor *cursorPtr; { TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr; - ckfree((char *) winCursorPtr); } /* diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index ee0f9e5..8f6a29c 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDefault.h,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWinDefault.h,v 1.3 1999/04/16 01:51:50 stanton Exp $ */ #ifndef _TKWINDEFAULT @@ -65,7 +65,8 @@ #define DEF_CHKRAD_FG TEXT_FG #define DEF_BUTTON_FONT CTL_FONT #define DEF_BUTTON_HEIGHT "0" -#define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG +#define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR +#define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO #define DEF_BUTTON_HIGHLIGHT HIGHLIGHT #define DEF_LABEL_HIGHLIGHT_WIDTH "0" #define DEF_BUTTON_HIGHLIGHT_WIDTH "1" @@ -288,7 +289,8 @@ #define DEF_MENUBUTTON_FONT CTL_FONT #define DEF_MENUBUTTON_FG NORMAL_FG #define DEF_MENUBUTTON_HEIGHT "0" -#define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG +#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR +#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 @@ -347,7 +349,8 @@ #define DEF_SCALE_FG_COLOR NORMAL_FG #define DEF_SCALE_FG_MONO BLACK #define DEF_SCALE_FROM "0" -#define DEF_SCALE_HIGHLIGHT_BG NORMAL_BG +#define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR +#define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO #define DEF_SCALE_HIGHLIGHT HIGHLIGHT #define DEF_SCALE_HIGHLIGHT_WIDTH "2" #define DEF_SCALE_LABEL "" diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index aa79171..bb3eb19 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -1,3 +1,4 @@ + /* * tkWinDialog.c -- * @@ -8,10 +9,10 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDialog.c,v 1.2 1998/09/14 18:23:59 stanton Exp $ + * RCS: @(#) $Id: tkWinDialog.c,v 1.3 1999/04/16 01:51:50 stanton Exp $ * */ - + #include "tkWinInt.h" #include "tkFileFilter.h" @@ -19,138 +20,139 @@ #include <dlgs.h> /* includes common dialog template defines */ #include <cderr.h> /* includes the common dialog error codes */ -#if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2)) +typedef struct ThreadSpecificData { + int debugFlag; /* Flags whether we should output debugging + * information while displaying a builtin + * dialog. */ + Tcl_Interp *debugInterp; /* Interpreter to used for debugging. */ + UINT WM_LBSELCHANGED; /* Holds a registered windows event used for + * communicating between the Directory + * Chooser dialog and its hook proc. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + /* - * The following function is implemented on tk4.3 and after only + * The following structures are used by Tk_MessageBox() to parse + * arguments and return results. */ -#define Tk_GetHWND TkWinGetHWND -#endif -#define SAVE_FILE 0 -#define OPEN_FILE 1 +static const TkStateMap iconMap[] = { + {MB_ICONERROR, "error"}, + {MB_ICONINFORMATION, "info"}, + {MB_ICONQUESTION, "question"}, + {MB_ICONWARNING, "warning"}, + {-1, NULL} +}; + +static const TkStateMap typeMap[] = { + {MB_ABORTRETRYIGNORE, "abortretryignore"}, + {MB_OK, "ok"}, + {MB_OKCANCEL, "okcancel"}, + {MB_RETRYCANCEL, "retrycancel"}, + {MB_YESNO, "yesno"}, + {MB_YESNOCANCEL, "yesnocancel"}, + {-1, NULL} +}; -/*---------------------------------------------------------------------- - * MsgTypeInfo -- - * - * This structure stores the type of available message box in an - * easy-to-process format. Used by th Tk_MessageBox() function - *---------------------------------------------------------------------- - */ -typedef struct MsgTypeInfo { - char * name; - int type; - int numButtons; - char * btnNames[3]; -} MsgTypeInfo; - -#define NUM_TYPES 6 - -static MsgTypeInfo -msgTypeInfo[NUM_TYPES] = { - {"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"}} +static const TkStateMap buttonMap[] = { + {IDABORT, "abort"}, + {IDRETRY, "retry"}, + {IDIGNORE, "ignore"}, + {IDOK, "ok"}, + {IDCANCEL, "cancel"}, + {IDNO, "no"}, + {IDYES, "yes"}, + {-1, NULL} +}; + +static const int buttonFlagMap[] = { + MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4 +}; + +static const struct {int type; int btnIds[3];} allowedTypes[] = { + {MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}}, + {MB_OK, {IDOK, -1, -1 }}, + {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }}, + {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }}, + {MB_YESNO, {IDYES, IDNO, -1 }}, + {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}} }; +#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0])) + /* - * The following structure is used in the GetOpenFileName() and - * GetSaveFileName() calls. + * The following structure is used to pass information between the directory + * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc. */ -typedef struct _OpenFileData { - Tcl_Interp * interp; - TCHAR szFile[MAX_PATH+1]; -} OpenFileData; + +typedef struct ChooseDir { + Tcl_Interp *interp; /* Interp, used only if debug is turned on, + * for setting the "tk_dialog" variable. */ + int lastCtrl; /* Used by hook proc to keep track of last + * control that had input focus, so when OK + * is pressed we know whether to browse a + * new directory or return. */ + int lastIdx; /* Last item that was selected in directory + * browser listbox. */ + TCHAR path[MAX_PATH]; /* On return from choose directory dialog, + * holds the selected path. Cannot return + * selected path in ofnPtr->lpstrFile because + * the default dialog proc stores a '\0' in + * it, since, of course, no _file_ was + * selected. */ +} ChooseDir; /* - * The following structure is used in the ChooseColor() call. + * Definitions of procedures used only in this file. */ -typedef struct _ChooseColorData { - Tcl_Interp * interp; - char * title; /* Title of the color dialog */ -} ChooseColorData; - - -static int GetFileName _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv, - int isOpen)); -static UINT CALLBACK ColorDlgHookProc _ANSI_ARGS_((HWND hDlg, UINT uMsg, - WPARAM wParam, LPARAM lParam)); -static int MakeFilter _ANSI_ARGS_((Tcl_Interp *interp, - OPENFILENAME *ofnPtr, char * string)); -static int ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp, - OPENFILENAME *ofnPtr, int argc, char ** argv, - int isOpen)); -static int ProcessCDError _ANSI_ARGS_((Tcl_Interp * interp, - DWORD dwErrorCode, HWND hWnd)); + +static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg, + WPARAM wParam, LPARAM lParam); +static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam, + LPARAM lParam); +static int GetFileName(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[], int isOpen); +static int MakeFilter(Tcl_Interp *interp, char *string, + Tcl_DString *dsPtr); +static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam, + LPARAM lParam); +static void SetTkDialog(ClientData clientData); +static int TrySetDirectory(HWND hwnd, const TCHAR *dir); /* - *---------------------------------------------------------------------- + *------------------------------------------------------------------------- * - * EvalArgv -- + * TkWinDialogDebug -- * - * Invokes the Tcl procedure with the arguments. argv[0] is set by - * the caller of this function. It may be different than cmdName. - * The TCL command will see argv[0], not cmdName, as its name if it - * invokes [lindex [info level 0] 0] + * Function to turn on/off debugging support for common dialogs under + * windows. The variable "tk_debug" is set to the identifier of the + * dialog window when the modal dialog window pops up and it is safe to + * send messages to the dialog. * * Results: - * TCL_ERROR if the command does not exist and cannot be autoloaded. - * Otherwise, return the result of the evaluation of the command. + * None. * * Side effects: - * The command may be autoloaded. + * This variable only makes sense if just one dialog is up at a time. * - *---------------------------------------------------------------------- + *------------------------------------------------------------------------- */ -static int -EvalArgv(interp, cmdName, argc, argv) - Tcl_Interp *interp; /* Current interpreter. */ - char * cmdName; /* Name of the TCL command to call */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ +void +TkWinDialogDebug( + int debug) { - Tcl_CmdInfo cmdInfo; - - if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) { - char * cmdArgv[2]; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - /* - * This comand is not in the interpreter yet -- looks like we - * have to auto-load it - */ - if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "cannot execute command \"auto_load\"", - NULL); - return TCL_ERROR; - } - - cmdArgv[0] = "auto_load"; - cmdArgv[1] = cmdName; - - if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ - return TCL_ERROR; - } - - if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "cannot auto-load command \"", - cmdName, "\"",NULL); - return TCL_ERROR; - } - } - - return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv); + tsdPtr->debugFlag = debug; } /* - *---------------------------------------------------------------------- + *------------------------------------------------------------------------- * - * Tk_ChooseColorCmd -- + * Tk_ChooseColorObjCmd -- * * This procedure implements the color dialog box for the Windows * platform. See the user documentation for details on what it @@ -164,106 +166,105 @@ EvalArgv(interp, cmdName, argc, argv) * This window is not destroyed and will be reused the next time the * application invokes the "tk_chooseColor" command. * - *---------------------------------------------------------------------- + *------------------------------------------------------------------------- */ int -Tk_ChooseColorCmd(clientData, interp, argc, argv) +Tk_ChooseColorObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tk_Window parent = Tk_MainWindow(interp); - ChooseColorData custData; - int oldMode; + Tk_Window tkwin, parent; + int i, oldMode, winCode; CHOOSECOLOR chooseColor; - char * colorStr = NULL; - int i; - int winCode, tclCode; - XColor * colorPtr = NULL; static inited = 0; - static long dwCustColors[16]; + static COLORREF dwCustColors[16]; static long oldColor; /* the color selected last time */ - - custData.title = NULL; - - if (!inited) { + static char *optionStrings[] = { + "-initialcolor", "-parent", "-title", NULL + }; + enum options { + COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE + }; + + if (inited == 0) { /* * dwCustColors stores the custom color which the user can - * modify. We store these colors in a fixed array so that the next + * modify. We store these colors in a static array so that the next * time the color dialog pops up, the same set of custom colors * remain in the dialog. */ - for (i=0; i<16; i++) { - dwCustColors[i] = (RGB(255-i*10, i, i*10)) ; + for (i = 0; i < 16; i++) { + dwCustColors[i] = RGB(255-i * 10, i, i * 10); } - oldColor = RGB(0xa0,0xa0,0xa0); + oldColor = RGB(0xa0, 0xa0, 0xa0); inited = 1; } - /* - * 1. Parse the arguments - */ - - chooseColor.lStructSize = sizeof(CHOOSECOLOR) ; - chooseColor.hwndOwner = 0; /* filled in below */ - chooseColor.hInstance = 0; - chooseColor.rgbResult = oldColor; - chooseColor.lpCustColors = (LPDWORD) dwCustColors ; - chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK; - chooseColor.lCustData = (LPARAM)&custData; - chooseColor.lpfnHook = ColorDlgHookProc; - chooseColor.lpTemplateName = NULL; - - for (i=1; i<argc; i+=2) { - int v = i+1; - int len = strlen(argv[i]); - - if (strncmp(argv[i], "-initialcolor", len)==0) { - if (v==argc) {goto arg_missing;} - - colorStr = argv[v]; + tkwin = (Tk_Window) clientData; + + parent = tkwin; + chooseColor.lStructSize = sizeof(CHOOSECOLOR) ; + chooseColor.hwndOwner = 0; + chooseColor.hInstance = 0; + chooseColor.rgbResult = oldColor; + chooseColor.lpCustColors = dwCustColors ; + chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK; + chooseColor.lCustData = (LPARAM) NULL; + chooseColor.lpfnHook = ColorDlgHookProc; + chooseColor.lpTemplateName = (LPTSTR) interp; + + for (i = 1; i < objc; i += 2) { + int index; + char *string; + Tcl_Obj *optionPtr, *valuePtr; + + optionPtr = objv[i]; + valuePtr = objv[i + 1]; + + if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", + TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; } - else if (strncmp(argv[i], "-parent", len)==0) { - if (v==argc) {goto arg_missing;} - - parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp)); - if (parent == NULL) { - return TCL_ERROR; - } + if (i + 1 == objc) { + string = Tcl_GetStringFromObj(optionPtr, NULL); + Tcl_AppendResult(interp, "value for \"", string, "\" missing", + (char *) NULL); + return TCL_ERROR; } - else if (strncmp(argv[i], "-title", len)==0) { - if (v==argc) {goto arg_missing;} - custData.title = argv[v]; - } - else { - Tcl_AppendResult(interp, "unknown option \"", - argv[i], "\", must be -initialcolor, -parent or -title", - NULL); - return TCL_ERROR; + string = Tcl_GetStringFromObj(valuePtr, NULL); + switch ((enum options) index) { + case COLOR_INITIAL: { + XColor *colorPtr; + + colorPtr = Tk_GetColor(interp, tkwin, string); + if (colorPtr == NULL) { + return TCL_ERROR; + } + chooseColor.rgbResult = RGB(colorPtr->red / 0x100, + colorPtr->green / 0x100, colorPtr->blue / 0x100); + break; + } + case COLOR_PARENT: { + parent = Tk_NameToWindow(interp, string, tkwin); + if (parent == NULL) { + return TCL_ERROR; + } + break; + } + case COLOR_TITLE: { + chooseColor.lCustData = (LPARAM) string; + break; + } } } - if (Tk_WindowId(parent) == None) { - Tk_MakeWindowExist(parent); - } + Tk_MakeWindowExist(parent); chooseColor.hwndOwner = Tk_GetHWND(Tk_WindowId(parent)); - if (colorStr != NULL) { - colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp), colorStr); - if (!colorPtr) { - return TCL_ERROR; - } - chooseColor.rgbResult = RGB((colorPtr->red/0x100), - (colorPtr->green/0x100), (colorPtr->blue/0x100)); - } - - /* - * 2. Popup the dialog - */ - oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); winCode = ChooseColor(&chooseColor); (void) Tcl_SetServiceMode(oldMode); @@ -278,6 +279,7 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv) /* * 3. Process the result of the dialog */ + if (winCode) { /* * User has selected a color @@ -285,75 +287,67 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv) char result[100]; sprintf(result, "#%02x%02x%02x", - GetRValue(chooseColor.rgbResult), - GetGValue(chooseColor.rgbResult), - GetBValue(chooseColor.rgbResult)); + GetRValue(chooseColor.rgbResult), + GetGValue(chooseColor.rgbResult), + GetBValue(chooseColor.rgbResult)); Tcl_AppendResult(interp, result, NULL); - tclCode = TCL_OK; - oldColor = chooseColor.rgbResult; - } else { - /* - * User probably pressed Cancel, or an error occurred - */ - tclCode = ProcessCDError(interp, CommDlgExtendedError(), - chooseColor.hwndOwner); - } - - if (colorPtr) { - Tk_FreeColor(colorPtr); } - - return tclCode; - - arg_missing: - Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", - NULL); - return TCL_ERROR; + return TCL_OK; } /* - *---------------------------------------------------------------------- + *------------------------------------------------------------------------- * * ColorDlgHookProc -- * - * Gets called during the execution of the color dialog. It processes - * the "interesting" messages that Windows send to the dialog. + * Provides special handling of messages for the Color common dialog + * box. Used to set the title when the dialog first appears. * * Results: - * TRUE if the message has been processed, FALSE otherwise. + * The return value is 0 if the default dialog box procedure should + * handle the message, non-zero otherwise. * * Side effects: - * Changes the title of the dialog window when it is popped up. + * Changes the title of the dialog window. * *---------------------------------------------------------------------- */ -static UINT -CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam) - HWND hDlg; /* Handle to the color dialog */ - UINT uMsg; /* Type of message */ - WPARAM wParam; /* word param, interpretation depends on uMsg*/ - LPARAM lParam; /* long param, interpretation depends on uMsg*/ +static UINT CALLBACK +ColorDlgHookProc(hDlg, uMsg, wParam, lParam) + HWND hDlg; /* Handle to the color dialog. */ + UINT uMsg; /* Type of message. */ + WPARAM wParam; /* First message parameter. */ + LPARAM lParam; /* Second message parameter. */ { - CHOOSECOLOR * ccPtr; - ChooseColorData * pCustData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); switch (uMsg) { - case WM_INITDIALOG: - /* Save the pointer to CHOOSECOLOR so that we can use it later */ - SetWindowLong(hDlg, DWL_USER, lParam); - - /* Set the title string of the dialog */ - ccPtr = (CHOOSECOLOR*)lParam; - pCustData = (ChooseColorData*)(ccPtr->lCustData); - if (pCustData->title && *(pCustData->title)) { - SetWindowText(hDlg, (LPCSTR)pCustData->title); - } + case WM_INITDIALOG: { + const char *title; + CHOOSECOLOR *ccPtr; + Tcl_DString ds; - return TRUE; - } + /* + * Set the title string of the dialog. + */ + ccPtr = (CHOOSECOLOR *) lParam; + title = (const char *) ccPtr->lCustData; + if ((title != NULL) && (title[0] != '\0')) { + Tcl_UtfToExternalDString(NULL, title, -1, &ds); + SetWindowText(hDlg, (TCHAR *) Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + } + if (tsdPtr->debugFlag) { + tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName; + Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg); + } + return TRUE; + } + } return FALSE; } @@ -371,21 +365,18 @@ CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam) * * Side effects: * A dialog window is created the first this procedure is called. - * This window is not destroyed and will be reused the next time - * the application invokes the "tk_getOpenFile" or - * "tk_getSaveFile" command. * *---------------------------------------------------------------------- */ int -Tk_GetOpenFileCmd(clientData, interp, argc, argv) +Tk_GetOpenFileObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - return GetFileName(clientData, interp, argc, argv, OPEN_FILE); + return GetFileName(clientData, interp, objc, objv, 1); } /* @@ -406,13 +397,13 @@ Tk_GetOpenFileCmd(clientData, interp, argc, argv) */ int -Tk_GetSaveFileCmd(clientData, interp, argc, argv) +Tk_GetSaveFileObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - return GetFileName(clientData, interp, argc, argv, SAVE_FILE); + return GetFileName(clientData, interp, objc, objv, 0); } /* @@ -432,41 +423,197 @@ Tk_GetSaveFileCmd(clientData, interp, argc, argv) */ static int -GetFileName(clientData, interp, argc, argv, isOpen) +GetFileName(clientData, interp, objc, objv, open) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ - int isOpen; /* true if we should call GetOpenFileName(), - * false if we should call GetSaveFileName() */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ + int open; /* 1 to call GetOpenFileName(), 0 to + * call GetSaveFileName(). */ { - OPENFILENAME openFileName, *ofnPtr; - int tclCode, winCode, oldMode; - OpenFileData *custData; - char buffer[MAX_PATH+1]; - - ofnPtr = &openFileName; + OPENFILENAME ofn; + TCHAR file[MAX_PATH], savePath[MAX_PATH]; + int result, winCode, oldMode, i; + char *extension, *filter, *title; + Tk_Window tkwin; + Tcl_DString utfFilterString, utfDirString; + Tcl_DString extString, filterString, dirString, titleString; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + static char *optionStrings[] = { + "-defaultextension", "-filetypes", "-initialdir", "-initialfile", + "-parent", "-title", NULL + }; + enum options { + FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, + FILE_PARENT, FILE_TITLE + }; + + result = TCL_ERROR; + file[0] = '\0'; /* - * 1. Parse the arguments. + * Parse the arguments. */ - if (ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) != TCL_OK) { - return TCL_ERROR; + + extension = NULL; + filter = NULL; + Tcl_DStringInit(&utfFilterString); + Tcl_DStringInit(&utfDirString); + tkwin = (Tk_Window) clientData; + title = NULL; + + for (i = 1; i < objc; i += 2) { + int index; + char *string; + Tcl_Obj *optionPtr, *valuePtr; + + optionPtr = objv[i]; + valuePtr = objv[i + 1]; + + if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", + 0, &index) != TCL_OK) { + goto end; + } + if (i + 1 == objc) { + string = Tcl_GetStringFromObj(optionPtr, NULL); + Tcl_AppendResult(interp, "value for \"", string, "\" missing", + (char *) NULL); + goto end; + } + + string = Tcl_GetStringFromObj(valuePtr, NULL); + switch ((enum options) index) { + case FILE_DEFAULT: { + if (string[0] == '.') { + string++; + } + extension = string; + break; + } + case FILE_TYPES: { + Tcl_DStringFree(&utfFilterString); + if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) { + goto end; + } + filter = Tcl_DStringValue(&utfFilterString); + break; + } + case FILE_INITDIR: { + Tcl_DStringFree(&utfDirString); + if (Tcl_TranslateFileName(interp, string, + &utfDirString) == NULL) { + goto end; + } + break; + } + case FILE_INITFILE: { + Tcl_DString ds; + + if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { + goto end; + } + Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds), 0, NULL, (char *) file, + sizeof(file), NULL, NULL, NULL); + break; + } + case FILE_PARENT: { + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { + goto end; + } + break; + } + case FILE_TITLE: { + title = string; + break; + } + } + } + + if (filter == NULL) { + if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) { + goto end; + } + } + + Tk_MakeWindowExist(tkwin); + + ofn.lStructSize = sizeof(ofn); + ofn.hwndOwner = Tk_GetHWND(Tk_WindowId(tkwin)); + ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner, + GWL_HINSTANCE); + ofn.lpstrFilter = NULL; + ofn.lpstrCustomFilter = NULL; + ofn.nMaxCustFilter = 0; + ofn.nFilterIndex = 0; + ofn.lpstrFile = (LPTSTR) file; + ofn.nMaxFile = MAX_PATH; + ofn.lpstrFileTitle = NULL; + ofn.nMaxFileTitle = 0; + ofn.lpstrInitialDir = NULL; + ofn.lpstrTitle = NULL; + ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST + | OFN_NOCHANGEDIR; + ofn.nFileOffset = 0; + ofn.nFileExtension = 0; + ofn.lpstrDefExt = NULL; + ofn.lpfnHook = OFNHookProc; + ofn.lCustData = (LPARAM) interp; + ofn.lpTemplateName = NULL; + + if (LOBYTE(LOWORD(GetVersion())) >= 4) { + /* + * Use the "explorer" style file selection box on platforms that + * support it (Win95 and NT4.0 both have a major version number + * of 4). + */ + + ofn.Flags |= OFN_EXPLORER; + } + + if (open != 0) { + ofn.Flags |= OFN_FILEMUSTEXIST; + } else { + ofn.Flags |= OFN_OVERWRITEPROMPT; + } + + if (tsdPtr->debugFlag != 0) { + ofn.Flags |= OFN_ENABLEHOOK; + } + + if (extension != NULL) { + Tcl_UtfToExternalDString(NULL, extension, -1, &extString); + ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString); + } + Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString), + Tcl_DStringLength(&utfFilterString), &filterString); + ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString); + + if (Tcl_DStringValue(&utfDirString)[0] != '\0') { + Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString), + Tcl_DStringLength(&utfDirString), &dirString); + ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString); + } + if (title != NULL) { + Tcl_UtfToExternalDString(NULL, title, -1, &titleString); + ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString); } - custData = (OpenFileData*) ofnPtr->lCustData; /* - * 2. Call the common dialog function. + * Popup the dialog. */ + + GetCurrentDirectory(MAX_PATH, savePath); oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - GetCurrentDirectory(MAX_PATH+1, buffer); - if (isOpen) { - winCode = GetOpenFileName(ofnPtr); + if (open != 0) { + winCode = GetOpenFileName(&ofn); } else { - winCode = GetSaveFileName(ofnPtr); + winCode = GetSaveFileName(&ofn); } - SetCurrentDirectory(buffer); - (void) Tcl_SetServiceMode(oldMode); + Tcl_SetServiceMode(oldMode); + SetCurrentDirectory(savePath); /* * Clear the interp result since anything may have happened during the @@ -475,18 +622,16 @@ GetFileName(clientData, interp, argc, argv, isOpen) Tcl_ResetResult(interp); - if (ofnPtr->lpstrInitialDir != NULL) { - ckfree((char*) ofnPtr->lpstrInitialDir); - } - /* - * 3. Process the results. + * Process the results. */ - if (winCode) { + + if (winCode != 0) { char *p; - Tcl_ResetResult(interp); + Tcl_DString ds; - for (p = custData->szFile; p && *p; p++) { + Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds); + for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { /* * Change the pathname to the Tcl "normalized" pathname, where * back slashes are used instead of forward slashes @@ -495,177 +640,80 @@ GetFileName(clientData, interp, argc, argv, isOpen) *p = '/'; } } - Tcl_AppendResult(interp, custData->szFile, NULL); - tclCode = TCL_OK; - } else { - tclCode = ProcessCDError(interp, CommDlgExtendedError(), - ofnPtr->hwndOwner); + Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); + Tcl_DStringFree(&ds); } - if (custData) { - ckfree((char*)custData); + if (ofn.lpstrTitle != NULL) { + Tcl_DStringFree(&titleString); + } + if (ofn.lpstrInitialDir != NULL) { + Tcl_DStringFree(&dirString); } - if (ofnPtr->lpstrFilter) { - ckfree((char*)ofnPtr->lpstrFilter); + Tcl_DStringFree(&filterString); + if (ofn.lpstrDefExt != NULL) { + Tcl_DStringFree(&extString); } + result = TCL_OK; + + end: + Tcl_DStringFree(&utfDirString); + Tcl_DStringFree(&utfFilterString); - return tclCode; + return result; } /* - *---------------------------------------------------------------------- + *------------------------------------------------------------------------- * - * ParseFileDlgArgs -- + * OFNHookProc -- * - * Parses the arguments passed to tk_getOpenFile and tk_getSaveFile. + * Hook procedure called only if debugging is turned on. Sets + * the "tk_dialog" variable when the dialog is ready to receive + * messages. * * Results: - * A standard TCL return value. + * Returns 0 to allow default processing of messages to occur. * * Side effects: - * The OPENFILENAME structure is initialized and modified according - * to the arguments. + * None. * - *---------------------------------------------------------------------- + *------------------------------------------------------------------------- */ -static int -ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) - Tcl_Interp * interp; /* Current interpreter. */ - OPENFILENAME *ofnPtr; /* Info about the file dialog */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ - int isOpen; /* true if we should call GetOpenFileName(), - * false if we should call GetSaveFileName() */ +static UINT APIENTRY +OFNHookProc( + HWND hdlg, // handle to child dialog window + UINT uMsg, // message identifier + WPARAM wParam, // message parameter + LPARAM lParam) // message parameter { - OpenFileData * custData; - int i; - Tk_Window parent = Tk_MainWindow(interp); - int doneFilter = 0; - int windowsMajorVersion; - Tcl_DString buffer; - - custData = (OpenFileData*)ckalloc(sizeof(OpenFileData)); - custData->interp = interp; - strcpy(custData->szFile, ""); - - /* Fill in the OPENFILENAME structure to */ - ofnPtr->lStructSize = sizeof(OPENFILENAME); - ofnPtr->hwndOwner = 0; /* filled in below */ - ofnPtr->lpstrFilter = NULL; - ofnPtr->lpstrCustomFilter = NULL; - ofnPtr->nMaxCustFilter = 0; - ofnPtr->nFilterIndex = 0; - ofnPtr->lpstrFile = custData->szFile; - ofnPtr->nMaxFile = sizeof(custData->szFile); - ofnPtr->lpstrFileTitle = NULL; - ofnPtr->nMaxFileTitle = 0; - ofnPtr->lpstrInitialDir = NULL; - ofnPtr->lpstrTitle = NULL; - ofnPtr->nFileOffset = 0; - ofnPtr->nFileExtension = 0; - ofnPtr->lpstrDefExt = NULL; - ofnPtr->lpfnHook = NULL; - ofnPtr->lCustData = (DWORD)custData; - ofnPtr->lpTemplateName = NULL; - ofnPtr->Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST; - - windowsMajorVersion = LOBYTE(LOWORD(GetVersion())); - if (windowsMajorVersion >= 4) { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + OPENFILENAME *ofnPtr; + + if (uMsg == WM_INITDIALOG) { + SetWindowLong(hdlg, GWL_USERDATA, lParam); + } else if (uMsg == WM_WINDOWPOSCHANGED) { /* - * Use the "explorer" style file selection box on platforms that - * support it (Win95 and NT4.0, both have a major version number - * of 4) + * This message is delivered at the right time to both + * old-style and explorer-style hook procs to enable Tk + * to set the debug information. Unhooks itself so it + * won't set the debug information every time it gets a + * WM_WINDOWPOSCHANGED message. */ - ofnPtr->Flags |= OFN_EXPLORER; - } - - - if (isOpen) { - ofnPtr->Flags |= OFN_FILEMUSTEXIST; - } else { - ofnPtr->Flags |= OFN_OVERWRITEPROMPT; - } - - for (i=1; i<argc; i+=2) { - int v = i+1; - int len = strlen(argv[i]); - - if (strncmp(argv[i], "-defaultextension", len)==0) { - if (v==argc) {goto arg_missing;} - - ofnPtr->lpstrDefExt = argv[v]; - if (ofnPtr->lpstrDefExt[0] == '.') { - /* Windows will insert the dot for us */ - ofnPtr->lpstrDefExt ++; - } - } - else if (strncmp(argv[i], "-filetypes", len)==0) { - if (v==argc) {goto arg_missing;} - - if (MakeFilter(interp, ofnPtr, argv[v]) != TCL_OK) { - return TCL_ERROR; - } - doneFilter = 1; - } - else if (strncmp(argv[i], "-initialdir", len)==0) { - if (v==argc) {goto arg_missing;} - - if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) { - return TCL_ERROR; - } - ofnPtr->lpstrInitialDir = ckalloc(Tcl_DStringLength(&buffer)+1); - strcpy((char*)ofnPtr->lpstrInitialDir, Tcl_DStringValue(&buffer)); - Tcl_DStringFree(&buffer); - } - else if (strncmp(argv[i], "-initialfile", len)==0) { - if (v==argc) {goto arg_missing;} - if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) { - return TCL_ERROR; + ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA); + if (ofnPtr != NULL) { + if (ofnPtr->Flags & OFN_EXPLORER) { + hdlg = GetParent(hdlg); } - strcpy(ofnPtr->lpstrFile, Tcl_DStringValue(&buffer)); - Tcl_DStringFree(&buffer); + tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData; + Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg); + SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL); } - else if (strncmp(argv[i], "-parent", len)==0) { - if (v==argc) {goto arg_missing;} - - parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp)); - if (parent == NULL) { - return TCL_ERROR; - } - } - else if (strncmp(argv[i], "-title", len)==0) { - if (v==argc) {goto arg_missing;} - - ofnPtr->lpstrTitle = argv[v]; - } - else { - Tcl_AppendResult(interp, "unknown option \"", - argv[i], "\", must be -defaultextension, ", - "-filetypes, -initialdir, -initialfile, -parent or -title", - NULL); - return TCL_ERROR; - } - } - - if (!doneFilter) { - if (MakeFilter(interp, ofnPtr, "") != TCL_OK) { - return TCL_ERROR; - } - } - - if (Tk_WindowId(parent) == None) { - Tk_MakeWindowExist(parent); } - ofnPtr->hwndOwner = Tk_GetHWND(Tk_WindowId(parent)); - - return TCL_OK; - - arg_missing: - Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", - NULL); - return TCL_ERROR; + return 0; } /* @@ -684,10 +732,11 @@ ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) * *---------------------------------------------------------------------- */ -static int MakeFilter(interp, ofnPtr, string) +static int +MakeFilter(interp, string, dsPtr) Tcl_Interp *interp; /* Current interpreter. */ - OPENFILENAME *ofnPtr; /* Info about the file dialog */ char *string; /* String value of the -filetypes option */ + Tcl_DString *dsPtr; /* Filled with windows filter string. */ { char *filterStr; char *p; @@ -702,7 +751,7 @@ static int MakeFilter(interp, ofnPtr, string) if (flist.filters == NULL) { /* - * Use "All Files (*.*) as the default filter is none is specified + * Use "All Files (*.*) as the default filter if none is specified */ char *defaultFilter = "All Files (*.*)"; @@ -790,10 +839,8 @@ static int MakeFilter(interp, ofnPtr, string) *p = '\0'; } - if (ofnPtr->lpstrFilter != NULL) { - ckfree((char*)ofnPtr->lpstrFilter); - } - ofnPtr->lpstrFilter = filterStr; + Tcl_DStringAppend(dsPtr, filterStr, p - filterStr); + ckfree((char *) filterStr); TkFreeFileFilters(&flist); return TCL_OK; @@ -802,249 +849,583 @@ static int MakeFilter(interp, ofnPtr, string) /* *---------------------------------------------------------------------- * - * Tk_MessageBoxCmd -- + * Tk_ChooseDirectoryObjCmd -- * - * This procedure implements the MessageBox window for the - * Windows platform. See the user documentation for details on what - * it does. + * This procedure implements the "tk_chooseDirectory" dialog box + * for the Windows platform. See the user documentation for details + * on what it does. * * Results: * See user documentation. * * Side effects: - * None. The MessageBox window will be destroy before this procedure - * returns. + * A modal dialog window is created. Tcl_SetServiceMode() is + * called to allow background events to be processed * *---------------------------------------------------------------------- */ int -Tk_MessageBoxCmd(clientData, interp, argc, argv) +Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int flags; - Tk_Window parent = Tk_MainWindow(interp); - HWND hWnd; - char *message = ""; - char *title = ""; - int icon = MB_ICONINFORMATION; - int type = MB_OK; - int i, j; - char *result; - int code, oldMode; - char *defaultBtn = NULL; - int defaultBtnIdx = -1; - - for (i=1; i<argc; i+=2) { - int v = i+1; - int len = strlen(argv[i]); - - if (strncmp(argv[i], "-default", len)==0) { - if (v==argc) {goto arg_missing;} - - defaultBtn = argv[v]; + OPENFILENAME ofn; + TCHAR path[MAX_PATH], savePath[MAX_PATH]; + ChooseDir cd; + int result, mustExist, code, mode, i; + Tk_Window tkwin; + char *utfTitle; + Tcl_DString utfDirString; + Tcl_DString titleString, dirString; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + static char *optionStrings[] = { + "-initialdir", "-mustexist", "-parent", "-title", + NULL + }; + enum options { + DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE + }; + + if (tsdPtr->WM_LBSELCHANGED == 0) { + tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING); + } + + result = TCL_ERROR; + path[0] = '\0'; + + Tcl_DStringInit(&utfDirString); + mustExist = 0; + tkwin = (Tk_Window) clientData; + utfTitle = NULL; + + for (i = 1; i < objc; i += 2) { + int index; + char *string; + 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_GetStringFromObj(optionPtr, NULL); + Tcl_AppendResult(interp, "value for \"", string, "\" missing", + (char *) NULL); + goto cleanup; } - else if (strncmp(argv[i], "-icon", len)==0) { - if (v==argc) {goto arg_missing;} - if (strcmp(argv[v], "error") == 0) { - icon = MB_ICONERROR; + string = Tcl_GetStringFromObj(valuePtr, NULL); + switch ((enum options) index) { + case DIR_INITIAL: { + Tcl_DStringFree(&utfDirString); + if (Tcl_TranslateFileName(interp, string, + &utfDirString) == NULL) { + goto cleanup; + } + break; } - else if (strcmp(argv[v], "info") == 0) { - icon = MB_ICONINFORMATION; + case DIR_EXIST: { + if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) { + goto cleanup; + } + break; } - else if (strcmp(argv[v], "question") == 0) { - icon = MB_ICONQUESTION; + case DIR_PARENT: { + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { + goto cleanup; + } + break; } - else if (strcmp(argv[v], "warning") == 0) { - icon = MB_ICONWARNING; + case FILE_TITLE: { + utfTitle = string; + break; } - else { - Tcl_AppendResult(interp, "invalid icon \"", argv[v], - "\", must be error, info, question or warning", NULL); - return TCL_ERROR; + } + } + + Tk_MakeWindowExist(tkwin); + + cd.interp = interp; + + ofn.lStructSize = sizeof(ofn); + ofn.hwndOwner = Tk_GetHWND(Tk_WindowId(tkwin)); + ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner, + GWL_HINSTANCE); + ofn.lpstrFilter = NULL; + ofn.lpstrCustomFilter = NULL; + ofn.nMaxCustFilter = 0; + ofn.nFilterIndex = 0; + ofn.lpstrFile = NULL; //(TCHAR *) path; + ofn.nMaxFile = MAX_PATH; + ofn.lpstrFileTitle = NULL; + ofn.nMaxFileTitle = 0; + ofn.lpstrInitialDir = NULL; + ofn.lpstrTitle = NULL; + ofn.Flags = OFN_HIDEREADONLY + | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE; + ofn.nFileOffset = 0; + ofn.nFileExtension = 0; + ofn.lpstrDefExt = NULL; + ofn.lCustData = (LPARAM) &cd; + ofn.lpfnHook = ChooseDirectoryHookProc; + ofn.lpTemplateName = MAKEINTRESOURCE(FILEOPENORD); + + if (Tcl_DStringValue(&utfDirString)[0] != '\0') { + Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString), + Tcl_DStringLength(&utfDirString), &dirString); + ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString); + } + if (mustExist) { + ofn.Flags |= OFN_PATHMUSTEXIST; + } + if (utfTitle != NULL) { + Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString); + ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString); + } + + /* + * Display dialog. The choose directory dialog doesn't preserve the + * current directory, so it must be saved and restored here. + */ + + GetCurrentDirectory(MAX_PATH, savePath); + mode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + code = GetOpenFileName(&ofn); + Tcl_SetServiceMode(mode); + SetCurrentDirectory(savePath); + + Tcl_ResetResult(interp); + if (code != 0) { + /* + * Change the pathname to the Tcl "normalized" pathname, where + * back slashes are used instead of forward slashes + */ + + char *p; + Tcl_DString ds; + + Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds); + for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; } } - else if (strncmp(argv[i], "-message", len)==0) { - if (v==argc) {goto arg_missing;} + Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); + Tcl_DStringFree(&ds); + } - message = argv[v]; + if (ofn.lpstrTitle != NULL) { + Tcl_DStringFree(&titleString); + } + if (ofn.lpstrInitialDir != NULL) { + Tcl_DStringFree(&dirString); + } + result = TCL_OK; + + cleanup: + Tcl_DStringFree(&utfDirString); + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * ChooseDirectoryHookProc -- + * + * Hook procedure called by the ChooseDirectory dialog to modify + * its default behavior. The ChooseDirectory dialog is really an + * OpenFile dialog with certain controls rearranged and certain + * behaviors changed. For instance, typing a name in the + * ChooseDirectory dialog selects a directory, rather than + * selecting a file. + * + * Results: + * Returns 0 to allow default processing of message, or 1 to + * tell default dialog procedure not to process the message. + * + * Side effects: + * A dialog window is created the first this procedure is called. + * This window is not destroyed and will be reused the next time + * the application invokes the "tk_getOpenFile" or + * "tk_getSaveFile" command. + * + *---------------------------------------------------------------------- + */ + +static UINT APIENTRY +ChooseDirectoryHookProc( + HWND hwnd, + UINT message, + WPARAM wParam, + LPARAM lParam) +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + OPENFILENAME *ofnPtr; + + /* + * GWL_USERDATA keeps track of ofnPtr. + */ + + ofnPtr = (OPENFILENAME *) GetWindowLong(hwnd, GWL_USERDATA); + + if (message == WM_INITDIALOG) { + ChooseDir *cdPtr; + + SetWindowLong(hwnd, GWL_USERDATA, lParam); + ofnPtr = (OPENFILENAME *) lParam; + cdPtr = (ChooseDir *) ofnPtr->lCustData; + cdPtr->lastCtrl = 0; + cdPtr->lastIdx = 1000; + cdPtr->path[0] = '\0'; + + if (ofnPtr->lpstrInitialDir == NULL) { + GetCurrentDirectory(MAX_PATH, cdPtr->path); + } else { + lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir); } - else if (strncmp(argv[i], "-parent", len)==0) { - if (v==argc) {goto arg_missing;} + SetDlgItemText(hwnd, edt10, cdPtr->path); + SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); + if (tsdPtr->debugFlag) { + tsdPtr->debugInterp = cdPtr->interp; + Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd); + } + return 0; + } + if (ofnPtr == NULL) { + return 0; + } - parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp)); - if (parent == NULL) { - return TCL_ERROR; + if (message == tsdPtr->WM_LBSELCHANGED) { + /* + * Called when double-clicking on directory. + * If directory wasn't already open, browse that directory. + * If directory was already open, return selected directory. + */ + + ChooseDir *cdPtr; + int idCtrl, thisItem; + + idCtrl = (int) wParam; + thisItem = LOWORD(lParam); + cdPtr = (ChooseDir *) ofnPtr->lCustData; + + GetCurrentDirectory(MAX_PATH, cdPtr->path); + if (idCtrl == lst2) { + if ((cdPtr->lastIdx < 0) || (cdPtr->lastIdx == thisItem)) { + EndDialog(hwnd, IDOK); + return 1; } + cdPtr->lastIdx = thisItem; } - else if (strncmp(argv[i], "-title", len)==0) { - if (v==argc) {goto arg_missing;} + SetDlgItemText(hwnd, edt10, cdPtr->path); + SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); + } else if (message == WM_COMMAND) { + ChooseDir *cdPtr; + int idCtrl, notifyCode; + + idCtrl = LOWORD(wParam); + notifyCode = HIWORD(wParam); + cdPtr = (ChooseDir *) ofnPtr->lCustData; + + if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) { + /* + * OK Button wasn't clicked. Do the default. + */ - title = argv[v]; + if ((idCtrl == lst2) || (idCtrl == edt10)) { + cdPtr->lastCtrl = idCtrl; + } + return 0; } - else if (strncmp(argv[i], "-type", len)==0) { - int found = 0; - if (v==argc) {goto arg_missing;} + /* + * Dialogs also get the message that OK was clicked when Enter + * is pressed in some other control. Find out what window + * we were really in when we got the supposed "OK", because the + * behavior is different. + */ + + if (cdPtr->lastCtrl == edt10) { + /* + * Hit Enter or clicked OK while typing a directory name in the + * edit control. + * If it's a new name, try to go to that directory. + * If the name hasn't changed since last time, return selected + * directory. + */ - for (j=0; j<NUM_TYPES; j++) { - if (strcmp(argv[v], msgTypeInfo[j].name) == 0) { - type = msgTypeInfo[j].type; - found = 1; - break; + int changed; + TCHAR tmp[MAX_PATH]; + + if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) { + return 0; + } + + changed = lstrcmp(cdPtr->path, tmp); + lstrcpy(cdPtr->path, tmp); + + if (SetCurrentDirectory(cdPtr->path) == 0) { + /* + * Non-existent directory. + */ + + if (ofnPtr->Flags & OFN_PATHMUSTEXIST) { + /* + * Directory must exist. Complain, then rehighlight text. + */ + + wsprintf(tmp, _T("Cannot change directory to \"%.200s\"."), + cdPtr->path); + MessageBox(hwnd, tmp, NULL, MB_OK); + SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); + return 0; + } + if (changed) { + /* + * Directory was invalid, but we want to keep displaying + * this name. Don't update the listbox that displays the + * current directory heirarchy, or it'll erase the name. + */ + + SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); + return 0; } } - if (!found) { - Tcl_AppendResult(interp, "invalid message box type \"", - argv[v], "\", must be abortretryignore, ok, ", - "okcancel, retrycancel, yesno or yesnocancel", NULL); - return TCL_ERROR; + if (changed == 0) { + /* + * Name hasn't changed since the last time we hit return + * or double-clicked on a directory, so return this. + */ + + EndDialog(hwnd, IDOK); + return 1; } + + cdPtr->lastCtrl = IDOK; + + /* + * The following is the magic code, determined by running + * Spy++ on some other directory chooser, that it takes to + * get this dialog to update the listbox to display the + * current directory. + */ + + SetDlgItemText(hwnd, edt1, cdPtr->path); + SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003), + (LPARAM) GetDlgItem(hwnd, cmb2)); + return 0; + } else if (idCtrl == lst2) { + /* + * Enter key was pressed while in listbox. + * If it's a new directory, allow default behavior to open dir. + * If the directory hasn't changed, return selected directory. + */ + + int thisItem; + + thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0); + if (cdPtr->lastIdx == thisItem) { + GetCurrentDirectory(MAX_PATH, cdPtr->path); + EndDialog(hwnd, IDOK); + return 1; + } + } else if (idCtrl == IDOK) { + /* + * The OK button was clicked. Return the path currently specified + * in the listbox. + * + * The directory has not yet been changed to the one specified in + * the listbox. Returning 0 allows the default dialog proc to + * change the directory to the one specified in the listbox and + * then causes it to send a WM_LBSELCHANGED back to the hook proc. + * When we get that message, we will record the current directory + * and then quit. + */ + + cdPtr->lastIdx = -1; + } + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_MessageBoxObjCmd -- + * + * This procedure implements the MessageBox window for the + * Windows platform. See the user documentation for details on what + * it does. + * + * Results: + * See user documentation. + * + * Side effects: + * None. The MessageBox window will be destroy before this procedure + * returns. + * + *---------------------------------------------------------------------- + */ + +int +Tk_MessageBoxObjCmd(clientData, interp, objc, objv) + 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, parent; + HWND hWnd; + char *message, *title; + int defaultBtn, icon, type; + int i, oldMode, flags, winCode; + Tcl_DString messageString, titleString; + static char *optionStrings[] = { + "-default", "-icon", "-message", "-parent", + "-title", "-type", NULL + }; + enum options { + MSG_DEFAULT, MSG_ICON, MSG_MESSAGE, MSG_PARENT, + MSG_TITLE, MSG_TYPE + }; + + tkwin = (Tk_Window) clientData; + + defaultBtn = -1; + icon = MB_ICONINFORMATION; + message = NULL; + parent = tkwin; + title = NULL; + type = MB_OK; + + for (i = 1; i < objc; i += 2) { + int index; + char *string; + Tcl_Obj *optionPtr, *valuePtr; + + optionPtr = objv[i]; + valuePtr = objv[i + 1]; + + if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", + TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + if (i + 1 == objc) { + string = Tcl_GetStringFromObj(optionPtr, NULL); + Tcl_AppendResult(interp, "value for \"", string, "\" missing", + (char *) NULL); + return TCL_ERROR; } - else { - Tcl_AppendResult(interp, "unknown option \"", - argv[i], "\", must be -default, -icon, ", - "-message, -parent, -title or -type", NULL); + + string = Tcl_GetStringFromObj(valuePtr, NULL); + switch ((enum options) index) { + case MSG_DEFAULT: + defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap, + valuePtr); + if (defaultBtn < 0) { + return TCL_ERROR; + } + break; + + case MSG_ICON: + icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr); + if (icon < 0) { + return TCL_ERROR; + } + break; + + case MSG_MESSAGE: + message = string; + break; + + case MSG_PARENT: + parent = Tk_NameToWindow(interp, string, tkwin); + if (parent == NULL) { return TCL_ERROR; + } + break; + + case MSG_TITLE: + title = string; + break; + + case MSG_TYPE: + type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr); + if (type < 0) { + return TCL_ERROR; + } + break; + } } - /* Make sure we have a valid hWnd to act as the parent of this message box - */ - if (Tk_WindowId(parent) == None) { - Tk_MakeWindowExist(parent); - } + Tk_MakeWindowExist(parent); hWnd = Tk_GetHWND(Tk_WindowId(parent)); - if (defaultBtn != NULL) { - for (i=0; i<NUM_TYPES; i++) { - if (type == msgTypeInfo[i].type) { - for (j=0; j<msgTypeInfo[i].numButtons; j++) { - if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) { - defaultBtnIdx = j; + flags = 0; + if (defaultBtn >= 0) { + int defaultBtnIdx; + + defaultBtnIdx = -1; + for (i = 0; i < NUM_TYPES; i++) { + if (type == allowedTypes[i].type) { + int j; + + for (j = 0; j < 3; j++) { + if (allowedTypes[i].btnIds[j] == defaultBtn) { + defaultBtnIdx = j; break; } } if (defaultBtnIdx < 0) { Tcl_AppendResult(interp, "invalid default button \"", - defaultBtn, "\"", NULL); + TkFindStateString(buttonMap, defaultBtn), + "\"", NULL); return TCL_ERROR; } break; } } - - switch (defaultBtnIdx) { - case 0: flags = MB_DEFBUTTON1; break; - case 1: flags = MB_DEFBUTTON2; break; - case 2: flags = MB_DEFBUTTON3; break; - case 3: flags = MB_DEFBUTTON4; break; - } - } else { - flags = 0; + flags = buttonFlagMap[defaultBtnIdx]; } - flags |= icon | type; + flags |= icon | type | MB_SYSTEMMODAL; + + Tcl_UtfToExternalDString(NULL, message, -1, &messageString); + Tcl_UtfToExternalDString(NULL, title, -1, &titleString); + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - code = MessageBox(hWnd, message, title, flags|MB_SYSTEMMODAL); + winCode = MessageBox(hWnd, Tcl_DStringValue(&messageString), + Tcl_DStringValue(&titleString), flags); (void) Tcl_SetServiceMode(oldMode); - switch (code) { - case IDABORT: result = "abort"; break; - case IDCANCEL: result = "cancel"; break; - case IDIGNORE: result = "ignore"; break; - case IDNO: result = "no"; break; - case IDOK: result = "ok"; break; - case IDRETRY: result = "retry"; break; - case IDYES: result = "yes"; break; - default: result = ""; - } - - /* - * When we come to here interp->result may have been changed by some - * background scripts. Call Tcl_SetResult() to make sure that any stuff - * lingering in interp->result will not appear in the result of - * this command. - */ + Tcl_DStringFree(&messageString); + Tcl_DStringFree(&titleString); - Tcl_SetResult(interp, result, TCL_STATIC); + Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC); return TCL_OK; - - arg_missing: - Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", - NULL); - return TCL_ERROR; } - -/* - *---------------------------------------------------------------------- - * - * ProcessCDError -- - * - * This procedure gets called if a Windows-specific error message - * has occurred during the execution of a common dialog or the - * user has pressed the CANCEL button. - * - * Results: - * If an error has indeed happened, returns a standard TCL result - * that reports the error code in string format. If the user has - * pressed the CANCEL button (dwErrorCode == 0), resets - * interp->result to the empty string. - * - * Side effects: - * interp->result is changed. - * - *---------------------------------------------------------------------- - */ -static int ProcessCDError(interp, dwErrorCode, hWnd) - Tcl_Interp * interp; /* Current interpreter. */ - DWORD dwErrorCode; /* The Windows-specific error code */ - HWND hWnd; /* window in which the error happened*/ -{ - char *string; - Tcl_ResetResult(interp); +static void +SetTkDialog(ClientData clientData) +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + char buf[32]; + HWND hwnd; - switch(dwErrorCode) { - case 0: /* User has hit CANCEL */ - return TCL_OK; - - case CDERR_DIALOGFAILURE: string="CDERR_DIALOGFAILURE"; break; - case CDERR_STRUCTSIZE: string="CDERR_STRUCTSIZE"; break; - case CDERR_INITIALIZATION: string="CDERR_INITIALIZATION"; break; - case CDERR_NOTEMPLATE: string="CDERR_NOTEMPLATE"; break; - case CDERR_NOHINSTANCE: string="CDERR_NOHINSTANCE"; break; - case CDERR_LOADSTRFAILURE: string="CDERR_LOADSTRFAILURE"; break; - case CDERR_FINDRESFAILURE: string="CDERR_FINDRESFAILURE"; break; - case CDERR_LOADRESFAILURE: string="CDERR_LOADRESFAILURE"; break; - case CDERR_LOCKRESFAILURE: string="CDERR_LOCKRESFAILURE"; break; - case CDERR_MEMALLOCFAILURE: string="CDERR_MEMALLOCFAILURE"; break; - case CDERR_MEMLOCKFAILURE: string="CDERR_MEMLOCKFAILURE"; break; - case CDERR_NOHOOK: string="CDERR_NOHOOK"; break; - case PDERR_SETUPFAILURE: string="PDERR_SETUPFAILURE"; break; - case PDERR_PARSEFAILURE: string="PDERR_PARSEFAILURE"; break; - case PDERR_RETDEFFAILURE: string="PDERR_RETDEFFAILURE"; break; - case PDERR_LOADDRVFAILURE: string="PDERR_LOADDRVFAILURE"; break; - case PDERR_GETDEVMODEFAIL: string="PDERR_GETDEVMODEFAIL"; break; - case PDERR_INITFAILURE: string="PDERR_INITFAILURE"; break; - case PDERR_NODEVICES: string="PDERR_NODEVICES"; break; - case PDERR_NODEFAULTPRN: string="PDERR_NODEFAULTPRN"; break; - case PDERR_DNDMMISMATCH: string="PDERR_DNDMMISMATCH"; break; - case PDERR_CREATEICFAILURE: string="PDERR_CREATEICFAILURE"; break; - case PDERR_PRINTERNOTFOUND: string="PDERR_PRINTERNOTFOUND"; break; - case CFERR_NOFONTS: string="CFERR_NOFONTS"; break; - case FNERR_SUBCLASSFAILURE: string="FNERR_SUBCLASSFAILURE"; break; - case FNERR_INVALIDFILENAME: string="FNERR_INVALIDFILENAME"; break; - case FNERR_BUFFERTOOSMALL: string="FNERR_BUFFERTOOSMALL"; break; - - default: - string="unknown error"; - } + hwnd = (HWND) clientData; - Tcl_AppendResult(interp, "Win32 internal error: ", string, NULL); - return TCL_ERROR; + sprintf(buf, "0x%08x", hwnd); + Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY); } diff --git a/win/tkWinDraw.c b/win/tkWinDraw.c index c68fb04..43a2197 100644 --- a/win/tkWinDraw.c +++ b/win/tkWinDraw.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDraw.c,v 1.3 1999/03/10 07:04:46 stanton Exp $ + * RCS: @(#) $Id: tkWinDraw.c,v 1.4 1999/04/16 01:51:51 stanton Exp $ */ #include "tkWinInt.h" @@ -106,6 +106,12 @@ static int bltModes[] = { typedef BOOL (CALLBACK *WinDrawFunc) _ANSI_ARGS_((HDC dc, CONST POINT* points, int npoints)); +typedef struct ThreadSpecificData { + POINT *winPoints; /* Array of points that is reused. */ + int nWinPoints; /* Current size of point array. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + /* * Forward declarations for procedures defined in this file: */ @@ -212,7 +218,8 @@ TkWinReleaseDrawableDC(d, dc, state) * Returns the converted array of POINTs. * * Side effects: - * Allocates a block of memory that should not be freed. + * Allocates a block of memory in thread local storage that + * should not be freed. * *---------------------------------------------------------------------- */ @@ -224,8 +231,8 @@ ConvertPoints(points, npoints, mode, bbox) int mode; /* CoordModeOrigin or CoordModePrevious. */ RECT *bbox; /* Bounding box of points. */ { - static POINT *winPoints = NULL; /* Array of points that is reused. */ - static int nWinPoints = -1; /* Current size of point array. */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); int i; /* @@ -233,16 +240,16 @@ ConvertPoints(points, npoints, mode, bbox) * we reuse the last array if it is large enough. */ - if (npoints > nWinPoints) { - if (winPoints != NULL) { - ckfree((char *) winPoints); + if (npoints > tsdPtr->nWinPoints) { + if (tsdPtr->winPoints != NULL) { + ckfree((char *) tsdPtr->winPoints); } - winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints); - if (winPoints == NULL) { - nWinPoints = -1; + tsdPtr->winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints); + if (tsdPtr->winPoints == NULL) { + tsdPtr->nWinPoints = -1; return NULL; } - nWinPoints = npoints; + tsdPtr->nWinPoints = npoints; } bbox->left = bbox->right = points[0].x; @@ -250,26 +257,26 @@ ConvertPoints(points, npoints, mode, bbox) if (mode == CoordModeOrigin) { for (i = 0; i < npoints; i++) { - winPoints[i].x = points[i].x; - winPoints[i].y = points[i].y; - bbox->left = MIN(bbox->left, winPoints[i].x); - bbox->right = MAX(bbox->right, winPoints[i].x); - bbox->top = MIN(bbox->top, winPoints[i].y); - bbox->bottom = MAX(bbox->bottom, winPoints[i].y); + tsdPtr->winPoints[i].x = points[i].x; + tsdPtr->winPoints[i].y = points[i].y; + bbox->left = MIN(bbox->left, tsdPtr->winPoints[i].x); + bbox->right = MAX(bbox->right, tsdPtr->winPoints[i].x); + bbox->top = MIN(bbox->top, tsdPtr->winPoints[i].y); + bbox->bottom = MAX(bbox->bottom, tsdPtr->winPoints[i].y); } } else { - winPoints[0].x = points[0].x; - winPoints[0].y = points[0].y; + tsdPtr->winPoints[0].x = points[0].x; + tsdPtr->winPoints[0].y = points[0].y; for (i = 1; i < npoints; i++) { - winPoints[i].x = winPoints[i-1].x + points[i].x; - winPoints[i].y = winPoints[i-1].y + points[i].y; - bbox->left = MIN(bbox->left, winPoints[i].x); - bbox->right = MAX(bbox->right, winPoints[i].x); - bbox->top = MIN(bbox->top, winPoints[i].y); - bbox->bottom = MAX(bbox->bottom, winPoints[i].y); + tsdPtr->winPoints[i].x = tsdPtr->winPoints[i-1].x + points[i].x; + tsdPtr->winPoints[i].y = tsdPtr->winPoints[i-1].y + points[i].y; + bbox->left = MIN(bbox->left, tsdPtr->winPoints[i].x); + bbox->right = MAX(bbox->right, tsdPtr->winPoints[i].x); + bbox->top = MIN(bbox->top, tsdPtr->winPoints[i].y); + bbox->bottom = MAX(bbox->bottom, tsdPtr->winPoints[i].y); } } - return winPoints; + return tsdPtr->winPoints; } /* @@ -926,8 +933,6 @@ XDrawLines(display, d, gc, points, npoints, mode) /* *---------------------------------------------------------------------- * -#if 0 - * XFillPolygon -- * * Draws a filled polygon. diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c index 799bb92..1cc4057 100644 --- a/win/tkWinEmbed.c +++ b/win/tkWinEmbed.c @@ -6,12 +6,12 @@ * one application can use as its main window an internal window from * another application). * - * Copyright (c) 1996 Sun Microsystems, Inc. + * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinEmbed.c,v 1.2 1998/09/14 18:24:00 stanton Exp $ + * RCS: @(#) $Id: tkWinEmbed.c,v 1.3 1999/04/16 01:51:51 stanton Exp $ */ #include "tkWinInt.h" @@ -38,9 +38,11 @@ typedef struct Container { * this process. */ } Container; -static Container *firstContainerPtr = NULL; - /* First in list of all containers +typedef struct ThreadSpecificData { + Container *firstContainerPtr; /* First in list of all containers * managed by this process. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; static void CleanupContainerList _ANSI_ARGS_(( ClientData clientData)); @@ -74,14 +76,16 @@ CleanupContainerList(clientData) ClientData clientData; { Container *nextPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (; - firstContainerPtr != (Container *) NULL; - firstContainerPtr = nextPtr) { - nextPtr = firstContainerPtr->nextPtr; - ckfree((char *) firstContainerPtr); + tsdPtr->firstContainerPtr != (Container *) NULL; + tsdPtr->firstContainerPtr = nextPtr) { + nextPtr = tsdPtr->firstContainerPtr->nextPtr; + ckfree((char *) tsdPtr->firstContainerPtr); } - firstContainerPtr = (Container *) NULL; + tsdPtr->firstContainerPtr = (Container *) NULL; } /* @@ -126,7 +130,7 @@ TkpTestembedCmd(clientData, interp, argc, argv) * The return value is normally TCL_OK. If an error occurred (such as * if the argument does not identify a legal Windows window handle), * the return value is TCL_ERROR and an error message is left in the - * interp->result if interp is not NULL. + * the interp's result if interp is not NULL. * * Side effects: * None. @@ -147,6 +151,8 @@ TkpUseWindow(interp, tkwin, string) int id; HWND hwnd; Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->window != None) { panic("TkpUseWindow: Already assigned a window"); @@ -159,7 +165,8 @@ TkpUseWindow(interp, tkwin, string) /* * Check if the window is a valid handle. If it is invalid, return - * TCL_ERROR and potentially leave an error message in interp->result. + * TCL_ERROR and potentially leave an error message in the interp's + * result. */ if (!IsWindow(hwnd)) { @@ -190,7 +197,7 @@ TkpUseWindow(interp, tkwin, string) * things will get cleaned up at finalization. */ - if (firstContainerPtr == (Container *) NULL) { + if (tsdPtr->firstContainerPtr == (Container *) NULL) { Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL); } @@ -201,8 +208,8 @@ TkpUseWindow(interp, tkwin, string) * app. are in the same process. */ - for (containerPtr = firstContainerPtr; containerPtr != NULL; - containerPtr = containerPtr->nextPtr) { + for (containerPtr = tsdPtr->firstContainerPtr; + containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->parentHWnd == hwnd) { winPtr->flags |= TK_BOTH_HALVES; containerPtr->parentPtr->flags |= TK_BOTH_HALVES; @@ -213,8 +220,8 @@ TkpUseWindow(interp, tkwin, string) containerPtr = (Container *) ckalloc(sizeof(Container)); containerPtr->parentPtr = NULL; containerPtr->parentHWnd = hwnd; - containerPtr->nextPtr = firstContainerPtr; - firstContainerPtr = containerPtr; + containerPtr->nextPtr = tsdPtr->firstContainerPtr; + tsdPtr->firstContainerPtr = containerPtr; } /* @@ -258,13 +265,15 @@ TkpMakeContainer(tkwin) { TkWindow *winPtr = (TkWindow *) tkwin; Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * If this is the first container, register an exit handler so that * things will get cleaned up at finalization. */ - if (firstContainerPtr == (Container *) NULL) { + if (tsdPtr->firstContainerPtr == (Container *) NULL) { Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL); } @@ -279,8 +288,8 @@ TkpMakeContainer(tkwin) containerPtr->parentHWnd = Tk_GetHWND(Tk_WindowId(tkwin)); containerPtr->embeddedHWnd = NULL; containerPtr->embeddedPtr = NULL; - containerPtr->nextPtr = firstContainerPtr; - firstContainerPtr = containerPtr; + containerPtr->nextPtr = tsdPtr->firstContainerPtr; + tsdPtr->firstContainerPtr = containerPtr; winPtr->flags |= TK_CONTAINER; /* @@ -358,12 +367,14 @@ TkWinEmbeddedEventProc(hwnd, message, wParam, lParam) LPARAM lParam; { Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Find the Container structure associated with the parent window. */ - for (containerPtr = firstContainerPtr; + for (containerPtr = tsdPtr->firstContainerPtr; containerPtr->parentHWnd != hwnd; containerPtr = containerPtr->nextPtr) { if (containerPtr == NULL) { @@ -508,8 +519,10 @@ TkpGetOtherWindow(winPtr) * embedded window. */ { Container *containerPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - for (containerPtr = firstContainerPtr; containerPtr != NULL; + for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->embeddedPtr == winPtr) { return containerPtr->parentPtr; @@ -608,6 +621,8 @@ EmbedWindowDeleted(winPtr) * was deleted. */ { Container *containerPtr, *prevPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Find the Container structure for this window work. Delete the @@ -616,7 +631,7 @@ EmbedWindowDeleted(winPtr) */ prevPtr = NULL; - containerPtr = firstContainerPtr; + containerPtr = tsdPtr->firstContainerPtr; while (1) { if (containerPtr->embeddedPtr == winPtr) { containerPtr->embeddedHWnd = NULL; @@ -636,7 +651,7 @@ EmbedWindowDeleted(winPtr) if ((containerPtr->embeddedPtr == NULL) && (containerPtr->parentPtr == NULL)) { if (prevPtr == NULL) { - firstContainerPtr = containerPtr->nextPtr; + tsdPtr->firstContainerPtr = containerPtr->nextPtr; } else { prevPtr->nextPtr = containerPtr->nextPtr; } diff --git a/win/tkWinFont.c b/win/tkWinFont.c index b850857..7680b97 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.c @@ -4,33 +4,156 @@ * Contains the Windows implementation of the platform-independant * font package interface. * - * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1994 Software Research Associates, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinFont.c,v 1.4 1999/02/04 21:00:48 stanton Exp $ + * RCS: @(#) $Id: tkWinFont.c,v 1.5 1999/04/16 01:51:51 stanton Exp $ */ #include "tkWinInt.h" #include "tkFont.h" /* - * The following structure represents Windows' implementation of a font. + * The following structure represents a font family. It is assumed that + * all screen fonts constructed from the same "font family" share certain + * properties; all screen fonts with the same "font family" point to a + * shared instance of this structure. The most important shared property + * is the character existence metrics, used to determine if a screen font + * can display a given Unicode character. + * + * Under Windows, a "font family" is uniquely identified by its face name. + */ + +#define FONTMAP_SHIFT 10 + +#define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT)) +#define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT) + +typedef struct FontFamily { + struct FontFamily *nextPtr; /* Next in list of all known font families. */ + int refCount; /* How many SubFonts are referring to this + * FontFamily. When the refCount drops to + * zero, this FontFamily may be freed. */ + /* + * Key. + */ + + Tk_Uid faceName; /* Face name key for this FontFamily. */ + + /* + * Derived properties. + */ + + Tcl_Encoding encoding; /* Encoding for this font family. */ + 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); + /* The procedure to use to draw text after + * it has been converted from UTF-8 to the + * encoding of this font. */ + BOOL (WINAPI *getTextExtentPoint32Proc)(HDC, TCHAR *, int, LPSIZE); + /* The procedure to use to measure text after + * it has been converted from UTF-8 to the + * encoding of this font. */ + + char *fontMap[FONTMAP_PAGES]; + /* Two-level sparse table used to determine + * quickly if the specified character exists. + * As characters are encountered, more pages + * in this table are dynamically added. The + * contents of each page is a bitmask + * consisting of FONTMAP_BITSPERPAGE bits, + * representing whether this font can be used + * to display the given character at the + * corresponding bit position. The high bits + * of the character are used to pick which + * page of the table is used. */ + + /* + * Cached Truetype font info. + */ + + int segCount; /* The length of the following arrays. */ + USHORT *startCount; /* Truetype information about the font, */ + USHORT *endCount; /* indicating which characters this font + * can display (malloced). The format of + * this information is (relatively) compact, + * but would take longer to search than + * indexing into the fontMap[][] table. */ +} FontFamily; + +/* + * The following structure encapsulates an individual screen font. A font + * object is made up of however many SubFonts are necessary to display a + * stream of multilingual characters. + */ + +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 when displaying/measuring chars + * belonging to the FontFamily. */ + FontFamily *familyPtr; /* The FontFamily for this SubFont. */ +} SubFont; + +/* + * The following structure represents Windows' implementation of a font + * object. */ +#define SUBFONT_SPACE 3 +#define BASE_CHARS 128 + typedef struct WinFont { TkFont font; /* Stuff used by generic font package. Must * be first in structure. */ - HFONT hFont; /* Windows information about font. */ + SubFont staticSubFonts[SUBFONT_SPACE]; + /* Builtin space for a limited number of + * SubFonts. */ + int numSubFonts; /* Length of following array. */ + SubFont *subFontArray; /* Array of SubFonts that have been loaded + * in order to draw/measure all the characters + * encountered by this font so far. All fonts + * start off with one SubFont initialized by + * AllocFont() from the original set of font + * 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. */ + * this font, used for getting HDC for + * offscreen measurements. */ + int pixelSize; /* Original pixel size used when font was + * constructed. */ + int widths[BASE_CHARS]; /* Widths of first 128 chars in the base + * font, for handling common case. The base + * font is always used to draw characters + * between 0x0000 and 0x007f. */ } WinFont; /* - * The following structure is used as to map between the Tcl strings - * that represent the system fonts and the numbers used by Windows. + * The following structure is passed as the LPARAM when calling the font + * enumeration procedure to determine if a font can support the given + * character. + */ + +typedef struct CanUse { + HDC hdc; + WinFont *fontPtr; + Tcl_DString *nameTriedPtr; + int ch; + SubFont *subFontPtr; +} CanUse; + +/* + * The following structure is used to map between the Tcl strings that + * represent the system fonts and the numbers used by Windows. */ static TkStateMap systemMap[] = { @@ -43,16 +166,105 @@ static TkStateMap systemMap[] = { {-1, NULL} }; -#define ABS(x) (((x) < 0) ? -(x) : (x)) +typedef struct ThreadSpecificData { + FontFamily *fontFamilyList; /* The list of font families that are + * currently loaded. As screen fonts + * are loaded, this list grows to hold + * information about what characters + * exist in each font family. */ + Tcl_HashTable uidTable; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; -static TkFont * AllocFont _ANSI_ARGS_((TkFont *tkFontPtr, - Tk_Window tkwin, HFONT hFont)); -static char * GetProperty _ANSI_ARGS_((CONST TkFontAttributes *faPtr, - CONST char *option)); -static int CALLBACK WinFontFamilyEnumProc _ANSI_ARGS_((ENUMLOGFONT *elfPtr, - NEWTEXTMETRIC *ntmPtr, int fontType, - LPARAM lParam)); +/* + * Information cached about the system at startup time. + */ + +static int platformId; +static Tcl_Encoding unicodeEncoding; +static Tcl_Encoding systemEncoding; +/* + * Procedures used only in this file. + */ + +static FontFamily * AllocFontFamily(HDC hdc, HFONT hFont, int base); +static SubFont * CanUseFallback(HDC hdc, WinFont *fontPtr, + char *fallbackName, int ch); +static SubFont * CanUseFallbackWithAliases(HDC hdc, WinFont *fontPtr, + char *faceName, int ch, Tcl_DString *nameTriedPtr); +static int FamilyExists(HDC hdc, CONST char *faceName); +static char * FamilyOrAliasExists(HDC hdc, CONST char *faceName); +static SubFont * FindSubFontForChar(WinFont *fontPtr, int ch); +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 void InitFont(Tk_Window tkwin, HFONT hFont, + int overstrike, WinFont *tkFontPtr); +static void InitSubFont(HDC hdc, HFONT hFont, int base, + SubFont *subFontPtr); +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); +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 int CALLBACK WinFontCanUseProc(ENUMLOGFONT *lfPtr, + NEWTEXTMETRIC *tmPtr, int fontType, + LPARAM lParam); +static int CALLBACK WinFontExistProc(ENUMLOGFONT *lfPtr, + NEWTEXTMETRIC *tmPtr, int fontType, + LPARAM lParam); +static int CALLBACK WinFontFamilyEnumProc(ENUMLOGFONT *lfPtr, + NEWTEXTMETRIC *tmPtr, int fontType, + LPARAM lParam); + +/* + *------------------------------------------------------------------------- + * + * TkpFontPkgInit -- + * + * This procedure is called when an application is created. It + * initializes all the structures that are used by the + * platform-dependant code on a per application basis. + * + * Results: + * None. + * + * Side effects: + * + * None. + * + *------------------------------------------------------------------------- + */ + +void +TkpFontPkgInit( + TkMainInfo *mainPtr) /* The application being created. */ +{ + OSVERSIONINFO os; + + os.dwOSVersionInfoSize = sizeof(os); + GetVersionEx(&os); + platformId = os.dwPlatformId; + unicodeEncoding = Tcl_GetEncoding(NULL, "unicode"); + if (platformId == VER_PLATFORM_WIN32_NT) { + /* + * If running NT, then we will be calling some Unicode functions + * explictly. So, even if the Tcl system encoding isn't Unicode, + * make sure we convert to/from the Unicode char set. + */ + + systemEncoding = unicodeEncoding; + } +} /* *--------------------------------------------------------------------------- @@ -75,29 +287,29 @@ static int CALLBACK WinFontFamilyEnumProc _ANSI_ARGS_((ENUMLOGFONT *elfPtr, * the contents of the generic TkFont before calling TkpDeleteFont(). * * Side effects: - * None. + * Memory allocated. * *--------------------------------------------------------------------------- */ TkFont * -TkpGetNativeFont(tkwin, name) - Tk_Window tkwin; /* For display where font will be used. */ - CONST char *name; /* Platform-specific font name. */ +TkpGetNativeFont( + Tk_Window tkwin, /* For display where font will be used. */ + CONST char *name) /* Platform-specific font name. */ { int object; - HFONT hFont; - + WinFont *fontPtr; + object = TkFindStateNum(NULL, NULL, systemMap, name); if (object < 0) { return NULL; } - hFont = GetStockObject(object); - if (hFont == NULL) { - panic("TkpGetNativeFont: can't allocate stock font"); - } - return AllocFont(NULL, tkwin, hFont); + tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr; + fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); + InitFont(tkwin, GetStockObject(object), 0, fontPtr); + + return (TkFont *) fontPtr; } /* @@ -124,80 +336,86 @@ TkpGetNativeFont(tkwin, name) * the contents of the generic TkFont before calling TkpDeleteFont(). * * Side effects: - * None. + * Memory allocated. * *--------------------------------------------------------------------------- */ + TkFont * -TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr) - TkFont *tkFontPtr; /* If non-NULL, store the information in +TkpGetFontFromAttributes( + TkFont *tkFontPtr, /* If non-NULL, store the information in * this existing TkFont structure, rather than * allocating a new structure to hold the * font; the existing contents of the font * will be released. If NULL, a new TkFont * structure is allocated. */ - Tk_Window tkwin; /* For display where font will be used. */ - CONST TkFontAttributes *faPtr; /* Set of attributes to match. */ + Tk_Window tkwin, /* For display where font will be used. */ + CONST TkFontAttributes *faPtr) + /* Set of attributes to match. */ { - LOGFONT lf; + int i, j; + HDC hdc; + HWND hwnd; HFONT hFont; Window window; - HWND hwnd; - HDC hdc; + WinFont *fontPtr; + char ***fontFallbacks; + char *faceName, *fallback, *actualName; - window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr); - hwnd = (window == None) ? NULL : TkWinGetHWND(window); - - hdc = GetDC(hwnd); - lf.lfHeight = -faPtr->pointsize; - if (lf.lfHeight < 0) { - lf.lfHeight = MulDiv(lf.lfHeight, - 254 * WidthOfScreen(Tk_Screen(tkwin)), - 720 * WidthMMOfScreen(Tk_Screen(tkwin))); - } - lf.lfWidth = 0; - lf.lfEscapement = 0; - lf.lfOrientation = 0; - lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD; - lf.lfItalic = faPtr->slant; - lf.lfUnderline = faPtr->underline; - lf.lfStrikeOut = faPtr->overstrike; - lf.lfCharSet = DEFAULT_CHARSET; - lf.lfOutPrecision = OUT_DEFAULT_PRECIS; - lf.lfClipPrecision = CLIP_DEFAULT_PRECIS; - lf.lfQuality = DEFAULT_QUALITY; - lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; - if (faPtr->family == NULL) { - lf.lfFaceName[0] = '\0'; - } else { - lstrcpyn(lf.lfFaceName, faPtr->family, sizeof(lf.lfFaceName)); - } - ReleaseDC(hwnd, hdc); + tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr; + window = Tk_WindowId(tkwin); + hwnd = (window == None) ? NULL : TkWinGetHWND(window); + hdc = GetDC(hwnd); /* - * Replace the standard X and Mac family names with the names that - * Windows likes. + * Algorithm to get the closest font name to the one requested. + * + * try fontname + * try all aliases for fontname + * foreach fallback for fontname + * try the fallback + * try all aliases for the fallback */ - if ((stricmp(lf.lfFaceName, "Times") == 0) - || (stricmp(lf.lfFaceName, "New York") == 0)) { - strcpy(lf.lfFaceName, "Times New Roman"); - } else if ((stricmp(lf.lfFaceName, "Courier") == 0) - || (stricmp(lf.lfFaceName, "Monaco") == 0)) { - strcpy(lf.lfFaceName, "Courier New"); - } else if ((stricmp(lf.lfFaceName, "Helvetica") == 0) - || (stricmp(lf.lfFaceName, "Geneva") == 0)) { - strcpy(lf.lfFaceName, "Arial"); - } - - hFont = CreateFontIndirect(&lf); - if (hFont == NULL) { - hFont = GetStockObject(SYSTEM_FONT); - if (hFont == NULL) { - panic("TkpGetFontFromAttributes: cannot get system font"); + faceName = faPtr->family; + if (faceName != NULL) { + actualName = FamilyOrAliasExists(hdc, faceName); + if (actualName != NULL) { + faceName = actualName; + goto found; + } + fontFallbacks = TkFontGetFallbacks(); + for (i = 0; fontFallbacks[i] != NULL; i++) { + for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { + if (strcasecmp(faceName, fallback) == 0) { + break; + } + } + if (fallback != NULL) { + for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { + actualName = FamilyOrAliasExists(hdc, fallback); + if (actualName != NULL) { + faceName = actualName; + goto found; + } + } + } } } - return AllocFont(tkFontPtr, tkwin, hFont); + + found: + ReleaseDC(hwnd, hdc); + + hFont = GetScreenFont(faPtr, faceName, TkFontGetPixels(tkwin, faPtr->size)); + if (tkFontPtr == NULL) { + fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); + } else { + fontPtr = (WinFont *) tkFontPtr; + ReleaseFont(fontPtr); + } + InitFont(tkwin, hFont, faPtr->overstrike, fontPtr); + + return (TkFont *) fontPtr; } /* @@ -220,26 +438,25 @@ TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr) */ void -TkpDeleteFont(tkFontPtr) - TkFont *tkFontPtr; /* Token of font to be deleted. */ +TkpDeleteFont( + TkFont *tkFontPtr) /* Token of font to be deleted. */ { WinFont *fontPtr; fontPtr = (WinFont *) tkFontPtr; - DeleteObject(fontPtr->hFont); - ckfree((char *) fontPtr); + ReleaseFont(fontPtr); } /* *--------------------------------------------------------------------------- * - * TkpGetFontFamilies, WinFontEnumFamilyProc -- + * TkpGetFontFamilies, WinFontFamilyEnumProc -- * * Return information about the font families that are available * on the display of the given window. * * Results: - * interp->result is modified to hold a list of all the available + * Modifies interp's result object to hold a list of all the available * font families. * * Side effects: @@ -249,51 +466,114 @@ TkpDeleteFont(tkFontPtr) */ void -TkpGetFontFamilies(interp, tkwin) - Tcl_Interp *interp; /* Interp to hold result. */ - Tk_Window tkwin; /* For display to query. */ +TkpGetFontFamilies( + Tcl_Interp *interp, /* Interp to hold result. */ + Tk_Window tkwin) /* For display to query. */ { - Window window; - HWND hwnd; HDC hdc; + HWND hwnd; + Window window; - window = Tk_WindowId(tkwin); - hwnd = (window == (Window) NULL) ? NULL : TkWinGetHWND(window); + window = Tk_WindowId(tkwin); + hwnd = (window == None) ? NULL : TkWinGetHWND(window); + hdc = GetDC(hwnd); - hdc = GetDC(hwnd); - EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontFamilyEnumProc, - (LPARAM) interp); + /* + * On any version NT, there may fonts with international names. + * Use the NT-only Unicode version of EnumFontFamilies to get the + * font names. If we used the ANSI version on a non-internationalized + * version of NT, we would get font names with '?' replacing all + * the international characters. + * + * On a non-internationalized verson of 95, fonts with international + * names are not allowed, so the ANSI version of EnumFontFamilies will + * work. On an internationalized version of 95, there may be fonts with + * international names; the ANSI version will work, fetching the + * name in the system code page. Can't use the Unicode version of + * EnumFontFamilies because it only exists under NT. + */ + + if (platformId == VER_PLATFORM_WIN32_NT) { + EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc, + (LPARAM) interp); + } else { + EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontFamilyEnumProc, + (LPARAM) interp); + } ReleaseDC(hwnd, hdc); } -/* ARGSUSED */ - static int CALLBACK -WinFontFamilyEnumProc(elfPtr, ntmPtr, fontType, lParam) - ENUMLOGFONT *elfPtr; /* Logical-font data. */ - NEWTEXTMETRIC *ntmPtr; /* Physical-font data (not used). */ - int fontType; /* Type of font (not used). */ - LPARAM lParam; /* Interp to hold result. */ +WinFontFamilyEnumProc( + ENUMLOGFONT *lfPtr, /* Logical-font data. */ + NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */ + int fontType, /* Type of font (not used). */ + LPARAM lParam) /* Result object to hold result. */ { + char *faceName; + Tcl_DString faceString; + Tcl_Obj *strPtr; Tcl_Interp *interp; interp = (Tcl_Interp *) lParam; - Tcl_AppendElement(interp, elfPtr->elfLogFont.lfFaceName); + 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_DStringFree(&faceString); return 1; } /* + *------------------------------------------------------------------------- + * + * TkpGetSubFonts -- + * + * A function used by the testing package for querying the actual + * screen fonts that make up a font object. + * + * Results: + * Modifies interp's result object to hold a list containing the + * names of the screen fonts that make up the given font object. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +void +TkpGetSubFonts( + Tcl_Interp *interp, /* Interp to hold result. */ + Tk_Font tkfont) /* Font object to query. */ +{ + int i; + WinFont *fontPtr; + FontFamily *familyPtr; + Tcl_Obj *resultPtr, *strPtr; + + resultPtr = Tcl_GetObjResult(interp); + 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); + } +} + +/* *--------------------------------------------------------------------------- * * Tk_MeasureChars -- * - * Determine the number of characters from the string that will fit + * Determine the number of bytes from the string that will fit * in the given horizontal span. The measurement is done under the * assumption that Tk_DrawChars() will be used to actually display * the characters. * * Results: - * The return value is the number of characters from source that + * The return value is the number of bytes from source that * fit into the span that extends from 0 to maxLength. *lengthPtr is * filled with the x-coordinate of the right edge of the last * character that did fit. @@ -303,126 +583,204 @@ WinFontFamilyEnumProc(elfPtr, ntmPtr, fontType, lParam) * *--------------------------------------------------------------------------- */ + int -Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr) - Tk_Font tkfont; /* Font in which characters will be drawn. */ - CONST char *source; /* Characters to be displayed. Need not be +Tk_MeasureChars( + Tk_Font tkfont, /* Font in which characters will be drawn. */ + CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ - int numChars; /* Maximum number of characters to consider + int numBytes, /* Maximum number of bytes to consider * from source string. */ - int maxLength; /* If > 0, maxLength specifies the longest - * permissible line length; don't consider any - * character that would cross this - * x-position. If <= 0, then line length is - * unbounded and the flags argument is + int maxLength, /* If >= 0, maxLength specifies the longest + * permissible line length in pixels; don't + * consider any character that would cross + * this x-position. If < 0, then line length + * is unbounded and the flags argument is * ignored. */ - int flags; /* Various flag bits OR-ed together: + int flags, /* Various flag bits OR-ed together: * TK_PARTIAL_OK means include the last char * which only partially fit on this line. * TK_WHOLE_WORDS means stop on a word * boundary, if possible. * TK_AT_LEAST_ONE means return at least one * character even if no characters fit. */ - int *lengthPtr; /* Filled with x-location just after the + int *lengthPtr) /* Filled with x-location just after the * terminating character. */ { - WinFont *fontPtr; HDC hdc; - HFONT hFont; - int curX, curIdx; + HFONT oldFont; + WinFont *fontPtr; + int curX, curByte; + SubFont *lastSubFontPtr; + + /* + * According to Microsoft tech support, Windows does not use kerning + * or fractional character widths when displaying text on the screen. + * So that means we can safely measure individual characters or spans + * of characters and add up the widths w/o any "off-by-one-pixel" + * errors. + */ fontPtr = (WinFont *) tkfont; hdc = GetDC(fontPtr->hwnd); - hFont = SelectObject(hdc, fontPtr->hFont); + lastSubFontPtr = &fontPtr->subFontArray[0]; + oldFont = SelectObject(hdc, lastSubFontPtr->hFont); - if (numChars == 0) { + if (numBytes == 0) { curX = 0; - curIdx = 0; - } else if (maxLength <= 0) { + curByte = 0; + } else if (maxLength < 0) { + Tcl_UniChar ch; SIZE size; + FontFamily *familyPtr; + Tcl_DString runString; + SubFont *thisSubFontPtr; + CONST char *p, *end, *next; + + /* + * A three step process: + * 1. Find a contiguous range of characters that can all be + * represented by a single screen font. + * 2. Convert those chars to the encoding of that font. + * 3. Measure converted chars. + */ + + curX = 0; + end = source + numBytes; + for (p = source; p < end; ) { + next = p + Tcl_UtfToUniChar(p, &ch); + thisSubFontPtr = FindSubFontForChar(fontPtr, ch); + if (thisSubFontPtr != lastSubFontPtr) { + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, + p - source, &runString); + (*familyPtr->getTextExtentPoint32Proc)(hdc, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> familyPtr->isWideFont, + &size); + curX += size.cx; + Tcl_DStringFree(&runString); + lastSubFontPtr = thisSubFontPtr; + source = p; - GetTextExtentPoint32(hdc, source, numChars, &size); - curX = size.cx; - curIdx = numChars; + SelectObject(hdc, lastSubFontPtr->hFont); + } + p = next; + } + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, + &runString); + (*familyPtr->getTextExtentPoint32Proc)(hdc, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> familyPtr->isWideFont, + &size); + curX += size.cx; + Tcl_DStringFree(&runString); + curByte = numBytes; } else { - int max; - int *partials; + Tcl_UniChar ch; SIZE size; + char buf[16]; + FontFamily *familyPtr; + SubFont *thisSubFontPtr; + CONST char *term, *end, *p, *next; + int newX, termX, sawNonSpace, srcRead, dstWrote; + + /* + * How many chars will fit in the space allotted? + * This first version may be inefficient because it measures + * every character individually. There is a function call that + * can measure multiple characters at once and return the + * offset of each of them, but it only works on NT, even though + * the documentation claims it works for 95. + * TODO: verify that GetTextExtentExPoint is still broken in '95, and + * possibly use it for NT anyway since it should be much faster and + * more accurate. + */ + + next = source + Tcl_UtfToUniChar(source, &ch); + newX = curX = termX = 0; - partials = (int *) ckalloc(numChars * sizeof (int)); - GetTextExtentExPoint(hdc, source, numChars, maxLength, &max, - partials, &size); - - if ((flags & TK_WHOLE_WORDS) && max < numChars) { - int sawSpace; - int i; - - sawSpace = 0; - i = max; - while (i >= 0 && !isspace(source[i])) { - --i; - } - while (i >= 0 && isspace(source[i])) { - sawSpace = 1; - --i; - } + term = source; + end = source + numBytes; - /* - * If a space char was not found, and the flag for forcing - * at least on (or more) chars to be drawn is false, then - * set MAX to zero so no text is drawn. Otherwise, if a - * space was found, set max to be one char past the space. - */ - - if ((i < 0) && !(flags & TK_AT_LEAST_ONE)) { - max = 0; - } else if (sawSpace) { - max = i + 1; + sawNonSpace = (ch > 255) || !isspace(ch); + for (p = source; ; ) { + if (ch < BASE_CHARS) { + newX += fontPtr->widths[ch]; + } else { + thisSubFontPtr = FindSubFontForChar(fontPtr, ch); + if (thisSubFontPtr != lastSubFontPtr) { + SelectObject(hdc, thisSubFontPtr->hFont); + lastSubFontPtr = thisSubFontPtr; + } + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p, + 0, NULL, buf, sizeof(buf), &srcRead, &dstWrote, NULL); + (*familyPtr->getTextExtentPoint32Proc)(hdc, buf, + dstWrote >> familyPtr->isWideFont, &size); + newX += size.cx; + } + if (newX > maxLength) { + break; + } + curX = newX; + p = next; + if (p >= end) { + term = end; + termX = curX; + break; } - - } - if (max == 0) { - curX = 0; - } else { - curX = partials[max - 1]; + next += Tcl_UtfToUniChar(next, &ch); + if ((ch < 256) && isspace(ch)) { + if (sawNonSpace) { + term = p; + termX = curX; + sawNonSpace = 0; + } + } else { + sawNonSpace = 1; + } } - if (((flags & TK_PARTIAL_OK) && max < numChars && curX < maxLength) - || ((flags & TK_AT_LEAST_ONE) && max == 0 && numChars > 0)) { + /* + * P points to the first character that doesn't fit in the desired + * span. Use the flags to figure out what to return. + */ + if ((flags & TK_PARTIAL_OK) && (p < end) && (curX < maxLength)) { /* - * MS BUG ALERT - We have to pass the bogus length, and - * the dummyMax parameter, because without them the call crashes on - * NT/J Service Pack 3 and less. This is documented in the - * Microsoft Knowledge Base. + * Include the first character that didn't quite fit in the desired + * span. The width returned will include the width of that extra + * character. */ - - int dummyMax; - - /* - * We want to include the first character that didn't - * quite fit. Call the function again to include the - * width of the extra character. - */ - - GetTextExtentExPoint(hdc, source, max + 1, INT_MAX, &dummyMax, - partials, &size); - curX = partials[max]; - ++max; - - } - - ckfree((char *) partials); - curIdx = max; + + curX = newX; + p += Tcl_UtfToUniChar(p, &ch); + } + if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) { + term = p; + termX = curX; + if (term == source) { + term += Tcl_UtfToUniChar(term, &ch); + termX = newX; + } + } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) { + term = p; + termX = curX; + } + + curX = termX; + curByte = term - source; } - SelectObject(hdc, hFont); + SelectObject(hdc, oldFont); ReleaseDC(fontPtr->hwnd, hdc); *lengthPtr = curX; - return curIdx; + return curByte; } /* @@ -442,27 +800,26 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr) */ void -Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) - 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; +Tk_DrawChars( + 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; /* Characters 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 * is passed to this function. If they are * not stripped out, they will be displayed as * regular printing characters. */ - int numChars; /* Number of characters in string. */ - int x, y; /* Coordinates at which to place origin of + int numBytes, /* Number of bytes in string. */ + int x, int y) /* Coordinates at which to place origin of * string when drawing. */ { HDC dc; - HFONT hFont; - TkWinDCState state; WinFont *fontPtr; + TkWinDCState state; fontPtr = (WinFont *) gc->font; display->request++; @@ -499,18 +856,16 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL); oldBrush = SelectObject(dc, stipple); - SetTextAlign(dcMem, TA_LEFT | TA_TOP); + SetTextAlign(dcMem, TA_LEFT | TA_BASELINE); SetTextColor(dcMem, gc->foreground); SetBkMode(dcMem, TRANSPARENT); SetBkColor(dcMem, RGB(0, 0, 0)); - hFont = SelectObject(dcMem, fontPtr->hFont); - /* * Compute the bounding box and create a compatible bitmap. */ - GetTextExtentPoint(dcMem, source, numChars, &size); + GetTextExtentPoint(dcMem, source, numBytes, &size); GetTextMetrics(dcMem, &tm); size.cx -= tm.tmOverhang; bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy); @@ -525,11 +880,11 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) */ PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS); - TextOut(dcMem, 0, 0, source, numChars); + MultiFontTextOut(dc, fontPtr, source, numBytes, x, y); BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem, 0, 0, 0xEA02E9); PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS); - TextOut(dcMem, 0, 0, source, numChars); + MultiFontTextOut(dc, fontPtr, source, numBytes, x, y); BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem, 0, 0, 0x8A0E06); @@ -537,7 +892,6 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) * Destroy the temporary bitmap and restore the device context. */ - SelectObject(dcMem, hFont); SelectObject(dcMem, oldBitmap); DeleteObject(bitmap); DeleteDC(dcMem); @@ -547,92 +901,1458 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y) SetTextAlign(dc, TA_LEFT | TA_BASELINE); SetTextColor(dc, gc->foreground); SetBkMode(dc, TRANSPARENT); - hFont = SelectObject(dc, fontPtr->hFont); - TextOut(dc, x, y, source, numChars); - SelectObject(dc, hFont); + MultiFontTextOut(dc, fontPtr, source, numBytes, x, y); } TkWinReleaseDrawableDC(drawable, dc, &state); } /* - *--------------------------------------------------------------------------- + *------------------------------------------------------------------------- * - * AllocFont -- + * MultiFontTextOut -- * - * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). - * Allocates and intializes the memory for a new TkFont that - * wraps the platform-specific data. + * Helper function for Tk_DrawChars. Draws characters, using the + * various screen fonts in fontPtr to draw multilingual characters. + * Note: No bidirectional support. * * Results: - * Returns pointer to newly constructed TkFont. + * None. + * + * Side effects: + * Information gets drawn on the screen. + * Contents of fontPtr may be modified if more subfonts were loaded + * in order to draw all the multilingual characters in the given + * string. + * + *------------------------------------------------------------------------- + */ + +static void +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. */ + int numBytes, /* Length of string in bytes. */ + int x, int y) /* Coordinates at which to place origin * + * of string when drawing. */ +{ + Tcl_UniChar ch; + SIZE size; + HFONT oldFont; + FontFamily *familyPtr; + Tcl_DString runString; + CONST char *p, *end, *next; + SubFont *lastSubFontPtr, *thisSubFontPtr; + + lastSubFontPtr = &fontPtr->subFontArray[0]; + oldFont = SelectObject(hdc, lastSubFontPtr->hFont); + + end = source + numBytes; + for (p = source; p < end; ) { + next = p + Tcl_UtfToUniChar(p, &ch); + thisSubFontPtr = FindSubFontForChar(fontPtr, ch); + if (thisSubFontPtr != lastSubFontPtr) { + if (p > source) { + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, + p - source, &runString); + (*familyPtr->textOutProc)(hdc, x, y, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> familyPtr->isWideFont); + (*familyPtr->getTextExtentPoint32Proc)(hdc, + Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> familyPtr->isWideFont, + &size); + x += size.cx; + Tcl_DStringFree(&runString); + } + lastSubFontPtr = thisSubFontPtr; + source = p; + SelectObject(hdc, lastSubFontPtr->hFont); + } + p = next; + } + if (p > source) { + familyPtr = lastSubFontPtr->familyPtr; + Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, + &runString); + (*familyPtr->textOutProc)(hdc, x, y, Tcl_DStringValue(&runString), + Tcl_DStringLength(&runString) >> familyPtr->isWideFont); + Tcl_DStringFree(&runString); + } + SelectObject(hdc, oldFont); +} + +/* + *--------------------------------------------------------------------------- + * + * InitFont -- + * + * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). + * Initializes the memory for a new WinFont that wraps the + * platform-specific data. * * The caller is responsible for initializing the fields of the - * TkFont that are used exclusively by the generic TkFont code, and + * WinFont that are used exclusively by the generic TkFont code, and * for releasing those fields before calling TkpDeleteFont(). * + * Results: + * Fills the WinFont structure. + * * Side effects: * Memory allocated. * *--------------------------------------------------------------------------- */ -static TkFont * -AllocFont(tkFontPtr, tkwin, hFont) - TkFont *tkFontPtr; /* If non-NULL, store the information in - * this existing TkFont structure, rather than - * allocating a new structure to hold the - * font; the existing contents of the font - * will be released. If NULL, a new TkFont - * structure is allocated. */ - Tk_Window tkwin; /* For display where font will be used. */ - HFONT hFont; /* Windows information about font. */ +static void +InitFont( + Tk_Window tkwin, /* Main window of interp in which font will + * be used, for getting HDC. */ + HFONT hFont, /* Windows token for font. */ + int overstrike, /* The overstrike attribute of logfont used + * to allocate this font. For some reason, + * the TEXTMETRICs may contain incorrect info + * in the tmStruckOut field. */ + WinFont *fontPtr) /* Filled with information constructed from + * the above arguments. */ { - HWND hwnd; - WinFont *fontPtr; HDC hdc; + HWND hwnd; + HFONT oldFont; TEXTMETRIC tm; Window window; - char buf[LF_FACESIZE]; + TkFontMetrics *fmPtr; + Tcl_Encoding encoding; + Tcl_DString faceString; TkFontAttributes *faPtr; + char buf[LF_FACESIZE * sizeof(WCHAR)]; + + window = Tk_WindowId(tkwin); + hwnd = (window == None) ? NULL : TkWinGetHWND(window); + hdc = GetDC(hwnd); + oldFont = SelectObject(hdc, hFont); - if (tkFontPtr != NULL) { - fontPtr = (WinFont *) tkFontPtr; - DeleteObject(fontPtr->hFont); + GetTextMetrics(hdc, &tm); + + /* + * On any version NT, there may fonts with international names. + * Use the NT-only Unicode version of GetTextFace to get the font's + * name. If we used the ANSI version on a non-internationalized + * version of NT, we would get a font name with '?' replacing all + * the international characters. + * + * On a non-internationalized verson of 95, fonts with international + * names are not allowed, so the ANSI version of GetTextFace will work. + * On an internationalized version of 95, there may be fonts with + * international names; the ANSI version will work, fetching the + * name in the international system code page. Can't use the Unicode + * version of GetTextFace because it only exists under NT. + */ + + if (platformId == VER_PLATFORM_WIN32_NT) { + GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf); } else { - fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); + GetTextFaceA(hdc, LF_FACESIZE, (char *) buf); } - - window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr); - hwnd = (window == None) ? NULL : TkWinGetHWND(window); - - hdc = GetDC(hwnd); - hFont = SelectObject(hdc, hFont); - GetTextFace(hdc, sizeof(buf), buf); - GetTextMetrics(hdc, &tm); + Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString); fontPtr->font.fid = (Font) fontPtr; - faPtr = &fontPtr->font.fa; - faPtr->family = Tk_GetUid(buf); - faPtr->pointsize = MulDiv(tm.tmHeight - tm.tmInternalLeading, - 720 * WidthMMOfScreen(Tk_Screen(tkwin)), - 254 * WidthOfScreen(Tk_Screen(tkwin))); + faPtr = &fontPtr->font.fa; + faPtr->family = Tk_GetUid(Tcl_DStringValue(&faceString)); + faPtr->size = TkFontGetPoints(tkwin, -(tm.tmHeight - tm.tmInternalLeading)); faPtr->weight = (tm.tmWeight > FW_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL; faPtr->slant = (tm.tmItalic != 0) ? TK_FS_ITALIC : TK_FS_ROMAN; faPtr->underline = (tm.tmUnderlined != 0) ? 1 : 0; - faPtr->overstrike = (tm.tmStruckOut != 0) ? 1 : 0; + faPtr->overstrike = overstrike; + + fmPtr = &fontPtr->font.fm; + fmPtr->ascent = tm.tmAscent; + fmPtr->descent = tm.tmDescent; + fmPtr->maxWidth = tm.tmMaxCharWidth; + fmPtr->fixed = !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH); - fontPtr->font.fm.ascent = tm.tmAscent; - fontPtr->font.fm.descent = tm.tmDescent; - fontPtr->font.fm.maxWidth = tm.tmMaxCharWidth; - fontPtr->font.fm.fixed = !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH); + fontPtr->hwnd = hwnd; + fontPtr->pixelSize = tm.tmHeight - tm.tmInternalLeading; - hFont = SelectObject(hdc, hFont); + fontPtr->numSubFonts = 1; + fontPtr->subFontArray = fontPtr->staticSubFonts; + InitSubFont(hdc, hFont, 1, &fontPtr->subFontArray[0]); + + encoding = fontPtr->subFontArray[0].familyPtr->encoding; + if (encoding == unicodeEncoding) { + GetCharWidthW(hdc, 0, BASE_CHARS - 1, fontPtr->widths); + } else { + GetCharWidthA(hdc, 0, BASE_CHARS - 1, fontPtr->widths); + } + Tcl_DStringFree(&faceString); + + SelectObject(hdc, oldFont); ReleaseDC(hwnd, hdc); +} + +/* + *------------------------------------------------------------------------- + * + * ReleaseFont -- + * + * Called to release the windows-specific contents of a TkFont. + * The caller is responsible for freeing the memory used by the + * font itself. + * + * Results: + * None. + * + * Side effects: + * Memory is freed. + * + *--------------------------------------------------------------------------- + */ + +static void +ReleaseFont( + WinFont *fontPtr) /* The font to delete. */ +{ + int i; - fontPtr->hFont = hFont; - fontPtr->hwnd = hwnd; + for (i = 0; i < fontPtr->numSubFonts; i++) { + ReleaseSubFont(&fontPtr->subFontArray[i]); + } + if (fontPtr->subFontArray != fontPtr->staticSubFonts) { + ckfree((char *) fontPtr->subFontArray); + } +} + +/* + *------------------------------------------------------------------------- + * + * InitSubFont -- + * + * Wrap a screen font and load the FontFamily that represents + * it. Used to prepare a SubFont so that characters can be mapped + * from UTF-8 to the charset of the font. + * + * Results: + * The subFontPtr is filled with information about the font. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ - return (TkFont *) fontPtr; +static void +InitSubFont( + HDC hdc, /* HDC in which font can be selected. */ + HFONT hFont, /* The screen font. */ + int base, /* Non-zero if this SubFont is being used + * as the base font for a font object. */ + SubFont *subFontPtr) /* Filled with SubFont constructed from + * above attributes. */ +{ + subFontPtr->hFont = hFont; + subFontPtr->familyPtr = AllocFontFamily(hdc, hFont, base); + subFontPtr->fontMap = subFontPtr->familyPtr->fontMap; +} + +/* + *------------------------------------------------------------------------- + * + * ReleaseSubFont -- + * + * Called to release the contents of a SubFont. The caller is + * responsible for freeing the memory used by the SubFont itself. + * + * Results: + * None. + * + * Side effects: + * Memory and resources are freed. + * + *--------------------------------------------------------------------------- + */ + +static void +ReleaseSubFont( + SubFont *subFontPtr) /* The SubFont to delete. */ +{ + DeleteObject(subFontPtr->hFont); + FreeFontFamily(subFontPtr->familyPtr); +} + +/* + *------------------------------------------------------------------------- + * + * AllocFontFamily -- + * + * Find the FontFamily structure associated with the given font + * name. The information should be stored by the caller in a + * SubFont and used when determining if that SubFont supports a + * character. + * + * Cannot use the string name used to construct the font as the + * key, because the capitalization may not be canonical. Therefore + * use the face name actually retrieved from the font metrics as + * the key. + * + * Results: + * A pointer to a FontFamily. The reference count in the FontFamily + * is automatically incremented. When the SubFont is released, the + * reference count is decremented. When no SubFont is using this + * FontFamily, it may be deleted. + * + * Side effects: + * A new FontFamily structure will be allocated if this font family + * has not been seen. TrueType character existence metrics are + * loaded into the FontFamily structure. + * + *------------------------------------------------------------------------- + */ + +static FontFamily * +AllocFontFamily( + HDC hdc, /* HDC in which font can be selected. */ + HFONT hFont, /* Screen font whose FontFamily is to be + * returned. */ + int base) /* Non-zero if this font family is to be + * used in the base font of a font object. */ +{ + Tk_Uid faceName; + FontFamily *familyPtr; + Tcl_DString faceString; + Tcl_Encoding encoding; + char buf[LF_FACESIZE * sizeof(WCHAR)]; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + hFont = SelectObject(hdc, hFont); + if (platformId == VER_PLATFORM_WIN32_NT) { + GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf); + } else { + GetTextFaceA(hdc, LF_FACESIZE, (char *) buf); + } + Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString); + faceName = Tk_GetUid(Tcl_DStringValue(&faceString)); + Tcl_DStringFree(&faceString); + hFont = SelectObject(hdc, hFont); + + familyPtr = tsdPtr->fontFamilyList; + for ( ; familyPtr != NULL; familyPtr = familyPtr->nextPtr) { + if (familyPtr->faceName == faceName) { + familyPtr->refCount++; + return familyPtr; + } + } + + familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily)); + memset(familyPtr, 0, sizeof(FontFamily)); + familyPtr->nextPtr = tsdPtr->fontFamilyList; + tsdPtr->fontFamilyList = familyPtr; + + /* + * Set key for this FontFamily. + */ + + familyPtr->faceName = faceName; + + /* + * An initial refCount of 2 means that FontFamily information will + * persist even when the SubFont that loaded the FontFamily is released. + * Change it to 1 to cause FontFamilies to be unloaded when not in use. + */ + + familyPtr->refCount = 2; + + familyPtr->segCount = LoadFontRanges(hdc, hFont, &familyPtr->startCount, + &familyPtr->endCount, &familyPtr->isSymbolFont); + + encoding = NULL; + if (familyPtr->isSymbolFont != 0) { + /* + * Symbol fonts are handled specially. For instance, Unicode 0393 + * (GREEK CAPITAL GAMMA) must be mapped to Symbol character 0047 + * (GREEK CAPITAL GAMMA), because the Symbol font doesn't have a + * GREEK CAPITAL GAMMA at location 0393. If Tk interpreted the + * Symbol font using the Unicode encoding, it would decide that + * the Symbol font has no GREEK CAPITAL GAMMA, because the Symbol + * encoding (of course) reports that character 0393 doesn't exist. + * + * With non-symbol Windows fonts, such as Times New Roman, if the + * font has a GREEK CAPITAL GAMMA, it will be found in the correct + * Unicode location (0393); the GREEK CAPITAL GAMMA will not be off + * hiding at some other location. + */ + + encoding = Tcl_GetEncoding(NULL, faceName); + } + + if (encoding == NULL) { + encoding = Tcl_GetEncoding(NULL, "unicode"); + familyPtr->textOutProc = + (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutW; + familyPtr->getTextExtentPoint32Proc = + (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPoint32W; + familyPtr->isWideFont = 1; + } else { + familyPtr->textOutProc = + (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutA; + familyPtr->getTextExtentPoint32Proc = + (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPoint32A; + familyPtr->isWideFont = 0; + } + + familyPtr->encoding = encoding; + + return familyPtr; +} + +/* + *------------------------------------------------------------------------- + * + * FreeFontFamily -- + * + * Called to free a FontFamily when the SubFont is finished using it. + * Frees the contents of the FontFamily and the memory used by the + * FontFamily itself. + * + * Results: + * None. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +FreeFontFamily( + FontFamily *familyPtr) /* The FontFamily to delete. */ +{ + int i; + FontFamily **familyPtrPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (familyPtr == NULL) { + return; + } + familyPtr->refCount--; + if (familyPtr->refCount > 0) { + return; + } + for (i = 0; i < FONTMAP_PAGES; i++) { + if (familyPtr->fontMap[i] != NULL) { + ckfree(familyPtr->fontMap[i]); + } + } + if (familyPtr->startCount != NULL) { + ckfree((char *) familyPtr->startCount); + } + if (familyPtr->endCount != NULL) { + ckfree((char *) familyPtr->endCount); + } + if (familyPtr->encoding != unicodeEncoding) { + Tcl_FreeEncoding(familyPtr->encoding); + } + + /* + * Delete from list. + */ + + for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) { + if (*familyPtrPtr == familyPtr) { + *familyPtrPtr = familyPtr->nextPtr; + break; + } + familyPtrPtr = &(*familyPtrPtr)->nextPtr; + } + + ckfree((char *) familyPtr); +} + +/* + *------------------------------------------------------------------------- + * + * FindSubFontForChar -- + * + * Determine which screen font is necessary to use to display the + * given character. If the font object does not have a screen font + * that can display the character, another screen font may be loaded + * into the font object, following a set of preferred fallback rules. + * + * Results: + * The return value is the SubFont to use to display the given + * character. + * + * Side effects: + * The contents of fontPtr are modified to cache the results + * of the lookup and remember any SubFonts that were dynamically + * loaded. + * + *------------------------------------------------------------------------- + */ + +static SubFont * +FindSubFontForChar( + WinFont *fontPtr, /* The font object with which the character + * will be displayed. */ + int ch) /* The Unicode character to be displayed. */ +{ + HDC hdc; + int i, j, k; + CanUse canUse; + char **aliases, **anyFallbacks; + char ***fontFallbacks; + char *fallbackName; + SubFont *subFontPtr; + Tcl_DString ds; + + if (ch < BASE_CHARS) { + return &fontPtr->subFontArray[0]; + } + + for (i = 0; i < fontPtr->numSubFonts; i++) { + if (FontMapLookup(&fontPtr->subFontArray[i], ch)) { + return &fontPtr->subFontArray[i]; + } + } + + /* + * Keep track of all face names that we check, so we don't check some + * name multiple times if it can be reached by multiple paths. + */ + + Tcl_DStringInit(&ds); + hdc = GetDC(fontPtr->hwnd); + + aliases = TkFontGetAliasList(fontPtr->font.fa.family); + + fontFallbacks = TkFontGetFallbacks(); + for (i = 0; fontFallbacks[i] != NULL; i++) { + for (j = 0; fontFallbacks[i][j] != NULL; j++) { + fallbackName = fontFallbacks[i][j]; + if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) { + /* + * If the base font has a fallback... + */ + + goto tryfallbacks; + } else if (aliases != NULL) { + /* + * Or if an alias for the base font has a fallback... + */ + + for (k = 0; aliases[k] != NULL; k++) { + if (strcasecmp(aliases[k], fallbackName) == 0) { + goto tryfallbacks; + } + } + } + } + continue; + + /* + * ...then see if we can use one of the fallbacks, or an + * alias for one of the fallbacks. + */ + + tryfallbacks: + for (j = 0; fontFallbacks[i][j] != NULL; j++) { + fallbackName = fontFallbacks[i][j]; + subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName, + ch, &ds); + if (subFontPtr != NULL) { + goto end; + } + } + } + + /* + * See if we can use something from the global fallback list. + */ + + anyFallbacks = TkFontGetGlobalClass(); + for (i = 0; anyFallbacks[i] != NULL; i++) { + fallbackName = anyFallbacks[i]; + subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName, + ch, &ds); + if (subFontPtr != NULL) { + goto end; + } + } + + /* + * Try all face names available in the whole system until we + * find one that can be used. + */ + + canUse.hdc = hdc; + canUse.fontPtr = fontPtr; + canUse.nameTriedPtr = &ds; + canUse.ch = ch; + canUse.subFontPtr = NULL; + if (platformId == VER_PLATFORM_WIN32_NT) { + EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontCanUseProc, + (LPARAM) &canUse); + } else { + EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontCanUseProc, + (LPARAM) &canUse); + } + subFontPtr = canUse.subFontPtr; + + end: + Tcl_DStringFree(&ds); + + if (subFontPtr == NULL) { + /* + * No font can display this character. We will use the base font + * and have it display the "unknown" character. + */ + + subFontPtr = &fontPtr->subFontArray[0]; + FontMapInsert(subFontPtr, ch); + } + ReleaseDC(fontPtr->hwnd, hdc); + return subFontPtr; +} + +static int CALLBACK +WinFontCanUseProc( + ENUMLOGFONT *lfPtr, /* Logical-font data. */ + NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */ + int fontType, /* Type of font (not used). */ + LPARAM lParam) /* Result object to hold result. */ +{ + int ch; + HDC hdc; + WinFont *fontPtr; + CanUse *canUsePtr; + char *fallbackName; + SubFont *subFontPtr; + Tcl_DString faceString; + Tcl_DString *nameTriedPtr; + + canUsePtr = (CanUse *) lParam; + ch = canUsePtr->ch; + hdc = canUsePtr->hdc; + fontPtr = canUsePtr->fontPtr; + nameTriedPtr = canUsePtr->nameTriedPtr; + + fallbackName = lfPtr->elfLogFont.lfFaceName; + Tcl_ExternalToUtfDString(systemEncoding, fallbackName, -1, &faceString); + fallbackName = Tcl_DStringValue(&faceString); + + if (SeenName(fallbackName, nameTriedPtr) == 0) { + subFontPtr = CanUseFallback(hdc, fontPtr, fallbackName, ch); + if (subFontPtr != NULL) { + canUsePtr->subFontPtr = subFontPtr; + Tcl_DStringFree(&faceString); + return 0; + } + } + Tcl_DStringFree(&faceString); + return 1; +} + +/* + *------------------------------------------------------------------------- + * + * FontMapLookup -- + * + * See if the screen font can display the given character. + * + * Results: + * The return value is 0 if the screen font cannot display the + * character, non-zero otherwise. + * + * Side effects: + * New pages are added to the font mapping cache whenever the + * character belongs to a page that hasn't been seen before. + * When a page is loaded, information about all the characters on + * that page is stored, not just for the single character in + * question. + * + *------------------------------------------------------------------------- + */ + +static int +FontMapLookup( + SubFont *subFontPtr, /* Contains font mapping cache to be queried + * and possibly updated. */ + int ch) /* Character to be tested. */ +{ + int row, bitOffset; + + row = ch >> FONTMAP_SHIFT; + if (subFontPtr->fontMap[row] == NULL) { + FontMapLoadPage(subFontPtr, row); + } + bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); + return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1; +} + +/* + *------------------------------------------------------------------------- + * + * FontMapInsert -- + * + * Tell the font mapping cache that the given screen font should be + * used to display the specified character. This is called when no + * font on the system can be be found that can display that + * character; we lie to the font and tell it that it can display + * the character, otherwise we would end up re-searching the entire + * fallback hierarchy every time that character was seen. + * + * Results: + * None. + * + * Side effects: + * New pages are added to the font mapping cache whenever the + * character belongs to a page that hasn't been seen before. + * When a page is loaded, information about all the characters on + * that page is stored, not just for the single character in + * question. + * + *------------------------------------------------------------------------- + */ + +static void +FontMapInsert( + SubFont *subFontPtr, /* Contains font mapping cache to be + * updated. */ + int ch) /* Character to be added to cache. */ +{ + int row, bitOffset; + + row = ch >> FONTMAP_SHIFT; + if (subFontPtr->fontMap[row] == NULL) { + FontMapLoadPage(subFontPtr, row); + } + bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); + subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); +} + +/* + *------------------------------------------------------------------------- + * + * FontMapLoadPage -- + * + * Load information about all the characters on a given page. + * This information consists of one bit per character that indicates + * whether the associated HFONT can (1) or cannot (0) display the + * characters on the page. + * + * Results: + * None. + * + * Side effects: + * Mempry allocated. + * + *------------------------------------------------------------------------- + */ +static void +FontMapLoadPage( + SubFont *subFontPtr, /* Contains font mapping cache to be + * updated. */ + int row) /* Index of the page to be loaded into + * the cache. */ +{ + FontFamily *familyPtr; + Tcl_Encoding encoding; + char src[TCL_UTF_MAX], buf[16]; + USHORT *startCount, *endCount; + int i, j, bitOffset, end, segCount; + + subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8); + memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8); + + familyPtr = subFontPtr->familyPtr; + encoding = familyPtr->encoding; + + if (familyPtr->encoding == unicodeEncoding) { + /* + * Font is Unicode. Few fonts are going to have all characters, so + * examine the TrueType character existence metrics to determine + * what characters actually exist in this font. + */ + + segCount = familyPtr->segCount; + startCount = familyPtr->startCount; + endCount = familyPtr->endCount; + + j = 0; + end = (row + 1) << FONTMAP_SHIFT; + for (i = row << FONTMAP_SHIFT; i < end; i++) { + for ( ; j < segCount; j++) { + if (endCount[j] >= i) { + if (startCount[j] <= i) { + bitOffset = i & (FONTMAP_BITSPERPAGE - 1); + subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); + } + break; + } + } + } + } else if (familyPtr->isSymbolFont) { + /* + * Assume that a symbol font with a known encoding has all the + * characters that its encoding claims it supports. + * + * The test for "encoding == unicodeEncoding" + * must occur before this case, to catch all symbol fonts (such + * as {Comic Sans MS} or Wingdings) for which we don't have + * encoding information; those symbol fonts are treated as if + * they were in the Unicode encoding and their symbolic + * character existence metrics are treated as if they were Unicode + * character existence metrics. This way, although we don't know + * the proper Unicode -> symbol font mapping, we can install the + * symbol font as the base font and access its glyphs. + */ + + end = (row + 1) << FONTMAP_SHIFT; + for (i = row << FONTMAP_SHIFT; i < end; i++) { + if (Tcl_UtfToExternal(NULL, encoding, src, + Tcl_UniCharToUtf(i, src), TCL_ENCODING_STOPONERROR, NULL, + buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK) { + continue; + } + bitOffset = i & (FONTMAP_BITSPERPAGE - 1); + subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); + } + } +} + +/* + *--------------------------------------------------------------------------- + * + * CanUseFallbackWithAliases -- + * + * Helper function for FindSubFontForChar. Determine if the + * specified face name (or an alias of the specified face name) + * can be used to construct a screen font that can display the + * given character. + * + * Results: + * See CanUseFallback(). + * + * Side effects: + * If the name and/or one of its aliases was rejected, the + * rejected string is recorded in nameTriedPtr so that it won't + * be tried again. + * + *--------------------------------------------------------------------------- + */ + +static SubFont * +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. */ + 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 tried. It is possible for the same + * face name to be queried multiple times when + * trying to find a suitable screen font. */ +{ + int i; + char **aliases; + SubFont *subFontPtr; + + if (SeenName(faceName, nameTriedPtr) == 0) { + subFontPtr = CanUseFallback(hdc, fontPtr, faceName, ch); + if (subFontPtr != NULL) { + return subFontPtr; + } + } + aliases = TkFontGetAliasList(faceName); + if (aliases != NULL) { + for (i = 0; aliases[i] != NULL; i++) { + if (SeenName(aliases[i], nameTriedPtr) == 0) { + subFontPtr = CanUseFallback(hdc, fontPtr, aliases[i], ch); + if (subFontPtr != NULL) { + return subFontPtr; + } + } + } + } + return NULL; +} + +/* + *--------------------------------------------------------------------------- + * + * SeenName -- + * + * Used to determine we have already tried and rejected the given + * face name when looking for a screen font that can support some + * Unicode character. + * + * Results: + * The return value is 0 if this face name has not already been seen, + * non-zero otherwise. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +SeenName( + CONST char *name, /* The name to check. */ + Tcl_DString *dsPtr) /* Contains names that have already been + * seen. */ +{ + CONST char *seen, *end; + + seen = Tcl_DStringValue(dsPtr); + end = seen + Tcl_DStringLength(dsPtr); + while (seen < end) { + if (strcasecmp(seen, name) == 0) { + return 1; + } + seen += strlen(seen) + 1; + } + Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1)); + return 0; +} + +/* + *------------------------------------------------------------------------- + * + * CanUseFallback -- + * + * If the specified screen font has not already been loaded into + * the font object, determine if it can display the given character. + * + * Results: + * The return value is a pointer to a newly allocated SubFont, owned + * by the font object. This SubFont can be used to display the given + * character. The SubFont represents the screen font with the base set + * of font attributes from the font object, but using the specified + * font name. NULL is returned if the font object already holds + * a reference to the specified physical font or if the specified + * physical font cannot display the given character. + * + * Side effects: + * The font object's subFontArray is updated to contain a reference + * to the newly allocated SubFont. + * + *------------------------------------------------------------------------- + */ + +static SubFont * +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. */ + int ch) /* The Unicode character that the new + * screen font must be able to display. */ +{ + int i; + HFONT hFont; + SubFont subFont; + + if (FamilyExists(hdc, faceName) == 0) { + return NULL; + } + + /* + * Skip all fonts we've already used. + */ + + for (i = 0; i < fontPtr->numSubFonts; i++) { + if (faceName == fontPtr->subFontArray[i].familyPtr->faceName) { + return NULL; + } + } + + /* + * Load this font and see if it has the desired character. + */ + + hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize); + InitSubFont(hdc, hFont, 0, &subFont); + if (((ch < 256) && (subFont.familyPtr->isSymbolFont)) + || (FontMapLookup(&subFont, ch) == 0)) { + /* + * Don't use a symbol font as a fallback font for characters below + * 256. + */ + + ReleaseSubFont(&subFont); + return NULL; + } + + if (fontPtr->numSubFonts >= SUBFONT_SPACE) { + SubFont *newPtr; + + newPtr = (SubFont *) ckalloc(sizeof(SubFont) + * (fontPtr->numSubFonts + 1)); + memcpy((char *) newPtr, fontPtr->subFontArray, + fontPtr->numSubFonts * sizeof(SubFont)); + if (fontPtr->subFontArray != fontPtr->staticSubFonts) { + ckfree((char *) fontPtr->subFontArray); + } + fontPtr->subFontArray = newPtr; + } + fontPtr->subFontArray[fontPtr->numSubFonts] = subFont; + fontPtr->numSubFonts++; + return &fontPtr->subFontArray[fontPtr->numSubFonts - 1]; +} + +/* + *--------------------------------------------------------------------------- + * + * GetScreenFont -- + * + * Given the name and other attributes, construct an HFONT. + * This is where all the alias and fallback substitution bottoms + * out. + * + * Results: + * The screen font that corresponds to the attributes. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static HFONT +GetScreenFont( + CONST TkFontAttributes *faPtr, + /* Desired font attributes for new HFONT. */ + CONST char *faceName, /* Overrides font family specified in font + * attributes. */ + int pixelSize) /* Overrides size specified in font + * attributes. */ +{ + Tcl_DString ds; + HFONT hFont; + LOGFONTW lf; + + lf.lfHeight = -pixelSize; + lf.lfWidth = 0; + lf.lfEscapement = 0; + lf.lfOrientation = 0; + lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD; + lf.lfItalic = faPtr->slant; + lf.lfUnderline = faPtr->underline; + lf.lfStrikeOut = faPtr->overstrike; + lf.lfCharSet = DEFAULT_CHARSET; + lf.lfOutPrecision = OUT_TT_PRECIS; + lf.lfClipPrecision = CLIP_DEFAULT_PRECIS; + lf.lfQuality = DEFAULT_QUALITY; + lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; + + Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds); + + if (platformId == VER_PLATFORM_WIN32_NT) { + Tcl_UniChar *src, *dst; + src = (Tcl_UniChar *) Tcl_DStringValue(&ds); + dst = (Tcl_UniChar *) lf.lfFaceName; + while (*src != '\0') { + *dst++ = *src++; + } + *dst = '\0'; + hFont = CreateFontIndirectW(&lf); + } else { + strcpy((char *) lf.lfFaceName, Tcl_DStringValue(&ds)); + hFont = CreateFontIndirectA((LOGFONTA *) &lf); + } + Tcl_DStringFree(&ds); + return hFont; +} + +/* + *------------------------------------------------------------------------- + * + * FamilyExists, FamilyOrAliasExists, WinFontExistsProc -- + * + * Determines if any physical screen font exists on the system with + * the given family name. If the family exists, then it should be + * possible to construct some physical screen font with that family + * name. + * + * Results: + * The return value is 0 if the specified font family does not exist, + * non-zero otherwise. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +FamilyExists( + HDC hdc, /* HDC in which font family will be used. */ + CONST char *faceName) /* Font family to query. */ +{ + int result; + Tcl_DString faceString; + + /* + * Just immediately rule out the following fonts, because they look so + * ugly on windows. The caller's fallback mechanism will cause the + * corresponding appropriate TrueType fonts to be selected. + */ + + if (strcasecmp(faceName, "Courier") == 0) { + return 0; + } + if (strcasecmp(faceName, "Times") == 0) { + return 0; + } + if (strcasecmp(faceName, "Helvetica") == 0) { + return 0; + } + + Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &faceString); + + /* + * If the family exists, WinFontExistProc() will be called and + * EnumFontFamilies() will return whatever WinFontExistProc() returns. + * If the family doesn't exist, EnumFontFamilies() will just return a + * non-zero value. + */ + + if (platformId == 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); + } + Tcl_DStringFree(&faceString); + return (result == 0); } +static char * +FamilyOrAliasExists( + HDC hdc, + CONST char *faceName) +{ + char **aliases; + int i; + + if (FamilyExists(hdc, faceName) != 0) { + return (char *) faceName; + } + aliases = TkFontGetAliasList(faceName); + if (aliases != NULL) { + for (i = 0; aliases[i] != NULL; i++) { + if (FamilyExists(hdc, aliases[i]) != 0) { + return aliases[i]; + } + } + } + return NULL; +} + +static int CALLBACK +WinFontExistProc( + ENUMLOGFONT *lfPtr, /* Logical-font data. */ + NEWTEXTMETRIC *tmPtr, /* Physical-font data (not used). */ + int fontType, /* Type of font (not used). */ + LPARAM lParam) /* EnumFontData to hold result. */ +{ + return 0; +} + +/* + * The following data structures are used when querying a TrueType font file + * to determine which characters the font supports. + */ + +#pragma pack(1) /* Structures are byte aligned in file. */ + +#define CMAPHEX 0x636d6170 /* Key for character map resource. */ + +typedef struct CMAPTABLE { + USHORT version; /* Table version number (0). */ + USHORT numTables; /* Number of encoding tables following. */ +} CMAPTABLE; + +typedef struct ENCODINGTABLE { + USHORT platform; /* Platform for which data is targeted. + * 3 means data is for Windows. */ + USHORT encoding; /* How characters in font are encoded. + * 1 means that the following subtable is + * keyed based on Unicode. */ + ULONG offset; /* Byte offset from beginning of CMAPTABLE + * to the subtable for this encoding. */ +} ENCODINGTABLE; + +typedef struct ANYTABLE { + USHORT format; /* Format number. */ + USHORT length; /* The actual length in bytes of this + * subtable. */ + USHORT version; /* Version number (starts at 0). */ +} ANYTABLE; + +typedef struct BYTETABLE { + USHORT format; /* Format number is set to 0. */ + USHORT length; /* The actual length in bytes of this + * subtable. */ + USHORT version; /* Version number (starts at 0). */ + BYTE glyphIdArray[256]; /* Array that maps up to 256 single-byte char + * codes to glyph indices. */ +} BYTETABLE; + +typedef struct SUBHEADER { + USHORT firstCode; /* First valid low byte for subHeader. */ + USHORT entryCount; /* Number valid low bytes for subHeader. */ + SHORT idDelta; /* Constant adder to get base glyph index. */ + USHORT idRangeOffset; /* Byte offset from here to appropriate + * glyphIndexArray. */ +} SUBHEADER; + +typedef struct HIBYTETABLE { + 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). */ + USHORT subHeaderKeys[256]; /* Maps high bytes to subHeaders: value is + * subHeader index * 8. */ +#if 0 + SUBHEADER subHeaders[]; /* Variable-length array of SUBHEADERs. */ + USHORT glyphIndexArray[]; /* Variable-length array containing subarrays + * used for mapping the low byte of 2-byte + * characters. */ +#endif +} HIBYTETABLE; + +typedef struct SEGMENTTABLE { + USHORT format; /* Format number is set to 4. */ + USHORT length; /* The actual length in bytes of this + * subtable. */ + USHORT version; /* Version number (starts at 0). */ + USHORT segCountX2; /* 2 x segCount. */ + USHORT searchRange; /* 2 x (2**floor(log2(segCount))). */ + USHORT entrySelector; /* log2(searchRange/2). */ + USHORT rangeShift; /* 2 x segCount - searchRange. */ +#if 0 + USHORT endCount[segCount] /* End characterCode for each segment. */ + USHORT reservedPad; /* Set to 0. */ + USHORT startCount[segCount];/* Start character code for each segment. */ + USHORT idDelta[segCount]; /* Delta for all character in segment. */ + USHORT idRangeOffset[segCount]; /* Offsets into glyphIdArray or 0. */ + USHORT glyphIdArray[] /* Glyph index array. */ +#endif +} SEGMENTTABLE; + +typedef struct TRIMMEDTABLE { + USHORT format; /* Format number is set to 6. */ + USHORT length; /* The actual length in bytes of this + * subtable. */ + USHORT version; /* Version number (starts at 0). */ + USHORT firstCode; /* First character code of subrange. */ + USHORT entryCount; /* Number of character codes in subrange. */ +#if 0 + USHORT glyphIdArray[]; /* Array of glyph index values for + character codes in the range. */ +#endif +} TRIMMEDTABLE; + +typedef union SUBTABLE { + ANYTABLE any; + BYTETABLE byte; + HIBYTETABLE hiByte; + SEGMENTTABLE segment; + TRIMMEDTABLE trimmed; +} SUBTABLE; + +#pragma pack() + +/* + *------------------------------------------------------------------------- + * + * LoadFontRanges -- + * + * Given an HFONT, get the information about the characters that + * this font can display. + * + * Results: + * If the font has no Unicode character information, the return value + * is 0 and *startCountPtr and *endCountPtr are filled with NULL. + * Otherwise, *startCountPtr and *endCountPtr are set to pointers to + * arrays of TrueType character existence information and the return + * value is the length of the arrays (the two arrays are always the + * same length as each other). + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +LoadFontRanges( + HDC hdc, /* HDC into which font can be selected. */ + HFONT hFont, /* HFONT to query. */ + USHORT **startCountPtr, /* Filled with malloced pointer to + * character range information. */ + USHORT **endCountPtr, /* Filled with malloced pointer to + * character range information. */ + int *symbolPtr) + { + int n, i, swapped, offset, cbData, segCount; + DWORD cmapKey; + USHORT *startCount, *endCount; + CMAPTABLE cmapTable; + ENCODINGTABLE encTable; + SUBTABLE subTable; + char *s; + + segCount = 0; + startCount = NULL; + endCount = NULL; + *symbolPtr = 0; + + hFont = SelectObject(hdc, hFont); + + i = 0; + s = (char *) &i; + *s = '\1'; + swapped = 0; + + if (i == 1) { + swapped = 1; + } + + cmapKey = CMAPHEX; + if (swapped) { + SwapLong(&cmapKey); + } + + n = GetFontData(hdc, cmapKey, 0, &cmapTable, sizeof(cmapTable)); + if (n != GDI_ERROR) { + if (swapped) { + SwapShort(&cmapTable.numTables); + } + for (i = 0; i < cmapTable.numTables; i++) { + offset = sizeof(cmapTable) + i * sizeof(encTable); + GetFontData(hdc, cmapKey, offset, &encTable, sizeof(encTable)); + if (swapped) { + SwapShort(&encTable.platform); + SwapShort(&encTable.encoding); + SwapLong(&encTable.offset); + } + if (encTable.platform != 3) { + /* + * Not Microsoft encoding. + */ + + continue; + } + if (encTable.encoding == 0) { + *symbolPtr = 1; + } else if (encTable.encoding != 1) { + continue; + } + + GetFontData(hdc, cmapKey, encTable.offset, &subTable, + sizeof(subTable)); + if (swapped) { + SwapShort(&subTable.any.format); + } + if (subTable.any.format == 4) { + if (swapped) { + SwapShort(&subTable.segment.segCountX2); + } + segCount = subTable.segment.segCountX2 / 2; + cbData = segCount * sizeof(USHORT); + + startCount = (USHORT *) ckalloc(cbData); + endCount = (USHORT *) ckalloc(cbData); + + offset = encTable.offset + sizeof(subTable.segment); + GetFontData(hdc, cmapKey, offset, endCount, cbData); + offset += cbData + sizeof(USHORT); + GetFontData(hdc, cmapKey, offset, startCount, cbData); + if (swapped) { + for (i = 0; i < segCount; i++) { + SwapShort(&endCount[i]); + SwapShort(&startCount[i]); + } + } + if (*symbolPtr != 0) { + /* + * Empirically determined: When a symbol font is + * loaded, the character existence metrics obtained + * from the system are mildly wrong. If the real range + * of the symbol font is from 0020 to 00FE, then the + * metrics are reported as F020 to F0FE. When we load + * a symbol font, we must fix the character existence + * metrics. + */ + + for (i = 0; i < segCount; i++) { + if ((startCount[i] & 0xff00) == 0xf000) { + startCount[i] &= 0xff; + } + if ((endCount[i] & 0xff00) == 0xf000) { + endCount[i] &= 0xff; + } + } + } + } + } + } + SelectObject(hdc, hFont); + + *startCountPtr = startCount; + *endCountPtr = endCount; + return segCount; +} + +/* + *------------------------------------------------------------------------- + * + * SwapShort, SwapLong -- + * + * Helper functions to convert the data loaded from TrueType font + * files to Intel byte ordering. + * + * Results: + * Bytes of input value are swapped and stored back in argument. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +SwapShort(PUSHORT p) +{ + *p = (SHORT)(HIBYTE(*p) + (LOBYTE(*p) << 8)); +} + +static void +SwapLong(PULONG p) +{ + ULONG temp; + + temp = (LONG) ((BYTE) *p); + temp <<= 8; + *p >>=8; + + temp += (LONG) ((BYTE) *p); + temp <<= 8; + *p >>=8; + + temp += (LONG) ((BYTE) *p); + temp <<= 8; + *p >>=8; + + temp += (LONG) ((BYTE) *p); + *p = temp; +} diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 6cb21d8..93a4906 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinInit.c,v 1.2 1998/09/14 18:24:00 stanton Exp $ + * RCS: @(#) $Id: tkWinInit.c,v 1.3 1999/04/16 01:51:52 stanton Exp $ */ #include "tkWinInt.h" @@ -31,7 +31,7 @@ * * Results: * A standard Tcl completion code (TCL_OK or TCL_ERROR). Also - * leaves information in interp->result. + * leaves information in the interp's result. * * Side effects: * Sets "tk_library" Tcl variable, runs "tk.tcl" script. diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 816e483..7fb1ea4 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -5,12 +5,12 @@ * Windows-specific parts of Tk, but aren't used by the rest of * Tk. * - * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinInt.h,v 1.5 1999/03/10 19:29:24 redman Exp $ + * RCS: @(#) $Id: tkWinInt.h,v 1.6 1999/04/16 01:51:52 stanton Exp $ */ #ifndef _TKWININT @@ -28,6 +28,11 @@ #include "tkWin.h" #endif +#ifndef _TKPORT +#include "tkPort.h" +#endif + + /* * Define constants missing from older Win32 SDK header files. */ @@ -148,9 +153,8 @@ extern int tkpWinRopModes[]; #include "tkIntPlatDecls.h" -extern void TkWinSetForegroundWindow(TkWindow *winPtr); -extern LRESULT CALLBACK TkWinChildProc (HWND hwnd, UINT message, - WPARAM wParam, LPARAM lParam); +extern LRESULT CALLBACK TkWinChildProc _ANSI_ARGS_((HWND hwnd, UINT message, + WPARAM wParam, LPARAM lParam)); #endif /* _TKWININT */ diff --git a/win/tkWinKey.c b/win/tkWinKey.c index 98cc24f..1ef7958 100644 --- a/win/tkWinKey.c +++ b/win/tkWinKey.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinKey.c,v 1.3 1998/09/14 18:24:00 stanton Exp $ + * RCS: @(#) $Id: tkWinKey.c,v 1.4 1999/04/16 01:51:52 stanton Exp $ */ #include "tkWinInt.h" @@ -89,71 +89,59 @@ static Keys keymap[] = { /* *---------------------------------------------------------------------- * - * XLookupString -- + * TkpGetString -- * - * Retrieve the string equivalent for the given keyboard event. + * Retrieve the UTF string equivalent for the given keyboard event. * * Results: - * Returns the number of characters stored in buffer_return. + * Returns the UTF string. * * Side effects: - * Retrieves the characters stored in the event and inserts them - * into buffer_return. + * None. * *---------------------------------------------------------------------- */ -int -XLookupString(event_struct, buffer_return, bytes_buffer, keysym_return, - status_in_out) - XKeyEvent* event_struct; - char* buffer_return; - int bytes_buffer; - KeySym* keysym_return; - XComposeStatus* status_in_out; +char * +TkpGetString(winPtr, eventPtr, dsPtr) + TkWindow *winPtr; /* Window where event occurred: needed to + * get input context. */ + XEvent *eventPtr; /* X keyboard event. */ + Tcl_DString *dsPtr; /* Uninitialized or empty string to hold + * result. */ { - int i, limit; + int index; + KeySym keysym; + XKeyEvent* keyEv = &eventPtr->xkey; - if (event_struct->send_event != -1) { + Tcl_DStringInit(dsPtr); + if (eventPtr->xkey.send_event != -1) { /* * This is an event generated from generic code. It has no * nchars or trans_chars members. */ - int index; - KeySym keysym; - index = 0; - if (event_struct->state & ShiftMask) { + if (eventPtr->xkey.state & ShiftMask) { index |= 1; } - if (event_struct->state & Mod1Mask) { + if (eventPtr->xkey.state & Mod1Mask) { index |= 2; } - keysym = XKeycodeToKeysym(event_struct->display, - event_struct->keycode, index); + keysym = XKeycodeToKeysym(eventPtr->xkey.display, + eventPtr->xkey.keycode, index); if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256)) || (keysym == XK_Return) || (keysym == XK_Tab)) { - buffer_return[0] = (char) keysym; - return 1; + char buf[TCL_UTF_MAX]; + int len = Tcl_UniCharToUtf((Tcl_UniChar) keysym, buf); + Tcl_DStringAppend(dsPtr, buf, len); } - return 0; - } - if ((event_struct->nchars <= 0) || (buffer_return == NULL)) { - return 0; - } - limit = (event_struct->nchars < bytes_buffer) ? event_struct->nchars : - bytes_buffer; - - for (i = 0; i < limit; i++) { - buffer_return[i] = event_struct->trans_chars[i]; - } - - if (keysym_return != NULL) { - *keysym_return = NoSymbol; + } else if (eventPtr->xkey.nbytes > 0) { + Tcl_ExternalToUtfDString(NULL, eventPtr->xkey.trans_chars, + eventPtr->xkey.nbytes, dsPtr); } - return i; + return Tcl_DStringValue(dsPtr); } /* @@ -199,8 +187,8 @@ XKeycodeToKeysym(display, keycode, index) * for alphanumeric characters map onto Latin-1, we just return it. */ - if (result == 1 && buf[0] >= 0x20) { - return (KeySym) buf[0]; + if (result == 1 && UCHAR(buf[0]) >= 0x20) { + return (KeySym) UCHAR(buf[0]); } /* diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 734591d..b39d584 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -3,18 +3,20 @@ * * This module implements the Windows platform-specific features of menus. * - * Copyright (c) 1996-1997 by Sun Microsystems, Inc. + * Copyright (c) 1996-1998 by Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinMenu.c,v 1.4 1999/02/04 21:44:18 stanton Exp $ + * RCS: @(#) $Id: tkWinMenu.c,v 1.5 1999/04/16 01:51:52 stanton Exp $ */ #define OEMRESOURCE -#include <string.h> -#include "tkMenu.h" #include "tkWinInt.h" +#include "tkMenu.h" + +#include <string.h> /* * The class of the window for popup menus. @@ -50,34 +52,40 @@ static int indicatorDimensions[2]; /* The dimensions of the indicator space * in a menu entry. Calculated at init * time to save time. */ -static Tcl_HashTable commandTable; + +typedef struct ThreadSpecificData { + Tcl_HashTable commandTable; /* A map of command ids to menu entries */ -static int inPostMenu; /* We cannot be re-entrant like X Windows. */ -static WORD lastCommandID; /* The last command ID we allocated. */ -static HWND menuHWND; /* A window to service popup-menu messages + int inPostMenu; /* We cannot be re-entrant like X Windows. */ + WORD lastCommandID; /* The last command ID we allocated. */ + HWND menuHWND; /* A window to service popup-menu messages * in. */ -static int oldServiceMode; /* Used while processing a menu; we need + int oldServiceMode; /* Used while processing a menu; we need * to set the event mode specially when we * enter the menu processing modal loop * and reset it when menus go away. */ -static TkMenu *modalMenuPtr; /* The menu we are processing inside the modal + TkMenu *modalMenuPtr; /* The menu we are processing inside the modal * loop. We need this to reset all of the * active items when menus go away since * Windows does not see fit to give this * to us when it sends its WM_MENUSELECT. */ + Tcl_HashTable winMenuTable; + /* Need this to map HMENUs back to menuPtrs */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + static OSVERSIONINFO versionInfo; /* So we don't have to keep doing this */ -static Tcl_HashTable winMenuTable; - /* Need this to map HMENUs back to menuPtrs */ /* * The following are default menu value strings. */ -static char borderString[5]; /* The string indicating how big the border is */ +static int defaultBorderWidth; /* The windows default border width. */ static Tcl_DString menuFontDString; /* A buffer to store the default menu font * string. */ +TCL_DECLARE_MUTEX(winMenuMutex) /* * Forward declarations for procedures defined later in this file: @@ -122,7 +130,7 @@ static void DrawWindowsSystemBitmap _ANSI_ARGS_(( GC gc, CONST RECT *rectPtr, int bitmapID, int alignFlags)); static void FreeID _ANSI_ARGS_((int commandID)); -static char * GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr)); +static TCHAR * GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr)); static void GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int *widthPtr, @@ -154,6 +162,7 @@ static void ReconfigureWindowsMenu _ANSI_ARGS_(( ClientData clientData)); static void RecursivelyClearActiveMenu _ANSI_ARGS_(( TkMenu *menuPtr)); +static void SetDefaults _ANSI_ARGS_((int firstTime)); static LRESULT CALLBACK TkWinMenuProc _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); @@ -189,16 +198,18 @@ GetNewID(mePtr, menuIDPtr) int newEntry; Tcl_HashEntry *commandEntryPtr; WORD returnID; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - WORD curID = lastCommandID + 1; + WORD curID = tsdPtr->lastCommandID + 1; /* * The following code relies on WORD wrapping when the highest value is * incremented. */ - while (curID != lastCommandID) { - commandEntryPtr = Tcl_CreateHashEntry(&commandTable, + while (curID != tsdPtr->lastCommandID) { + commandEntryPtr = Tcl_CreateHashEntry(&tsdPtr->commandTable, (char *) curID, &newEntry); if (newEntry == 1) { found = 1; @@ -211,7 +222,7 @@ GetNewID(mePtr, menuIDPtr) if (found) { Tcl_SetHashValue(commandEntryPtr, (char *) mePtr); *menuIDPtr = (int) returnID; - lastCommandID = returnID; + tsdPtr->lastCommandID = returnID; return TCL_OK; } else { return TCL_ERROR; @@ -238,7 +249,10 @@ static void FreeID(commandID) int commandID; { - Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&commandTable, + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, (char *) commandID); if (entryPtr != NULL) { @@ -272,6 +286,8 @@ TkpNewMenu(menuPtr) HMENU winMenuHdl; Tcl_HashEntry *hashEntryPtr; int newEntry; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); winMenuHdl = CreatePopupMenu(); @@ -286,7 +302,7 @@ TkpNewMenu(menuPtr) * back when dispatch messages. */ - hashEntryPtr = Tcl_CreateHashEntry(&winMenuTable, (char *) winMenuHdl, + hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl, &newEntry); Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr); @@ -315,6 +331,9 @@ TkpDestroyMenu(menuPtr) TkMenu *menuPtr; /* The common menu structure */ { HMENU winMenuHdl = (HMENU) menuPtr->platformData; + char *searchName; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr); @@ -339,7 +358,8 @@ TkpDestroyMenu(menuPtr) for (searchEntryPtr = menuPtr->menuRefPtr->parentEntryPtr; searchEntryPtr != NULL; searchEntryPtr = searchEntryPtr->nextCascadePtr) { - if (strcmp(searchEntryPtr->name, menuName) == 0) { + searchName = Tcl_GetStringFromObj(searchEntryPtr->namePtr, NULL); + if (strcmp(searchName, menuName) == 0) { Tk_Window parentTopLevelPtr = searchEntryPtr ->menuPtr->parentTopLevelPtr; @@ -357,7 +377,8 @@ TkpDestroyMenu(menuPtr) * Remove the menu from the menu hash table, then destroy the handle. */ - hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) winMenuHdl); + hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, + (char *) winMenuHdl); if (hashEntryPtr != NULL) { Tcl_DeleteHashEntry(hashEntryPtr); } @@ -365,8 +386,8 @@ TkpDestroyMenu(menuPtr) } menuPtr->platformData = NULL; - if (menuPtr == modalMenuPtr) { - modalMenuPtr = NULL; + if (menuPtr == tsdPtr->modalMenuPtr) { + tsdPtr->modalMenuPtr = NULL; } } @@ -431,18 +452,23 @@ GetEntryText(mePtr) if (mePtr->type == TEAROFF_ENTRY) { itemText = ckalloc(sizeof("(Tear-off)")); strcpy(itemText, "(Tear-off)"); - } else if (mePtr->imageString != NULL) { + } else if (mePtr->imagePtr != NULL) { itemText = ckalloc(sizeof("(Image)")); strcpy(itemText, "(Image)"); - } else if (mePtr->bitmap != None) { + } else if (mePtr->bitmapPtr != NULL) { itemText = ckalloc(sizeof("(Pixmap)")); strcpy(itemText, "(Pixmap)"); - } else if (mePtr->label == NULL || mePtr->labelLength == 0) { + } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) { itemText = ckalloc(sizeof("( )")); strcpy(itemText, "( )"); } else { - int size = mePtr->labelLength + 1; - int i, j; + int i; + char *label = (mePtr->labelPtr == NULL) ? "" + : Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + char *accel = (mePtr->accelPtr == NULL) ? "" + : Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + char *p, *next; + Tcl_DString itemString; /* * We have to construct the string with an ampersand @@ -451,57 +477,32 @@ GetEntryText(mePtr) * ampersands in the string. */ - for (i = 0; i < mePtr->labelLength; i++) { - if (mePtr->label[i] == '&') { - size++; - } - } + Tcl_DStringInit(&itemString); - if (mePtr->underline >= 0) { - size++; - if (mePtr->label[mePtr->underline] == '&') { - size++; + for (p = label, i = 0; *p != '\0'; i++, p = next) { + if (i == mePtr->underline) { + Tcl_DStringAppend(&itemString, "&", 1); } - } - - if (mePtr->accelLength > 0) { - size += mePtr->accelLength + 1; - } - - for (i = 0; i < mePtr->accelLength; i++) { - if (mePtr->accel[i] == '&') { - size++; + if (*p == '&') { + Tcl_DStringAppend(&itemString, "&", 1); } + next = Tcl_UtfNext(p); + Tcl_DStringAppend(&itemString, p, next - p); } - - itemText = ckalloc(size); - - if (mePtr->labelLength == 0) { - itemText[0] = 0; - } else { - for (i = 0, j = 0; i < mePtr->labelLength; i++, j++) { - if (mePtr->label[i] == '&') { - itemText[j++] = '&'; - } - if (i == mePtr->underline) { - itemText[j++] = '&'; + if (mePtr->accelLength > 0) { + Tcl_DStringAppend(&itemString, "\t", 1); + for (p = accel, i = 0; *p != '\0'; i++, p = next) { + if (*p == '&') { + Tcl_DStringAppend(&itemString, "&", 1); } - itemText[j] = mePtr->label[i]; + next = Tcl_UtfNext(p); + Tcl_DStringAppend(&itemString, p, next - p); } - itemText[j] = '\0'; - } + } - if (mePtr->accelLength > 0) { - strcat(itemText, "\t"); - for (i = 0, j = strlen(itemText); i < mePtr->accelLength; - i++, j++) { - if (mePtr->accel[i] == '&') { - itemText[j++] = '&'; - } - itemText[j] = mePtr->accel[i]; - } - itemText[j] = '\0'; - } + itemText = ckalloc(Tcl_DStringLength(&itemString) + 1); + strcpy(itemText, Tcl_DStringValue(&itemString)); + Tcl_DStringFree(&itemString); } return itemText; } @@ -530,13 +531,14 @@ ReconfigureWindowsMenu( TkMenu *menuPtr = (TkMenu *) clientData; TkMenuEntry *mePtr; HMENU winMenuHdl = (HMENU) menuPtr->platformData; - char *itemText = NULL; - LPCTSTR lpNewItem; + TCHAR *itemText = NULL; + const TCHAR *lpNewItem; UINT flags; UINT itemID; int i, count, systemMenu = 0, base; int width, height; - + Tcl_DString translatedText; + if (NULL == winMenuHdl) { return; } @@ -565,6 +567,7 @@ ReconfigureWindowsMenu( lpNewItem = NULL; flags = MF_BYPOSITION; itemID = 0; + Tcl_DStringInit(&translatedText); if ((menuPtr->menuType == MENUBAR) && (mePtr->type == TEAROFF_ENTRY)) { continue; @@ -576,7 +579,8 @@ ReconfigureWindowsMenu( itemText = GetEntryText(mePtr); if ((menuPtr->menuType == MENUBAR) || (menuPtr->menuFlags & MENU_SYSTEM_MENU)) { - lpNewItem = itemText; + Tcl_UtfToExternalDString(NULL, itemText, -1, &translatedText); + lpNewItem = Tcl_DStringValue(&translatedText); } else { lpNewItem = (LPCTSTR) mePtr; flags |= MF_OWNERDRAW; @@ -586,7 +590,7 @@ ReconfigureWindowsMenu( * Set enabling and disabling correctly. */ - if (mePtr->state == tkDisabledUid) { + if (mePtr->state == ENTRY_DISABLED) { flags |= MF_DISABLED; } @@ -617,18 +621,21 @@ ReconfigureWindowsMenu( if ((menuPtr->menuType == MENUBAR) && !(mePtr->childMenuRefPtr->menuPtr->menuFlags & MENU_SYSTEM_MENU)) { + Tcl_DString ds; TkMenuReferences *menuRefPtr; TkMenu *systemMenuPtr = mePtr->childMenuRefPtr ->menuPtr; - char *systemMenuName = ckalloc(strlen( - Tk_PathName(menuPtr->masterMenuPtr->tkwin)) - + strlen(".system") + 1); - strcpy(systemMenuName, - Tk_PathName(menuPtr->masterMenuPtr->tkwin)); - strcat(systemMenuName, ".system"); + Tcl_DStringInit(&ds); + Tcl_DStringAppend(&ds, + Tk_PathName(menuPtr->masterMenuPtr->tkwin), -1); + Tcl_DStringAppend(&ds, ".system", 7); + menuRefPtr = TkFindMenuReferences(menuPtr->interp, - systemMenuName); + Tcl_DStringValue(&ds)); + + Tcl_DStringFree(&ds); + if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL) && (menuPtr->parentTopLevelPtr != NULL) @@ -653,7 +660,6 @@ ReconfigureWindowsMenu( } } } - ckfree(systemMenuName); } if (mePtr->childMenuRefPtr->menuPtr->menuFlags & MENU_SYSTEM_MENU) { @@ -664,6 +670,7 @@ ReconfigureWindowsMenu( if (!systemMenu) { InsertMenu(winMenuHdl, 0xFFFFFFFF, flags, itemID, lpNewItem); } + Tcl_DStringFree(&translatedText); if (itemText != NULL) { ckfree(itemText); itemText = NULL; @@ -709,8 +716,10 @@ TkpPostMenu(interp, menuPtr, x, y) POINT point; Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin); int oldServiceMode = Tcl_GetServiceMode(); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - inPostMenu++; + tsdPtr->inPostMenu++; if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr); @@ -719,7 +728,7 @@ TkpPostMenu(interp, menuPtr, x, y) result = TkPreprocessMenu(menuPtr); if (result != TCL_OK) { - inPostMenu--; + tsdPtr->inPostMenu--; return result; } @@ -729,7 +738,7 @@ TkpPostMenu(interp, menuPtr, x, y) */ if (menuPtr->tkwin == NULL) { - inPostMenu--; + tsdPtr->inPostMenu--; return TCL_OK; } @@ -770,14 +779,14 @@ TkpPostMenu(interp, menuPtr, x, y) } TrackPopupMenu(winMenuHdl, flags, x, y, 0, - menuHWND, &noGoawayRect); + tsdPtr->menuHWND, &noGoawayRect); Tcl_SetServiceMode(oldServiceMode); GetCursorPos(&point); Tk_PointerEvent(NULL, point.x, point.y); - if (inPostMenu) { - inPostMenu = 0; + if (tsdPtr->inPostMenu) { + tsdPtr->inPostMenu = 0; } return TCL_OK; } @@ -886,24 +895,27 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) int returnResult = 0; TkMenu *menuPtr; TkMenuEntry *mePtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); switch (*pMessage) { case WM_INITMENU: TkMenuInit(); - hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) *pwParam); + hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, + (char *) *pwParam); if (hashEntryPtr != NULL) { - oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + tsdPtr->oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); - modalMenuPtr = menuPtr; + tsdPtr->modalMenuPtr = menuPtr; if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr); ReconfigureWindowsMenu((ClientData) menuPtr); } - if (!inPostMenu) { + if (!tsdPtr->inPostMenu) { Tcl_Interp *interp; int code; - + interp = menuPtr->interp; Tcl_Preserve((ClientData)interp); code = TkPreprocessMenu(menuPtr); @@ -918,7 +930,7 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) *plResult = 0; returnResult = 1; } else { - modalMenuPtr = NULL; + tsdPtr->modalMenuPtr = NULL; } break; @@ -928,7 +940,7 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) if (HIWORD(*pwParam) != 0) { break; } - hashEntryPtr = Tcl_FindHashEntry(&commandTable, + hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, (char *)LOWORD(*pwParam)); if (hashEntryPtr == NULL) { break; @@ -949,21 +961,23 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) menuPtr = mePtr->menuPtr; menuRefPtr = TkFindMenuReferences(menuPtr->interp, Tk_PathName(menuPtr->tkwin)); - if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr - != NULL)) { - for (parentEntryPtr = menuRefPtr->parentEntryPtr; - strcmp(parentEntryPtr->name, - Tk_PathName(menuPtr->tkwin)) != 0; - parentEntryPtr = parentEntryPtr->nextCascadePtr) { - - /* - * Empty loop body. - */ + if ((menuRefPtr != NULL) + && (menuRefPtr->parentEntryPtr != NULL)) { + char *name; + for (parentEntryPtr = menuRefPtr->parentEntryPtr; + ; + parentEntryPtr = + parentEntryPtr->nextCascadePtr) { + name = Tcl_GetStringFromObj( + parentEntryPtr->namePtr, NULL); + if (strcmp(name, Tk_PathName(menuPtr->tkwin)) + == 0) { + break; + } } - if (parentEntryPtr->menuPtr - ->entries[parentEntryPtr->index]->state - != tkDisabledUid) { + if (parentEntryPtr->menuPtr->entries[parentEntryPtr->index] + ->state != ENTRY_DISABLED) { TkActivateMenuEntry(parentEntryPtr->menuPtr, parentEntryPtr->index); } @@ -972,8 +986,8 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) interp = menuPtr->interp; Tcl_Preserve((ClientData)interp); code = TkInvokeMenu(interp, menuPtr, mePtr->index); - if ((code != TCL_OK) && (code != TCL_CONTINUE) - && (code != TCL_BREAK)) { + if (code != TCL_OK && code != TCL_CONTINUE + && code != TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (menu invoke)"); Tcl_BackgroundError(interp); } @@ -987,19 +1001,27 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) case WM_MENUCHAR: { unsigned char menuChar = (unsigned char) LOWORD(*pwParam); - hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) *plParam); + hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, + (char *) *plParam); if (hashEntryPtr != NULL) { int i; *plResult = 0; menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); for (i = 0; i < menuPtr->numEntries; i++) { - int underline = menuPtr->entries[i]->underline; + int underline; + char *label; + + underline = menuPtr->entries[i]->underline; + if (menuPtr->entries[i]->labelPtr != NULL) { + label = Tcl_GetStringFromObj( + menuPtr->entries[i]->labelPtr, NULL); + } if ((-1 != underline) - && (NULL != menuPtr->entries[i]->label) + && (NULL != menuPtr->entries[i]->labelPtr) && (CharUpper((LPTSTR) menuChar) - == CharUpper((LPTSTR) (unsigned char) menuPtr - ->entries[i]->label[underline]))) { + == CharUpper((LPTSTR) (unsigned char) + label[underline]))) { *plResult = (2 << 16) | i; returnResult = 1; break; @@ -1020,9 +1042,14 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) itemPtr->itemHeight = mePtr->height; itemPtr->itemWidth = mePtr->width; if (mePtr->hideMargin) { - itemPtr->itemWidth += 2 - indicatorDimensions[0]; + itemPtr->itemWidth += 2 - indicatorDimensions[1]; } else { - itemPtr->itemWidth += 2 * menuPtr->activeBorderWidth; + int activeBorderWidth; + + Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, + &activeBorderWidth); + itemPtr->itemWidth += 2 * activeBorderWidth; } *plResult = 1; returnResult = 1; @@ -1036,13 +1063,15 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) Tk_FontMetrics fontMetrics; if (itemPtr != NULL) { + Tk_Font tkfont; + mePtr = (TkMenuEntry *) itemPtr->itemData; menuPtr = mePtr->menuPtr; twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable)); twdPtr->type = TWD_WINDC; twdPtr->winDC.hdc = itemPtr->hDC; - if (mePtr->state != tkDisabledUid) { + if (mePtr->state != ENTRY_DISABLED) { if (itemPtr->itemState & ODS_SELECTED) { TkActivateMenuEntry(menuPtr, mePtr->index); } else { @@ -1050,8 +1079,9 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) } } - Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics); - TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, menuPtr->tkfont, + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(tkfont, &fontMetrics); + TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, tkfont, &fontMetrics, itemPtr->rcItem.left, itemPtr->rcItem.top, itemPtr->rcItem.right - itemPtr->rcItem.left, itemPtr->rcItem.bottom @@ -1070,14 +1100,14 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) TkMenuInit(); if ((flags == 0xFFFF) && (*plParam == 0)) { - Tcl_SetServiceMode(oldServiceMode); - if (modalMenuPtr != NULL) { - RecursivelyClearActiveMenu(modalMenuPtr); + Tcl_SetServiceMode(tsdPtr->oldServiceMode); + if (tsdPtr->modalMenuPtr != NULL) { + RecursivelyClearActiveMenu(tsdPtr->modalMenuPtr); } } else { menuPtr = NULL; - if (*plParam != 0) { - hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, + if (*plParam != 0) { + hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) *plParam); if (hashEntryPtr != NULL) { menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); @@ -1090,15 +1120,17 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) if (flags & MF_POPUP) { mePtr = menuPtr->entries[LOWORD(*pwParam)]; } else { - hashEntryPtr = Tcl_FindHashEntry(&commandTable, + hashEntryPtr = Tcl_FindHashEntry( + &tsdPtr->commandTable, (char *) LOWORD(*pwParam)); if (hashEntryPtr != NULL) { - mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr); + mePtr = (TkMenuEntry *) + Tcl_GetHashValue(hashEntryPtr); } } } - if ((mePtr == NULL) || (mePtr->state == tkDisabledUid)) { + if ((mePtr == NULL) || (mePtr->state == ENTRY_DISABLED)) { TkActivateMenuEntry(menuPtr, -1); } else { TkActivateMenuEntry(menuPtr, mePtr->index); @@ -1171,18 +1203,21 @@ TkpSetWindowMenuBar(tkwin, menuPtr) TkMenu *menuPtr; /* The menu we are inserting */ { HMENU winMenuHdl; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (menuPtr != NULL) { Tcl_HashEntry *hashEntryPtr; int newEntry; winMenuHdl = (HMENU) menuPtr->platformData; - hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) winMenuHdl); + hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, + (char *) winMenuHdl); Tcl_DeleteHashEntry(hashEntryPtr); DestroyMenu(winMenuHdl); winMenuHdl = CreateMenu(); - hashEntryPtr = Tcl_CreateHashEntry(&winMenuTable, (char *) winMenuHdl, - &newEntry); + hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, + (char *) winMenuHdl, &newEntry); Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr); menuPtr->platformData = (TkMenuPlatformData) winMenuHdl; TkWinSetMenu(tkwin, winMenuHdl); @@ -1254,7 +1289,11 @@ GetMenuIndicatorGeometry ( if (mePtr->hideMargin) { *widthPtr = 0; } else { - *widthPtr = indicatorDimensions[1] - menuPtr->borderWidth; + int borderWidth; + + Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, + menuPtr->borderWidthPtr, &borderWidth); + *widthPtr = indicatorDimensions[1] - borderWidth; } } @@ -1286,10 +1325,11 @@ GetMenuAccelGeometry ( *heightPtr = fmPtr->linespace; if (mePtr->type == CASCADE_ENTRY) { *widthPtr = 0; - } else if (mePtr->accel == NULL) { + } else if (mePtr->accelPtr == NULL) { *widthPtr = 0; } else { - *widthPtr = Tk_TextWidth(tkfont, mePtr->accel, mePtr->accelLength); + char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength); } } @@ -1379,7 +1419,7 @@ DrawWindowsSystemBitmap(display, drawable, gc, rectPtr, bitmapID, alignFlags) Display *display; /* The display we are drawing into */ Drawable drawable; /* The drawable we are working with */ GC gc; /* The GC to draw with */ - CONST RECT *rectPtr; /* The rectangle to draw into */ + CONST RECT *rectPtr; /* The rectangle to draw into */ int bitmapID; /* The windows id of the system * bitmap to draw. */ int alignFlags; /* How to align the bitmap inside the @@ -1465,47 +1505,52 @@ DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr, x, int width; int height; { - if ((mePtr->type == CHECK_BUTTON_ENTRY || - mePtr->type == RADIO_BUTTON_ENTRY) - && mePtr->indicatorOn - && mePtr->entryFlags & ENTRY_SELECTED) { - RECT rect; - GC whichGC; - - if (mePtr->state != tkNormalUid) { - whichGC = gc; - } else { - whichGC = indicatorGC; - } - - rect.top = y; - rect.bottom = y + mePtr->height; - rect.left = menuPtr->borderWidth + menuPtr->activeBorderWidth + x; - rect.right = mePtr->indicatorSpace + x; + if ((mePtr->type == CHECK_BUTTON_ENTRY) + || (mePtr->type == RADIO_BUTTON_ENTRY)) { + if (mePtr->indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) { + RECT rect; + GC whichGC; + int borderWidth, activeBorderWidth; + if (mePtr->state != ENTRY_NORMAL) { + whichGC = gc; + } else { + whichGC = indicatorGC; + } - if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg != NULL) - && (versionInfo.dwMajorVersion >= 4)) { - RECT hilightRect; - COLORREF oldFgColor = whichGC->foreground; - - whichGC->foreground = GetSysColor(COLOR_3DHILIGHT); - hilightRect.top = rect.top + 1; - hilightRect.bottom = rect.bottom + 1; - hilightRect.left = rect.left + 1; - hilightRect.right = rect.right + 1; - DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, - &hilightRect, OBM_CHECK, 0); - whichGC->foreground = oldFgColor; - } + rect.top = y; + rect.bottom = y + mePtr->height; + Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, + menuPtr->borderWidthPtr, &borderWidth); + Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); + rect.left = borderWidth + activeBorderWidth + x; + rect.right = mePtr->indicatorSpace + x; + + if ((mePtr->state == ENTRY_DISABLED) + && (menuPtr->disabledFgPtr != NULL) + && (versionInfo.dwMajorVersion >= 4)) { + RECT hilightRect; + COLORREF oldFgColor = whichGC->foreground; + + whichGC->foreground = GetSysColor(COLOR_3DHILIGHT); + hilightRect.top = rect.top + 1; + hilightRect.bottom = rect.bottom + 1; + hilightRect.left = rect.left + 1; + hilightRect.right = rect.right + 1; + DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, + &hilightRect, OBM_CHECK, 0); + whichGC->foreground = oldFgColor; + } - DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect, - OBM_CHECK, 0); + DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect, + OBM_CHECK, 0); - if ((mePtr->state == tkDisabledUid) - && (menuPtr->disabledImageGC != None) - && (versionInfo.dwMajorVersion < 4)) { - XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC, - rect.left, rect.top, rect.right, rect.bottom); + if ((mePtr->state == ENTRY_DISABLED) + && (menuPtr->disabledImageGC != None) + && (versionInfo.dwMajorVersion < 4)) { + XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC, + rect.left, rect.top, rect.right, rect.bottom); + } } } } @@ -1550,18 +1595,23 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, { int baseline; int leftEdge = x + mePtr->indicatorSpace + mePtr->labelWidth; + char *accel; + + if (mePtr->accelPtr != NULL) { + accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + } baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; - if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg != NULL) - && ((mePtr->accel != NULL) + if ((mePtr->state == ENTRY_DISABLED) && (menuPtr->disabledFgPtr != NULL) + && ((mePtr->accelPtr != NULL) || ((mePtr->type == CASCADE_ENTRY) && drawArrow))) { if (versionInfo.dwMajorVersion >= 4) { COLORREF oldFgColor = gc->foreground; gc->foreground = GetSysColor(COLOR_3DHILIGHT); - if (mePtr->accel != NULL) { - Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel, + if (mePtr->accelPtr != NULL) { + Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, mePtr->accelLength, leftEdge + 1, baseline + 1); } @@ -1579,12 +1629,12 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, } } - if (mePtr->accel != NULL) { - Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel, + if (mePtr->accelPtr != NULL) { + Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, mePtr->accelLength, leftEdge, baseline); } - if ((mePtr->state == tkDisabledUid) + if ((mePtr->state == ENTRY_DISABLED) && (menuPtr->disabledImageGC != None) && (versionInfo.dwMajorVersion < 4)) { XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC, @@ -1601,7 +1651,7 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, rect.right = x + width - 1; DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect, OBM_MNARROW, ALIGN_BITMAP_RIGHT); - if ((mePtr->state == tkDisabledUid) + if ((mePtr->state == ENTRY_DISABLED) && (menuPtr->disabledImageGC != None) && (versionInfo.dwMajorVersion < 4)) { XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC, @@ -1640,13 +1690,15 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) int height; /* height of item */ { XPoint points[2]; + Tk_3DBorder border; points[0].x = x; points[0].y = y + height / 2; points[1].x = x + width - 1; points[1].y = points[0].y; - Tk_Draw3DPolygon(menuPtr->tkwin, d, - menuPtr->border, points, 2, 1, TK_RELIEF_RAISED); + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); + Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, + TK_RELIEF_RAISED); } /* @@ -1680,10 +1732,14 @@ DrawMenuUnderline( int height) /* Height of entry */ { if (mePtr->underline >= 0) { + char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + char *start = Tcl_UtfAtIndex(label, mePtr->underline); + char *end = Tcl_UtfNext(start); + Tk_UnderlineChars(menuPtr->display, d, - gc, tkfont, mePtr->label, x + mePtr->indicatorSpace, + gc, tkfont, label, x + mePtr->indicatorSpace, y + (height + fmPtr->ascent - fmPtr->descent) / 2, - mePtr->underline, mePtr->underline + 1); + start - label, end - label); } } @@ -1745,8 +1801,8 @@ MenuKeyBindProc(clientData, interp, eventPtr, tkwin, keySym) CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYDOWN, virtualKey, ((scanCode << 16) | (1 << 29))); - if (eventPtr->xkey.nchars > 0) { - for (i = 0; i < eventPtr->xkey.nchars; i++) { + if (eventPtr->xkey.nbytes > 0) { + for (i = 0; i < eventPtr->xkey.nbytes; i++) { CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSCHAR, @@ -1872,9 +1928,14 @@ DrawMenuEntryLabel( { int baseline; int indicatorSpace = mePtr->indicatorSpace; - int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth; + int activeBorderWidth; + int leftEdge; int imageHeight, imageWidth; + Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); + leftEdge = x + indicatorSpace + activeBorderWidth; + /* * Draw label or bitmap or image for entry. */ @@ -1892,27 +1953,25 @@ DrawMenuEntryLabel( imageHeight, d, leftEdge, (int) (y + (mePtr->height - imageHeight)/2)); } - } else if (mePtr->bitmap != None) { + } else if (mePtr->bitmapPtr != NULL) { int width, height; - - Tk_SizeOfBitmap(menuPtr->display, - mePtr->bitmap, &width, &height); - XCopyPlane(menuPtr->display, - mePtr->bitmap, d, - gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge, - (int) (y + (mePtr->height - height)/2), 1); + Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, &width, &height); + XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0, (unsigned) width, + (unsigned) height, leftEdge, + (int) (y + (mePtr->height - height)/2), 1); } else { if (mePtr->labelLength > 0) { - Tk_DrawChars(menuPtr->display, d, gc, - tkfont, mePtr->label, mePtr->labelLength, - leftEdge, baseline); + char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + Tk_DrawChars(menuPtr->display, d, gc, tkfont, label, + mePtr->labelLength, leftEdge, baseline); DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height); } } - if (mePtr->state == tkDisabledUid) { - if (menuPtr->disabledFg == NULL) { + if (mePtr->state == ENTRY_DISABLED) { + if (menuPtr->disabledFgPtr == NULL) { XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y, (unsigned) width, (unsigned) height); } else if ((mePtr->image != NULL) @@ -1983,6 +2042,7 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) { XPoint points[2]; int segmentWidth, maxX; + Tk_3DBorder border; if (menuPtr->menuType != MASTER_MENU) { return; @@ -1993,13 +2053,14 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) points[1].y = points[0].y; segmentWidth = 6; maxX = width - 1; + border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); while (points[0].x < maxX) { points[1].x = points[0].x + segmentWidth; if (points[1].x > maxX) { points[1].x = maxX; } - Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1, + Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, TK_RELIEF_RAISED); points[0].x += 2*segmentWidth; } @@ -2014,7 +2075,7 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height) * * Results: * Returns standard TCL result. If TCL_ERROR is returned, then - * interp->result contains an error message. + * the interp's result contains an error message. * * Side effects: * Configuration information get set for mePtr; old resources @@ -2085,8 +2146,7 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height, * Choose the gc for drawing the foreground part of the entry. */ - if ((mePtr->state == tkActiveUid) - && !strictMotif) { + if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) { gc = mePtr->activeGC; if (gc == NULL) { gc = menuPtr->activeGC; @@ -2094,21 +2154,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height, } else { TkMenuEntry *cascadeEntryPtr; int parentDisabled = 0; + char *name; for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr; cascadeEntryPtr != NULL; cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { - if (strcmp(cascadeEntryPtr->name, - Tk_PathName(menuPtr->tkwin)) == 0) { - if (cascadeEntryPtr->state == tkDisabledUid) { + name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL); + if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) { + if (mePtr->state == ENTRY_DISABLED) { parentDisabled = 1; } break; } } - if (((parentDisabled || (mePtr->state == tkDisabledUid))) - && (menuPtr->disabledFg != NULL)) { + if (((parentDisabled || (mePtr->state == ENTRY_DISABLED))) + && (menuPtr->disabledFgPtr != NULL)) { gc = mePtr->disabledGC; if (gc == NULL) { gc = menuPtr->disabledGC; @@ -2124,24 +2185,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height, if (indicatorGC == NULL) { indicatorGC = menuPtr->indicatorGC; } - - bgBorder = mePtr->border; - if (bgBorder == NULL) { - bgBorder = menuPtr->border; - } + + bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->borderPtr == NULL) ? menuPtr->borderPtr + : mePtr->borderPtr); if (strictMotif) { activeBorder = bgBorder; } else { - activeBorder = mePtr->activeBorder; - if (activeBorder == NULL) { - activeBorder = menuPtr->activeBorder; - } + activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, + (mePtr->activeBorderPtr == NULL) ? menuPtr->activeBorderPtr + : mePtr->activeBorderPtr); } - if (mePtr->tkfont == NULL) { + if (mePtr->fontPtr == NULL) { fmPtr = menuMetricsPtr; } else { - tkfont = mePtr->tkfont; + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } @@ -2204,13 +2263,16 @@ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr) if (mePtr->image != NULL) { Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr); - } else if (mePtr->bitmap != (Pixmap) NULL) { - Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr); + } else if (mePtr->bitmapPtr != NULL) { + Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr); } else { *heightPtr = fmPtr->linespace; - if (mePtr->label != NULL) { - *widthPtr = Tk_TextWidth(tkfont, mePtr->label, mePtr->labelLength); + if (mePtr->labelPtr != NULL) { + char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + + *widthPtr = Tk_TextWidth(tkfont, label, mePtr->labelLength); } else { *widthPtr = 0; } @@ -2247,7 +2309,7 @@ DrawMenuEntryBackground( int width, /* width of rectangle to draw */ int height) /* height of rectangle to draw */ { - if (mePtr->state == tkActiveUid) { + if (mePtr->state == ENTRY_ACTIVE) { bgBorder = activeBorder; } Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, @@ -2277,17 +2339,20 @@ void TkpComputeStandardMenuGeometry( TkMenu *menuPtr) /* Structure describing menu. */ { - Tk_Font tkfont; + Tk_Font menuFont, tkfont; Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr; int x, y, height, width, indicatorSpace, labelWidth, accelWidth; int windowWidth, windowHeight, accelSpace; int i, j, lastColumnBreak = 0; + int activeBorderWidth, borderWidth; if (menuPtr->tkwin == NULL) { return; } - x = y = menuPtr->borderWidth; + Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, + menuPtr->borderWidthPtr, &borderWidth); + x = y = borderWidth; indicatorSpace = labelWidth = accelWidth = 0; windowHeight = 0; @@ -2302,19 +2367,22 @@ TkpComputeStandardMenuGeometry( * give all of the geometry/drawing the entry's font and metrics. */ - Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics); - accelSpace = Tk_TextWidth(menuPtr->tkfont, "M", 1); + menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); + Tk_GetFontMetrics(menuFont, &menuMetrics); + accelSpace = Tk_TextWidth(menuFont, "M", 1); + Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, + menuPtr->activeBorderWidthPtr, &activeBorderWidth); for (i = 0; i < menuPtr->numEntries; i++) { - tkfont = menuPtr->entries[i]->tkfont; - if (tkfont == NULL) { - tkfont = menuPtr->tkfont; - fmPtr = &menuMetrics; - } else { + if (menuPtr->entries[i]->fontPtr == NULL) { + tkfont = menuFont; + fmPtr = &menuMetrics; + } else { + tkfont = Tk_GetFontFromObj(menuPtr->tkwin, + menuPtr->entries[i]->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } - if ((i > 0) && menuPtr->entries[i]->columnBreak) { if (accelWidth != 0) { labelWidth += accelSpace; @@ -2323,15 +2391,15 @@ TkpComputeStandardMenuGeometry( menuPtr->entries[j]->indicatorSpace = indicatorSpace; menuPtr->entries[j]->labelWidth = labelWidth; menuPtr->entries[j]->width = indicatorSpace + labelWidth - + accelWidth + 2 * menuPtr->activeBorderWidth; + + accelWidth + 2 * activeBorderWidth; menuPtr->entries[j]->x = x; menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN; } x += indicatorSpace + labelWidth + accelWidth - + 2 * menuPtr->borderWidth; + + 2 * borderWidth; indicatorSpace = labelWidth = accelWidth = 0; lastColumnBreak = i; - y = menuPtr->borderWidth; + y = borderWidth; } if (menuPtr->entries[i]->type == SEPARATOR_ENTRY) { @@ -2379,7 +2447,7 @@ TkpComputeStandardMenuGeometry( indicatorSpace = width; } - menuPtr->entries[i]->height += 2 * menuPtr->activeBorderWidth + 1; + menuPtr->entries[i]->height += 2 * activeBorderWidth + 1; } menuPtr->entries[i]->y = y; y += menuPtr->entries[i]->height; @@ -2395,16 +2463,15 @@ TkpComputeStandardMenuGeometry( menuPtr->entries[j]->indicatorSpace = indicatorSpace; menuPtr->entries[j]->labelWidth = labelWidth; menuPtr->entries[j]->width = indicatorSpace + labelWidth - + accelWidth + 2 * menuPtr->activeBorderWidth; + + accelWidth + 2 * activeBorderWidth; menuPtr->entries[j]->x = x; menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN; } windowWidth = x + indicatorSpace + labelWidth + accelWidth + accelSpace - + 2 * menuPtr->activeBorderWidth - + 2 * menuPtr->borderWidth; + + 2 * activeBorderWidth + 2 * borderWidth; - windowHeight += menuPtr->borderWidth; + windowHeight += borderWidth; /* * The X server doesn't like zero dimensions, so round up to at least @@ -2530,14 +2597,55 @@ static void MenuExitHandler( ClientData clientData) /* Not used */ { - DestroyWindow(menuHWND); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + DestroyWindow(tsdPtr->menuHWND); UnregisterClass(MENU_CLASS_NAME, Tk_GetHINSTANCE()); } /* *---------------------------------------------------------------------- * - * TkpMenuInit -- + * TkWinGetMenuSystemDefault -- + * + * Gets the Windows specific default value for a given X resource + * database name. + * + * Results: + * Returns a Tcl_Obj * with the default value. If there is no + * Windows-specific default for this attribute, returns NULL. + * This object has a ref count of 0. + * + * Side effects: + * Storage is allocated. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkWinGetMenuSystemDefault( + Tk_Window tkwin, /* A window to use. */ + char *dbName, /* The option database name. */ + char *className) /* The name of the option class. */ +{ + Tcl_Obj *valuePtr = NULL; + + if ((strcmp(dbName, "activeBorderWidth") == 0) || + (strcmp(dbName, "borderWidth") == 0)) { + valuePtr = Tcl_NewIntObj(defaultBorderWidth); + } else if (strcmp(dbName, "font") == 0) { + valuePtr = Tcl_NewStringObj(Tcl_DStringValue(&menuFontDString), + -1); + } + + return valuePtr; +} + +/* + *---------------------------------------------------------------------- + * + * TkWinMenuSetDefaults -- * * Sets up the hash tables and the variables used by the menu package. * @@ -2552,37 +2660,20 @@ MenuExitHandler( */ void -TkpMenuInit() +SetDefaults( + int firstTime) /* Is this the first time this + * has been called? */ { - WNDCLASS wndClass; - char sizeString[4]; + char sizeString[TCL_INTEGER_SPACE]; char faceName[LF_FACESIZE]; HDC scratchDC; Tcl_DString boldItalicDString; int bold = 0; int italic = 0; - int i; TEXTMETRIC tm; + int pointSize; + HFONT menuFont; - Tcl_InitHashTable(&winMenuTable, TCL_ONE_WORD_KEYS); - Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS); - - wndClass.style = CS_OWNDC; - wndClass.lpfnWndProc = TkWinMenuProc; - wndClass.cbClsExtra = 0; - wndClass.cbWndExtra = 0; - wndClass.hInstance = Tk_GetHINSTANCE(); - wndClass.hIcon = NULL; - wndClass.hCursor = NULL; - wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1); - wndClass.lpszMenuName = NULL; - wndClass.lpszClassName = MENU_CLASS_NAME; - RegisterClass(&wndClass); - - menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP, - 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL); - - Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL); versionInfo.dwOSVersionInfoSize = sizeof(versionInfo); @@ -2601,74 +2692,59 @@ TkpMenuInit() * out of options via a break statement. */ - for (i = 0; ; i++) { - if (tkMenuConfigSpecs[i].type == TK_CONFIG_END) { - break; - } + defaultBorderWidth = GetSystemMetrics(SM_CXBORDER); + if (GetSystemMetrics(SM_CYBORDER) > defaultBorderWidth) { + defaultBorderWidth = GetSystemMetrics(SM_CYBORDER); + } - if ((strcmp(tkMenuConfigSpecs[i].dbName, - "activeBorderWidth") == 0) || - (strcmp(tkMenuConfigSpecs[i].dbName, "borderWidth") == 0)) { - int borderWidth; - borderWidth = GetSystemMetrics(SM_CXBORDER); - if (GetSystemMetrics(SM_CYBORDER) > borderWidth) { - borderWidth = GetSystemMetrics(SM_CYBORDER); - } - sprintf(borderString, "%d", borderWidth); - tkMenuConfigSpecs[i].defValue = borderString; - } else if ((strcmp(tkMenuConfigSpecs[i].dbName, "font") == 0)) { - int pointSize; - HFONT menuFont; - - scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL); - Tcl_DStringInit(&menuFontDString); - - if (versionInfo.dwMajorVersion >= 4) { - NONCLIENTMETRICS ncMetrics; - - ncMetrics.cbSize = sizeof(ncMetrics); - SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics), - &ncMetrics, 0); - menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont); - } else { - menuFont = GetStockObject(SYSTEM_FONT); - } - SelectObject(scratchDC, menuFont); - GetTextMetrics(scratchDC, &tm); - GetTextFace(scratchDC, sizeof(menuFontDString), faceName); - pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading, - 72, GetDeviceCaps(scratchDC, LOGPIXELSY)); - if (tm.tmWeight >= 700) { - bold = 1; - } - if (tm.tmItalic) { - italic = 1; - } + scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL); + if (!firstTime) { + Tcl_DStringFree(&menuFontDString); + } + Tcl_DStringInit(&menuFontDString); - SelectObject(scratchDC, GetStockObject(SYSTEM_FONT)); - DeleteDC(scratchDC); + if (versionInfo.dwMajorVersion >= 4) { + NONCLIENTMETRICS ncMetrics; - DeleteObject(menuFont); - - Tcl_DStringAppendElement(&menuFontDString, faceName); - sprintf(sizeString, "%d", pointSize); - Tcl_DStringAppendElement(&menuFontDString, sizeString); - - if (bold == 1 || italic == 1) { - Tcl_DStringInit(&boldItalicDString); - if (bold == 1) { - Tcl_DStringAppendElement(&boldItalicDString, "bold"); - } - if (italic == 1) { - Tcl_DStringAppendElement(&boldItalicDString, "italic"); - } - Tcl_DStringAppendElement(&menuFontDString, - Tcl_DStringValue(&boldItalicDString)); - } + ncMetrics.cbSize = sizeof(ncMetrics); + SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics), + &ncMetrics, 0); + menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont); + } else { + menuFont = GetStockObject(SYSTEM_FONT); + } + SelectObject(scratchDC, menuFont); + GetTextMetrics(scratchDC, &tm); + GetTextFace(scratchDC, sizeof(menuFontDString), faceName); + pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading, + 72, GetDeviceCaps(scratchDC, LOGPIXELSY)); + if (tm.tmWeight >= 700) { + bold = 1; + } + if (tm.tmItalic) { + italic = 1; + } + + SelectObject(scratchDC, GetStockObject(SYSTEM_FONT)); + DeleteDC(scratchDC); - tkMenuConfigSpecs[i].defValue = Tcl_DStringValue(&menuFontDString); + DeleteObject(menuFont); + + Tcl_DStringAppendElement(&menuFontDString, faceName); + sprintf(sizeString, "%d", pointSize); + Tcl_DStringAppendElement(&menuFontDString, sizeString); + + if (bold == 1 || italic == 1) { + Tcl_DStringInit(&boldItalicDString); + if (bold == 1) { + Tcl_DStringAppendElement(&boldItalicDString, "bold"); + } + if (italic == 1) { + Tcl_DStringAppendElement(&boldItalicDString, "italic"); } + Tcl_DStringAppendElement(&menuFontDString, + Tcl_DStringValue(&boldItalicDString)); } /* @@ -2692,5 +2768,72 @@ TkpMenuInit() indicatorDimensions[0] = HIWORD(dimensions); indicatorDimensions[1] = LOWORD(dimensions); } +} + +/* + *---------------------------------------------------------------------- + * + * TkpMenuInit -- + * + * Sets up the process-wide variables used by the menu package. + * + * Results: + * None. + * + * Side effects: + * lastMenuID gets initialized. + * + *---------------------------------------------------------------------- + */ + +void +TkpMenuInit() +{ + WNDCLASS wndClass; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + wndClass.style = CS_OWNDC; + wndClass.lpfnWndProc = TkWinMenuProc; + wndClass.cbClsExtra = 0; + wndClass.cbWndExtra = 0; + wndClass.hInstance = Tk_GetHINSTANCE(); + wndClass.hIcon = NULL; + wndClass.hCursor = NULL; + wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1); + wndClass.lpszMenuName = NULL; + wndClass.lpszClassName = MENU_CLASS_NAME; + RegisterClass(&wndClass); + + tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP, + 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL); + + Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL); + SetDefaults(1); +} + +/* + *---------------------------------------------------------------------- + * + * TkpMenuThreadInit -- + * + * Sets up the thread-local hash tables used by the menu module. + * + * Results: + * None. + * + * Side effects: + * Hash tables winMenuTable and commandTable are initialized. + * + *---------------------------------------------------------------------- + */ + +void +TkpMenuThreadInit() +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_InitHashTable(&tsdPtr->winMenuTable, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(&tsdPtr->commandTable, TCL_ONE_WORD_KEYS); } diff --git a/win/tkWinPointer.c b/win/tkWinPointer.c index 289ff4b..d503417 100644 --- a/win/tkWinPointer.c +++ b/win/tkWinPointer.c @@ -4,11 +4,12 @@ * Windows specific mouse tracking code. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinPointer.c,v 1.5 1999/03/10 19:29:24 redman Exp $ + * RCS: @(#) $Id: tkWinPointer.c,v 1.6 1999/04/16 01:51:53 stanton Exp $ */ #include "tkWinInt.h" diff --git a/win/tkWinPort.h b/win/tkWinPort.h index d673d46..5391b21 100644 --- a/win/tkWinPort.h +++ b/win/tkWinPort.h @@ -6,12 +6,11 @@ * file that contains #ifdefs to handle different flavors of OS. * * Copyright (c) 1995-1996 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinPort.h,v 1.4 1999/03/10 07:04:46 stanton Exp $ + * RCS: @(#) $Id: tkWinPort.h,v 1.5 1999/04/16 01:51:53 stanton Exp $ */ #ifndef _WINPORT @@ -22,6 +21,7 @@ #include <X11/keysym.h> #include <X11/Xatom.h> #include <X11/Xutil.h> + #include <malloc.h> #include <errno.h> #include <ctype.h> @@ -33,6 +33,7 @@ #include <io.h> #include <sys/stat.h> #include <time.h> +#include <tchar.h> #ifdef _MSC_VER # define hypot _hypot @@ -110,16 +111,8 @@ struct timezone { int tz_dsttime; }; -extern int gettimeofday(struct timeval *, struct timezone *); - -/* - * tclInt.h is included to get declarations of the following functions. - * void panic _ANSI_ARGS_(TCL_VARARGS(char *,format)); - * void TclpGetTime _ANSI_ARGS_((Tcl_Time *time)); - */ - #ifndef _TCLINT -# include <tclInt.h> +#include <tclInt.h> #endif #endif /* _WINPORT */ diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c index 619a6f9..e81e77c 100644 --- a/win/tkWinScrlbr.c +++ b/win/tkWinScrlbr.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinScrlbr.c,v 1.2 1998/09/14 18:24:01 stanton Exp $ + * RCS: @(#) $Id: tkWinScrlbr.c,v 1.3 1999/04/16 01:51:53 stanton Exp $ */ #include "tkWinInt.h" @@ -57,12 +57,14 @@ static int initialized = 0; static int hArrowWidth, hThumb; /* Horizontal control metrics. */ static int vArrowWidth, vArrowHeight, vThumb; /* Vertical control metrics. */ +TCL_DECLARE_MUTEX(winScrlbrMutex) + /* * This variable holds the default width for a scrollbar in string * form for use in a Tk_ConfigSpec. */ -static char defWidth[8]; +static char defWidth[TCL_INTEGER_SPACE]; /* * Declarations for functions defined in this file. @@ -116,8 +118,10 @@ TkpCreateScrollbar(tkwin) TkWindow *winPtr = (TkWindow *)tkwin; if (!initialized) { + Tcl_MutexLock(&winScrlbrMutex); UpdateScrollbarMetrics(); initialized = 1; + Tcl_MutexUnlock(&winScrlbrMutex); } scrollPtr = (WinScrollbar *) ckalloc(sizeof(WinScrollbar)); diff --git a/win/tkWinTest.c b/win/tkWinTest.c new file mode 100644 index 0000000..00553eb --- /dev/null +++ b/win/tkWinTest.c @@ -0,0 +1,230 @@ +/* + * tkWinTest.c -- + * + * Contains commands for platform specific tests for + * the Windows platform. + * + * Copyright (c) 1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkWinTest.c,v 1.2 1999/04/16 01:51:53 stanton Exp $ + */ + +#include "tkWinInt.h" + +HWND tkWinCurrentDialog; + +/* + * Forward declarations of procedures defined later in this file: + */ + +int TkplatformtestInit(Tcl_Interp *interp); +static int TestclipboardCmd(ClientData clientData, + Tcl_Interp *interp, int argc, char **argv); +static int TestwineventCmd(ClientData clientData, + Tcl_Interp *interp, int argc, char **argv); + + +/* + *---------------------------------------------------------------------- + * + * TkplatformtestInit -- + * + * Defines commands that test platform specific functionality for + * Unix platforms. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Defines new commands. + * + *---------------------------------------------------------------------- + */ + +int +TkplatformtestInit( + Tcl_Interp *interp) /* Interpreter to add commands to. */ +{ + /* + * Add commands for platform specific tests on MacOS here. + */ + + Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestclipboardCmd -- + * + * This procedure implements the testclipboard command. It provides + * a way to determine the actual contents of the Windows clipboard. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestclipboardCmd(clientData, interp, argc, argv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + TkWindow *winPtr = (TkWindow *) clientData; + HGLOBAL handle; + char *data; + + if (OpenClipboard(NULL)) { + handle = GetClipboardData(CF_TEXT); + if (handle != NULL) { + data = GlobalLock(handle); + Tcl_AppendResult(interp, data, (char *) NULL); + GlobalUnlock(handle); + } + CloseClipboard(); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestwineventCmd -- + * + * This procedure implements the testwinevent command. It provides + * a way to send messages to windows dialogs. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestwineventCmd(clientData, interp, argc, argv) + ClientData clientData; /* Main window for application. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + HWND hwnd; + int id; + char *rest; + UINT message; + WPARAM wParam; + LPARAM lParam; + static TkStateMap messageMap[] = { + {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"}, + {WM_LBUTTONUP, "WM_LBUTTONUP"}, + {WM_CHAR, "WM_CHAR"}, + {WM_GETTEXT, "WM_GETTEXT"}, + {WM_SETTEXT, "WM_SETTEXT"}, + {-1, NULL} + }; + + if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) { + int i; + + if (Tcl_GetBoolean(interp, argv[2], &i) != TCL_OK) { + return TCL_ERROR; + } + TkWinDialogDebug(i); + return TCL_OK; + } + + if (argc < 4) { + return TCL_ERROR; + } + + hwnd = (HWND) strtol(argv[1], &rest, 0); + if (rest == argv[2]) { + hwnd = FindWindow(NULL, argv[1]); + if (hwnd == NULL) { + Tcl_SetResult(interp, "no such window", TCL_STATIC); + return TCL_ERROR; + } + } + UpdateWindow(hwnd); + + id = strtol(argv[2], &rest, 0); + if (rest == argv[2]) { + HWND child; + 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) { + id = GetDlgCtrlID(child); + break; + } + child = GetWindow(child, GW_HWNDNEXT); + } + if (child == NULL) { + return TCL_ERROR; + } + } + message = TkFindStateNum(NULL, NULL, messageMap, argv[3]); + if (message < 0) { + message = strtol(argv[3], NULL, 0); + } + wParam = 0; + lParam = 0; + + if (argc > 4) { + wParam = strtol(argv[4], NULL, 0); + } + if (argc > 5) { + lParam = strtol(argv[5], NULL, 0); + } + + switch (message) { + case WM_GETTEXT: { + Tcl_DString ds; + char buf[256]; + + GetDlgItemText(hwnd, id, buf, 256); + Tcl_ExternalToUtfDString(NULL, buf, -1, &ds); + Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); + Tcl_DStringFree(&ds); + break; + } + case WM_SETTEXT: { + Tcl_DString ds; + + Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); + SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + break; + } + default: { + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "%d", + SendDlgItemMessage(hwnd, id, message, wParam, lParam)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + break; + } + } + return TCL_OK; +} + + + diff --git a/win/tkWinWindow.c b/win/tkWinWindow.c index 7d321d9..1b0e7a4 100644 --- a/win/tkWinWindow.c +++ b/win/tkWinWindow.c @@ -4,27 +4,22 @@ * Xlib emulation routines for Windows related to creating, * displaying and destroying windows. * - * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinWindow.c,v 1.4 1998/09/14 18:24:01 stanton Exp $ + * RCS: @(#) $Id: tkWinWindow.c,v 1.5 1999/04/16 01:51:54 stanton Exp $ */ #include "tkWinInt.h" -/* - * The windowTable maps from HWND to Tk_Window handles. - */ - -static Tcl_HashTable windowTable; - -/* - * Have statics in this module been initialized? - */ - -static int initialized = 0; +typedef struct ThreadSpecificData { + int initialized; /* 0 means table below needs initializing. */ + Tcl_HashTable windowTable; /* The windowTable maps from HWND to + * Tk_Window handles. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations for procedures defined in this file: @@ -61,10 +56,12 @@ Tk_AttachHWND(tkwin, hwnd) int new; Tcl_HashEntry *entryPtr; TkWinDrawable *twdPtr = (TkWinDrawable *) Tk_WindowId(tkwin); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (!initialized) { - Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS); - initialized = 1; + if (!tsdPtr->initialized) { + Tcl_InitHashTable(&tsdPtr->windowTable, TCL_ONE_WORD_KEYS); + tsdPtr->initialized = 1; } /* @@ -77,7 +74,7 @@ Tk_AttachHWND(tkwin, hwnd) twdPtr->type = TWD_WINDOW; twdPtr->window.winPtr = (TkWindow *) tkwin; } else if (twdPtr->window.handle != NULL) { - entryPtr = Tcl_FindHashEntry(&windowTable, + entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char *)twdPtr->window.handle); Tcl_DeleteHashEntry(entryPtr); } @@ -87,7 +84,7 @@ Tk_AttachHWND(tkwin, hwnd) */ twdPtr->window.handle = hwnd; - entryPtr = Tcl_CreateHashEntry(&windowTable, (char *)hwnd, &new); + entryPtr = Tcl_CreateHashEntry(&tsdPtr->windowTable, (char *)hwnd, &new); Tcl_SetHashValue(entryPtr, (ClientData)tkwin); return (Window)twdPtr; @@ -115,11 +112,14 @@ Tk_HWNDToWindow(hwnd) HWND hwnd; { Tcl_HashEntry *entryPtr; - if (!initialized) { - Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS); - initialized = 1; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (!tsdPtr->initialized) { + Tcl_InitHashTable(&tsdPtr->windowTable, TCL_ONE_WORD_KEYS); + tsdPtr->initialized = 1; } - entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd); + entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd); if (entryPtr != NULL) { return (Tk_Window) Tcl_GetHashValue(entryPtr); } @@ -190,7 +190,7 @@ TkpPrintWindowId(buf, window) * The return value is normally TCL_OK; in this case *idPtr * will be set to the X Window id equivalent to string. If * string is improperly formed then TCL_ERROR is returned and - * an error message will be left in interp->result. If the + * an error message will be left in the interp's result. If the * number does not correspond to a Tk Window, then *idPtr will * be set to None. * @@ -295,6 +295,8 @@ XDestroyWindow(display, w) TkWinDrawable *twdPtr = (TkWinDrawable *)w; TkWindow *winPtr = TkWinGetWinPtr(w); HWND hwnd = Tk_GetHWND(w); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); display->request++; @@ -305,7 +307,7 @@ XDestroyWindow(display, w) TkPointerDeadWindow(winPtr); - entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd); + entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd); if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index a0ed0ae..71b78ca 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -7,12 +7,12 @@ * to the window manager. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinWm.c,v 1.7 1999/03/10 19:29:24 redman Exp $ + * RCS: @(#) $Id: tkWinWm.c,v 1.8 1999/04/16 01:51:54 stanton Exp $ */ #include "tkWinInt.h" @@ -227,22 +227,6 @@ typedef struct TkWmInfo { (WS_EX_TOOLWINDOW|WS_EX_DLGMODALFRAME) /* - * This module keeps a list of all top-level windows. - */ - -static WmInfo *firstWmPtr = NULL; /* Points to first top-level window. */ -static WmInfo *foregroundWmPtr = NULL; /* Points to the foreground window. */ - -/* - * The variable below is used to enable or disable tracing in this - * module. If tracing is enabled, then information is printed on - * standard output about interesting interactions with the window - * manager. - */ - -static int wmTracing = 0; - -/* * The following structure is the official type record for geometry * management of top-level windows. */ @@ -255,41 +239,36 @@ static Tk_GeomMgr wmMgrType = { (Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */ }; -/* - * Global system palette. This value always refers to the currently - * installed foreground logical palette. - */ - -static HPALETTE systemPalette = NULL; - -/* - * Window that is being constructed. This value is set immediately - * before a call to CreateWindowEx, and is used by SetLimits. - * This is a gross hack needed to work around Windows brain damage - * where it sends the WM_GETMINMAXINFO message before the WM_CREATE - * window. - */ - -static TkWindow *createWindow = NULL; - -/* - * Flag indicating whether this module has been initialized yet. - */ - -static int initialized = 0; +typedef struct ThreadSpecificData { + HPALETTE systemPalette; /* System palette; refers to the + * currently installed foreground logical + * palette. */ + TkWindow *createWindow; /* Window that is being constructed. This + * value is set immediately before a + * call to CreateWindowEx, and is used + * by SetLimits. This is a gross hack + * needed to work around Windows brain + * damage where it sends the + * WM_GETMINMAXINFO message before the + * WM_CREATE window. */ + int initialized; /* Flag indicating whether thread- + * specific elements of module have + * been initialized. */ + int firstWindow; /* Flag, cleared when the first window + * is mapped in a non-iconic state. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* - * Class for toplevel windows. + * The following variables cannot be placed in thread local storage + * because they must be shared across threads. */ -static WNDCLASS toplevelClass; - -/* - * This flag is cleared when the first window is mapped in a non-iconic - * state. - */ +static WNDCLASS toplevelClass; /* Class for toplevel windows. */ +static int initialized; /* Flag indicating whether module has + * been initialized. */ +TCL_DECLARE_MUTEX(winWmMutex) -static int firstWindow = 1; /* * Forward declarations for procedures defined in this file: @@ -314,7 +293,8 @@ static void InvalidateSubTree _ANSI_ARGS_((TkWindow *winPtr, Colormap colormap)); static int ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp, char *string, TkWindow *winPtr)); -static void RefreshColormap _ANSI_ARGS_((Colormap colormap)); +static void RefreshColormap _ANSI_ARGS_((Colormap colormap, + TkDisplay *dispPtr)); static void SetLimits _ANSI_ARGS_((HWND hwnd, MINMAXINFO *info)); static LRESULT CALLBACK TopLevelProc _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); @@ -347,24 +327,49 @@ static LRESULT CALLBACK WmProc _ANSI_ARGS_((HWND hwnd, UINT message, static void InitWm(void) { - if (initialized) { - return; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + WNDCLASS * classPtr; + + if (! tsdPtr->initialized) { + tsdPtr->initialized = 1; + tsdPtr->firstWindow = 1; } - initialized = 1; - - toplevelClass.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC; - toplevelClass.cbClsExtra = 0; - toplevelClass.cbWndExtra = 0; - toplevelClass.hInstance = Tk_GetHINSTANCE(); - toplevelClass.hbrBackground = NULL; - toplevelClass.lpszMenuName = NULL; - toplevelClass.lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME; - toplevelClass.lpfnWndProc = WmProc; - toplevelClass.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk"); - toplevelClass.hCursor = LoadCursor(NULL, IDC_ARROW); - - if (!RegisterClass(&toplevelClass)) { - panic("Unable to register TkTopLevel class"); + if (! initialized) { + Tcl_MutexLock(&winWmMutex); + if (! initialized) { + initialized = 1; + classPtr = &toplevelClass; + + /* + * When threads are enabled, we cannot use CLASSDC because + * threads will then write into the same device context. + * + * This is a hack; we should add a subsystem that manages + * device context on a per-thread basis. See also tkWinX.c, + * which also initializes a WNDCLASS structure. + */ + +#ifdef TCL_THREADS + classPtr->style = CS_HREDRAW | CS_VREDRAW; +#else + classPtr->style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC; +#endif + classPtr->cbClsExtra = 0; + classPtr->cbWndExtra = 0; + classPtr->hInstance = Tk_GetHINSTANCE(); + classPtr->hbrBackground = NULL; + classPtr->lpszMenuName = NULL; + classPtr->lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME; + classPtr->lpfnWndProc = WmProc; + classPtr->hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk"); + classPtr->hCursor = LoadCursor(NULL, IDC_ARROW); + + if (!RegisterClass(classPtr)) { + panic("Unable to register TkTopLevel class"); + } + } + Tcl_MutexUnlock(&winWmMutex); } } @@ -389,14 +394,17 @@ static TkWindow * GetTopLevel(hwnd) HWND hwnd; { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + /* * If this function is called before the CreateWindowEx call * has completed, then the user data slot will not have been * set yet, so we use the global createWindow variable. */ - if (createWindow) { - return createWindow; + if (tsdPtr->createWindow) { + return tsdPtr->createWindow; } return (TkWindow *) GetWindowLong(hwnd, GWL_USERDATA); } @@ -510,10 +518,13 @@ void TkWinWmCleanup(hInstance) HINSTANCE hInstance; { - if (!initialized) { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (!tsdPtr->initialized) { return; } - initialized = 0; + tsdPtr->initialized = 0; UnregisterClass(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance); } @@ -596,8 +607,8 @@ TkWmNewWindow(winPtr) wmPtr->cmdArgv = NULL; wmPtr->clientMachine = NULL; wmPtr->flags = WM_NEVER_MAPPED; - wmPtr->nextPtr = firstWmPtr; - firstWmPtr = wmPtr; + wmPtr->nextPtr = winPtr->dispPtr->firstWmPtr; + winPtr->dispPtr->firstWmPtr = wmPtr; /* * Tk must monitor structure events for top-level windows, in order @@ -644,6 +655,9 @@ UpdateWrapper(winPtr) HWND child = TkWinGetHWND(winPtr->window); int x, y, width, height, state; WINDOWPLACEMENT place; + Tcl_DString titleString; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); parentHWND = NULL; child = TkWinGetHWND(winPtr->window); @@ -720,13 +734,15 @@ UpdateWrapper(winPtr) * to the TkWindow. */ - createWindow = winPtr; + tsdPtr->createWindow = winPtr; + Tcl_UtfToExternalDString(NULL, wmPtr->titleUid, -1, &titleString); wmPtr->wrapper = CreateWindowEx(wmPtr->exStyle, TK_WIN_TOPLEVEL_CLASS_NAME, - wmPtr->titleUid, wmPtr->style, x, y, width, height, - parentHWND, NULL, Tk_GetHINSTANCE(), NULL); + Tcl_DStringValue(&titleString), wmPtr->style, x, y, width, + height, parentHWND, NULL, Tk_GetHINSTANCE(), NULL); + Tcl_DStringFree(&titleString); SetWindowLong(wmPtr->wrapper, GWL_USERDATA, (LONG) winPtr); - createWindow = NULL; + tsdPtr->createWindow = NULL; place.length = sizeof(WINDOWPLACEMENT); GetWindowPlacement(wmPtr->wrapper, &place); @@ -800,8 +816,8 @@ UpdateWrapper(winPtr) * we should activate the initial window. */ - if (firstWindow) { - firstWindow = 0; + if (tsdPtr->firstWindow) { + tsdPtr->firstWindow = 0; SetActiveWindow(wmPtr->wrapper); } } @@ -835,8 +851,10 @@ TkWmMapWindow(winPtr) * be mapped. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (!initialized) { + if (!tsdPtr->initialized) { InitWm(); } @@ -917,6 +935,7 @@ TkpWmSetState(winPtr, state) WmInfo *wmPtr = winPtr->wmInfoPtr; int cmd; + if (wmPtr->flags & WM_NEVER_MAPPED) { wmPtr->hints.initial_state = state; return; @@ -932,6 +951,7 @@ TkpWmSetState(winPtr, state) } else if (state == ZoomState) { cmd = SW_SHOWMAXIMIZED; } + ShowWindow(wmPtr->wrapper, cmd); wmPtr->flags &= ~WM_SYNC_PENDING; } @@ -969,11 +989,12 @@ TkWmDeadWindow(winPtr) * Clean up event related window info. */ - if (firstWmPtr == wmPtr) { - firstWmPtr = wmPtr->nextPtr; + if (winPtr->dispPtr->firstWmPtr == wmPtr) { + winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr; } else { register WmInfo *prevPtr; - for (prevPtr = firstWmPtr; ; prevPtr = prevPtr->nextPtr) { + for (prevPtr = winPtr->dispPtr->firstWmPtr; ; prevPtr + = prevPtr->nextPtr) { if (prevPtr == NULL) { panic("couldn't unlink window in TkWmDeadWindow"); } @@ -988,7 +1009,8 @@ TkWmDeadWindow(winPtr) * Reset all transient windows whose master is the dead window. */ - for (wmPtr2 = firstWmPtr; wmPtr2 != NULL; wmPtr2 = wmPtr2->nextPtr) { + for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL; wmPtr2 + = wmPtr2->nextPtr) { if (wmPtr2->masterPtr == winPtr) { wmPtr2->masterPtr = NULL; if ((wmPtr2->wrapper != None) @@ -1102,10 +1124,11 @@ Tk_WmCmd(clientData, interp, argc, argv) char **argv; /* Argument strings. */ { Tk_Window tkwin = (Tk_Window) clientData; - TkWindow *winPtr; + TkWindow *winPtr = NULL; register WmInfo *wmPtr; int c; size_t length; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; if (argc < 2) { wrongNumArgs: @@ -1123,10 +1146,10 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 2) { - interp->result = (wmTracing) ? "on" : "off"; + Tcl_SetResult(interp, ((dispPtr->wmTracing) ? "on" : "off"), TCL_STATIC); return TCL_OK; } - return Tcl_GetBoolean(interp, argv[2], &wmTracing); + return Tcl_GetBoolean(interp, argv[2], &dispPtr->wmTracing); } if (argc < 3) { @@ -1153,9 +1176,12 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x, + char buf[TCL_INTEGER_SPACE * 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); } return TCL_OK; } @@ -1170,7 +1196,8 @@ Tk_WmCmd(clientData, interp, argc, argv) } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - interp->result = "aspect number can't be <= 0"; + Tcl_SetResult(interp, "aspect number can't be <= 0", + TCL_STATIC); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -1190,7 +1217,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->clientMachine != NULL) { - interp->result = wmPtr->clientMachine; + Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); } return TCL_OK; } @@ -1286,7 +1313,7 @@ Tk_WmCmd(clientData, interp, argc, argv) * Now we need to force the updated colormaps to be installed. */ - if (wmPtr == foregroundWmPtr) { + if (wmPtr == winPtr->dispPtr->foregroundWmPtr) { InstallColormaps(wmPtr->wrapper, WM_QUERYNEWPALETTE, 1); } else { InstallColormaps(wmPtr->wrapper, WM_PALETTECHANGED, 0); @@ -1305,8 +1332,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->cmdArgv != NULL) { - interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - interp->freeProc = TCL_DYNAMIC; + Tcl_SetResult(interp, + Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), + TCL_DYNAMIC); } return TCL_OK; } @@ -1358,7 +1386,8 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - interp->result = wmPtr->hints.input ? "passive" : "active"; + Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), + TCL_STATIC); return TCL_OK; } c = argv[3][0]; @@ -1375,6 +1404,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0) && (length >= 2)) { HWND hwnd; + char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: must be \"", @@ -1388,7 +1418,8 @@ Tk_WmCmd(clientData, interp, argc, argv) if (hwnd == NULL) { hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr)); } - sprintf(interp->result, "0x%x", (unsigned int) hwnd); + sprintf(buf, "0x%x", (unsigned int) hwnd); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0) && (length >= 2)) { char xSign, ySign; @@ -1401,6 +1432,8 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { + char buf[16 + TCL_INTEGER_SPACE * 4]; + xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -1412,8 +1445,9 @@ Tk_WmCmd(clientData, interp, argc, argv) width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(interp->result, "%dx%d%c%d%c%d", width, height, - xSign, wmPtr->x, ySign, wmPtr->y); + sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, + ySign, wmPtr->y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if (*argv[3] == '\0') { @@ -1434,9 +1468,12 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth, + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, wmPtr->reqGridHeight, wmPtr->widthInc, wmPtr->heightInc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } @@ -1463,19 +1500,19 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (reqWidth < 0) { - interp->result = "baseWidth can't be < 0"; + Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); return TCL_ERROR; } if (reqHeight < 0) { - interp->result = "baseHeight can't be < 0"; + Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); return TCL_ERROR; } if (widthInc < 0) { - interp->result = "widthInc can't be < 0"; + Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC); return TCL_ERROR; } if (heightInc < 0) { - interp->result = "heightInc can't be < 0"; + Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, @@ -1494,7 +1531,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - interp->result = wmPtr->leaderName; + Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); } return TCL_OK; } @@ -1527,8 +1564,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - interp->result = Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap); + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), + TCL_STATIC); } return TCL_OK; } @@ -1586,8 +1624,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - interp->result = Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_mask); + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), + TCL_STATIC); } return TCL_OK; } @@ -1612,7 +1651,9 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : ""; + Tcl_SetResult(interp, + ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), + TCL_STATIC); return TCL_OK; } else { wmPtr->iconName = Tk_GetUid(argv[3]); @@ -1632,8 +1673,11 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - sprintf(interp->result, "%d %d", wmPtr->hints.icon_x, + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", wmPtr->hints.icon_x, wmPtr->hints.icon_y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } @@ -1662,7 +1706,7 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->icon != NULL) { - interp->result = Tk_PathName(wmPtr->icon); + Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); } return TCL_OK; } @@ -1729,8 +1773,9 @@ Tk_WmCmd(clientData, interp, argc, argv) if (!(wmPtr2->flags & WM_NEVER_MAPPED)) { if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(tkwin2), Tk_ScreenNumber(tkwin2)) == 0) { - interp->result = - "couldn't send withdraw message to window manager"; + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); return TCL_ERROR; } } @@ -1745,8 +1790,11 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + GetMaxSize(wmPtr, &width, &height); - sprintf(interp->result, "%d %d", width, height); + sprintf(buf, "%d %d", width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) @@ -1766,8 +1814,11 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + GetMinSize(wmPtr, &width, &height); - sprintf(interp->result, "%d %d", width, height); + sprintf(buf, "%d %d", width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) @@ -1790,9 +1841,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - interp->result = "1"; + Tcl_SetResult(interp, "1", TCL_STATIC); } else { - interp->result = "0"; + Tcl_SetResult(interp, "0", TCL_STATIC); } return TCL_OK; } @@ -1816,9 +1867,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & USPosition) { - interp->result = "user"; + Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PPosition) { - interp->result = "program"; + Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } @@ -1872,7 +1923,7 @@ Tk_WmCmd(clientData, interp, argc, argv) for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - interp->result = protPtr->command; + Tcl_SetResult(interp, protPtr->command, TCL_STATIC); return TCL_OK; } } @@ -1916,9 +1967,12 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - sprintf(interp->result, "%d %d", + char buf[TCL_INTEGER_SPACE * 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); return TCL_OK; } if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK) @@ -1947,9 +2001,9 @@ Tk_WmCmd(clientData, interp, argc, argv) } if (argc == 3) { if (wmPtr->sizeHintsFlags & USSize) { - interp->result = "user"; + Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PSize) { - interp->result = "program"; + Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } @@ -1980,20 +2034,20 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - interp->result = "icon"; + Tcl_SetResult(interp, "icon", TCL_STATIC); } else { switch (wmPtr->hints.initial_state) { case NormalState: - interp->result = "normal"; + Tcl_SetResult(interp, "normal", TCL_STATIC); break; case IconicState: - interp->result = "iconic"; + Tcl_SetResult(interp, "iconic", TCL_STATIC); break; case WithdrawnState: - interp->result = "withdrawn"; + Tcl_SetResult(interp, "withdrawn", TCL_STATIC); break; case ZoomState: - interp->result = "zoomed"; + Tcl_SetResult(interp, "zoomed", TCL_STATIC); break; } } @@ -2005,13 +2059,18 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_ERROR; } if (argc == 3) { - interp->result = (wmPtr->titleUid != NULL) ? wmPtr->titleUid - : winPtr->nameUid; + Tcl_SetResult(interp, + ((wmPtr->titleUid != NULL) ? wmPtr->titleUid : winPtr->nameUid), + TCL_STATIC); return TCL_OK; } else { wmPtr->titleUid = Tk_GetUid(argv[3]); if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) { - SetWindowText(wmPtr->wrapper, wmPtr->titleUid); + Tcl_DString titleString; + Tcl_UtfToExternalDString(NULL, wmPtr->titleUid, -1, + &titleString); + SetWindowText(wmPtr->wrapper, Tcl_DStringValue(&titleString)); + Tcl_DStringFree(&titleString); } } } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0) @@ -2611,7 +2670,7 @@ UpdateGeometryInfo(clientData) * * Results: * A standard Tcl return value, plus an error message in - * interp->result if an error occurs. + * the interp's result if an error occurs. * * Side effects: * The size and/or location of winPtr may change. @@ -3136,7 +3195,7 @@ TkWmAddToColormapWindows(winPtr) * Now we need to force the updated colormaps to be installed. */ - if (topPtr->wmInfoPtr == foregroundWmPtr) { + if (topPtr->wmInfoPtr == winPtr->dispPtr->foregroundWmPtr) { InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_QUERYNEWPALETTE, 1); } else { InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_PALETTECHANGED, 0); @@ -3534,6 +3593,8 @@ InstallColormaps(hwnd, message, isForemost) HPALETTE oldPalette; TkWindow *winPtr = GetTopLevel(hwnd); WmInfo *wmPtr; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr == NULL) { return 0; @@ -3550,17 +3611,17 @@ InstallColormaps(hwnd, message, isForemost) * secondary palettes are installed properly. */ - foregroundWmPtr = wmPtr; + winPtr->dispPtr->foregroundWmPtr = wmPtr; if (wmPtr->cmapCount > 0) { winPtr = wmPtr->cmapList[0]; } - systemPalette = TkWinGetPalette(winPtr->atts.colormap); + tsdPtr->systemPalette = TkWinGetPalette(winPtr->atts.colormap); dc = GetDC(hwnd); - oldPalette = SelectPalette(dc, systemPalette, FALSE); + oldPalette = SelectPalette(dc, tsdPtr->systemPalette, FALSE); if (RealizePalette(dc)) { - RefreshColormap(winPtr->atts.colormap); + RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr); } else if (wmPtr->cmapCount > 1) { SelectPalette(dc, oldPalette, TRUE); RealizePalette(dc); @@ -3596,13 +3657,13 @@ InstallColormaps(hwnd, message, isForemost) oldPalette = SelectPalette(dc, TkWinGetPalette(winPtr->atts.colormap), TRUE); if (RealizePalette(dc)) { - RefreshColormap(winPtr->atts.colormap); + RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr); } for (; i < wmPtr->cmapCount; i++) { winPtr = wmPtr->cmapList[i]; SelectPalette(dc, TkWinGetPalette(winPtr->atts.colormap), TRUE); if (RealizePalette(dc)) { - RefreshColormap(winPtr->atts.colormap); + RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr); } } } @@ -3634,13 +3695,14 @@ InstallColormaps(hwnd, message, isForemost) */ static void -RefreshColormap(colormap) +RefreshColormap(colormap, dispPtr) Colormap colormap; + TkDisplay *dispPtr; { WmInfo *wmPtr; int i; - for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { + for (wmPtr = dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { if (wmPtr->cmapCount > 0) { for (i = 0; i < wmPtr->cmapCount; i++) { if ((wmPtr->cmapList[i]->atts.colormap == colormap) @@ -3722,7 +3784,10 @@ InvalidateSubTree(winPtr, colormap) HPALETTE TkWinGetSystemPalette() { - return systemPalette; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->systemPalette; } /* @@ -3950,8 +4015,8 @@ WmProc(hwnd, message, wParam, lParam) * leaving move/size mode. Note that this mechanism * assumes move/size is only one level deep. */ LRESULT result; - TkWindow *winPtr; - + TkWindow *winPtr = NULL; + if (TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &result)) { goto done; } @@ -4235,21 +4300,22 @@ ActivateWindow( return 1; } + /* *---------------------------------------------------------------------- * * TkWinSetForegroundWindow -- * - * This function is a wrapper for SetForegroundWindow, calling + * This function is a wrapper for SetForegroundWindow, calling * it on the wrapper window because it has no affect on child * windows. * * Results: - * none + * none * * Side effects: - * May activate the toplevel window. + * May activate the toplevel window. * *---------------------------------------------------------------------- */ diff --git a/win/tkWinX.c b/win/tkWinX.c index 50a9e24..358d15e 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -10,10 +10,9 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinX.c,v 1.4 1998/10/10 00:30:37 rjohnson Exp $ + * RCS: @(#) $Id: tkWinX.c,v 1.5 1999/04/16 01:51:54 stanton Exp $ */ -#include "tkInt.h" #include "tkWinInt.h" /* @@ -32,13 +31,23 @@ int tkpIsWin32s = -1; * Declarations of static variables used in this file. */ -static HINSTANCE tkInstance = (HINSTANCE) NULL; - /* Global application instance handle. */ -static TkDisplay *winDisplay; /* Display that represents Windows screen. */ -static char winScreenName[] = ":0"; - /* Default name of windows display. */ -static WNDCLASS childClass; /* Window class for child windows. */ -static childClassInitialized = 0; /* Registered child class? */ +static char winScreenName[] = ":0"; /* Default name of windows display. */ +static HINSTANCE tkInstance; /* Application instance handle. */ +static int childClassInitialized; /* Registered child class? */ +static WNDCLASS childClass; /* Window class for child windows. */ + +TCL_DECLARE_MUTEX(winXMutex) + +/* + * Thread local storage. Notice that now each thread must have its + * own TkDisplay structure, since this structure contains most of + * the thread-specific date for threads. + */ +typedef struct ThreadSpecificData { + TkDisplay *winDisplay; /* TkDisplay structure that * + * represents Windows screen. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations of procedures used in this file. @@ -142,7 +151,21 @@ TkWinXInit(hInstance) tkInstance = hInstance; + /* + * When threads are enabled, we cannot use CLASSDC because + * threads will then write into the same device context. + * + * This is a hack; we should add a subsystem that manages + * device context on a per-thread basis. See also tkWinWm.c, + * which also initializes a WNDCLASS structure. + */ + +#ifdef TCL_THREADS + childClass.style = CS_HREDRAW | CS_VREDRAW; +#else childClass.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC; +#endif + childClass.cbClsExtra = 0; childClass.cbWndExtra = 0; childClass.hInstance = hInstance; @@ -236,10 +259,10 @@ TkGetDefaultScreenName(interp, screenName) * specific information. * * Results: - * Returns a Display structure on success or NULL on failure. + * Returns a TkDisplay structure on success or NULL on failure. * * Side effects: - * Allocates a new Display structure. + * Allocates a new TkDisplay structure. * *---------------------------------------------------------------------- */ @@ -252,10 +275,13 @@ TkpOpenDisplay(display_name) HDC dc; TkWinDrawable *twdPtr; Display *display; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (winDisplay != NULL) { - if (strcmp(winDisplay->display->display_name, display_name) == 0) { - return winDisplay; + if (tsdPtr->winDisplay != NULL) { + if (strcmp(tsdPtr->winDisplay->display->display_name, display_name) + == 0) { + return tsdPtr->winDisplay; } else { return NULL; } @@ -357,9 +383,9 @@ TkpOpenDisplay(display_name) display->default_screen = 0; screen->cmap = XCreateColormap(display, None, screen->root_visual, AllocNone); - winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay)); - winDisplay->display = display; - return winDisplay; + tsdPtr->winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay)); + tsdPtr->winDisplay->display = display; + return tsdPtr->winDisplay; } /* @@ -385,8 +411,10 @@ TkpCloseDisplay(dispPtr) { Display *display = dispPtr->display; HWND hwnd; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (dispPtr != winDisplay) { + if (dispPtr != tsdPtr->winDisplay) { panic("TkpCloseDisplay: tried to call TkpCloseDisplay on another display"); return; } @@ -405,7 +433,7 @@ TkpCloseDisplay(dispPtr) } } - winDisplay = NULL; + tsdPtr->winDisplay = NULL; if (display->display_name != (char *) NULL) { ckfree(display->display_name); @@ -795,19 +823,61 @@ GenerateXEvent(hwnd, message, wParam, lParam) */ event.type = KeyRelease; event.xkey.keycode = wParam; - event.xkey.nchars = 0; + event.xkey.nbytes = 0; break; case WM_CHAR: /* * Synthesize both a KeyPress and a KeyRelease. + * Strings generated by Input Method Editor are handled + * in the following manner: + * 1. A series of WM_KEYDOWN & WM_KEYUP messages that + * cause GetTranslatedKey() to be called and return + * immediately because the WM_KEYDOWNs have no + * associated WM_CHAR messages -- the IME window is + * accumulating the characters and translating them + * itself. In the "bind" command, you get an event + * with a mystery keysym and %A == "" for each + * WM_KEYDOWN that actually was meant for the IME. + * 2. A WM_KEYDOWN corresponding to the "confirm typing" + * character. This causes GetTranslatedKey() to be + * called. + * 3. A WM_IME_NOTIFY message saying that the IME is + * done. A side effect of this message is that + * GetTranslatedKey() thinks this means that there + * are no WM_CHAR messages and returns immediately. + * In the "bind" command, you get an another event + * with a mystery keysym and %A == "". + * 4. A sequence of WM_CHAR messages that correspond to + * the characters in the IME window. A bunch of + * simulated KeyPress/KeyRelease events will be + * generated, one for each character. Adjacent + * WM_CHAR messages may actually specify the high + * and low bytes of a multi-byte character -- in that + * case the two WM_CHAR messages will be combined into + * one event. It is the event-consumer's + * responsibility to convert the string returned from + * XLookupString from system encoding to UTF-8. + * 5. And finally we get the WM_KEYUP for the "confirm + * typing" character. */ event.type = KeyPress; event.xany.send_event = -1; event.xkey.keycode = 0; - event.xkey.nchars = 1; + event.xkey.nbytes = 1; event.xkey.trans_chars[0] = (char) wParam; + + if (IsDBCSLeadByte((BYTE) wParam)) { + MSG msg; + + if ((PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE) != 0) + && (msg.message == WM_CHAR)) { + GetMessage(&msg, NULL, 0, 0); + event.xkey.nbytes = 2; + event.xkey.trans_chars[1] = (char) msg.wParam; + } + } Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); event.type = KeyRelease; break; @@ -906,7 +976,7 @@ GetState(message, wParam, lParam) * given KeyPress event. * * Results: - * Sets the trans_chars and nchars member of the key event. + * Sets the trans_chars and nbytes member of the key event. * * Side effects: * Removes any WM_CHAR messages waiting on the top of the system @@ -920,14 +990,13 @@ GetTranslatedKey(xkey) XKeyEvent *xkey; { MSG msg; + char buf[XMaxTransChars]; - xkey->nchars = 0; + xkey->nbytes = 0; - while (xkey->nchars < XMaxTransChars + while ((xkey->nbytes < XMaxTransChars) && PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { if ((msg.message == WM_CHAR) || (msg.message == WM_SYSCHAR)) { - xkey->trans_chars[xkey->nchars] = (char) msg.wParam; - xkey->nchars++; GetMessage(&msg, NULL, 0, 0); /* @@ -941,6 +1010,9 @@ GetTranslatedKey(xkey) if ((msg.message == WM_CHAR) && (msg.lParam & 0x20000000)) { xkey->state = 0; } + buf[xkey->nbytes] = (char) msg.wParam; + xkey->trans_chars[xkey->nbytes] = (char) msg.wParam; + xkey->nbytes++; } else { break; } diff --git a/win/winMain.c b/win/winMain.c index 9cf081d..79f8f96 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -3,27 +3,30 @@ * * Main entry point for wish and other Tk-based applications. * - * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: winMain.c,v 1.5 1999/03/10 07:04:46 stanton Exp $ + * RCS: @(#) $Id: winMain.c,v 1.6 1999/04/16 01:51:55 stanton Exp $ */ #include <tk.h> -#include "tkInt.h" #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN #include <malloc.h> #include <locale.h> +#include "tkInt.h" + /* * The following declarations refer to internal Tk routines. These * interfaces are available for use, but are not supported. */ + /* * Forward declarations for procedures defined later in this file: */ @@ -35,6 +38,13 @@ static void WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format)); extern int Tktest_Init(Tcl_Interp *interp); #endif /* TK_TEST */ +#ifdef TCL_TEST +extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +#endif /* TCL_TEST */ + +static BOOL consoleRequired = TRUE; + /* *---------------------------------------------------------------------- @@ -60,9 +70,8 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow) LPSTR lpszCmdLine; int nCmdShow; { - char **argv, *p; + char **argv; int argc; - char buffer[MAX_PATH]; Tcl_SetPanicProc(WishPanic); @@ -72,7 +81,7 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow) */ setlocale(LC_ALL, "C"); - + setargv(&argc, &argv); /* * Increase the application queue size from default value of 8. @@ -81,22 +90,16 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow) * This is only needed for Windows 3.x, since NT dynamically expands * the queue. */ - SetMessageQueue(64); - setargv(&argc, &argv); + SetMessageQueue(64); /* - * Replace argv[0] with full pathname of executable, and forward - * slashes substituted for backslashes. + * Create the console channels and install them as the standard + * channels. All I/O will be discarded until TkConsoleInit is + * called to attach the console to a text widget. */ - GetModuleFileName(NULL, buffer, sizeof(buffer)); - argv[0] = buffer; - for (p = buffer; *p != '\0'; p++) { - if (*p == '\\') { - *p = '/'; - } - } + consoleRequired = TRUE; Tk_Main(argc, argv, Tcl_AppInit); return 1; @@ -114,7 +117,7 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow) * * Results: * Returns a standard Tcl completion code, and leaves an error - * message in interp->result if an error occurs. + * message in the interp's result if an error occurs. * * Side effects: * Depends on the startup script. @@ -132,7 +135,6 @@ Tcl_AppInit(interp) if (Tk_Init(interp) == TCL_ERROR) { goto error; } - Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); /* @@ -140,9 +142,22 @@ Tcl_AppInit(interp) * application. */ - if (TkConsoleInit(interp) == TCL_ERROR) { - goto error; + if (consoleRequired) { + if (TkConsoleInit(interp) == TCL_ERROR) { + goto error; + } + } + +#ifdef TCL_TEST + if (Tcltest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; } + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, + (Tcl_PackageInitProc *) NULL); + if (TclObjTest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } +#endif /* TCL_TEST */ #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { @@ -156,7 +171,7 @@ Tcl_AppInit(interp) return TCL_OK; error: - WishPanic(interp->result); + WishPanic(Tcl_GetStringResult(interp)); return TCL_ERROR; } @@ -230,7 +245,7 @@ setargv(argcPtr, argvPtr) char **argv; int argc, size, inquote, copy, slashes; - cmdLine = GetCommandLine(); + cmdLine = GetCommandLine(); /* INTL: BUG */ /* * Precompute an overly pessimistic guess at the number of arguments @@ -239,9 +254,9 @@ setargv(argcPtr, argvPtr) size = 2; for (p = cmdLine; *p != '\0'; p++) { - if (isspace(*p)) { + if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ size++; - while (isspace(*p)) { + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ p++; } if (*p == '\0') { @@ -249,8 +264,8 @@ setargv(argcPtr, argvPtr) } } } - argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *) - + strlen(cmdLine) + 1)); + argSpace = (char *) Tcl_Alloc( + (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); argv = (char **) argSpace; argSpace += size * sizeof(char *); size--; @@ -258,7 +273,7 @@ setargv(argcPtr, argvPtr) p = cmdLine; for (argc = 0; argc < size; argc++) { argv[argc] = arg = argSpace; - while (isspace(*p)) { + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ p++; } if (*p == '\0') { @@ -292,7 +307,8 @@ setargv(argcPtr, argvPtr) slashes--; } - if ((*p == '\0') || (!inquote && isspace(*p))) { + if ((*p == '\0') + || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ break; } if (copy != 0) { @@ -310,3 +326,53 @@ setargv(argcPtr, argvPtr) *argvPtr = argv; } + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * Main entry point from the console. + * + * Results: + * None: Tk_Main never returns here, so this procedure never + * returns either. + * + * Side effects: + * Whatever the applications does. + * + *---------------------------------------------------------------------- + */ + +int main(int argc, char **argv) +{ + Tcl_SetPanicProc(WishPanic); + + /* + * Set up the default locale to be standard "C" locale so parsing + * is performed correctly. + */ + + setlocale(LC_ALL, "C"); + /* + * Increase the application queue size from default value of 8. + * At the default value, cross application SendMessage of WM_KILLFOCUS + * will fail because the handler will not be able to do a PostMessage! + * This is only needed for Windows 3.x, since NT dynamically expands + * the queue. + */ + + SetMessageQueue(64); + + /* + * Create the console channels and install them as the standard + * channels. All I/O will be discarded until TkConsoleInit is + * called to attach the console to a text widget. + */ + + consoleRequired = FALSE; + + Tk_Main(argc, argv, Tcl_AppInit); + return 0; +} + diff --git a/xlib/X11/X.h b/xlib/X11/X.h index 55a3133..a7f6566 100644 --- a/xlib/X11/X.h +++ b/xlib/X11/X.h @@ -59,7 +59,11 @@ typedef unsigned long VisualID; typedef unsigned long Time; -typedef unsigned short KeyCode; +typedef unsigned long KeyCode; /* In order to use IME, the Macintosh needs + * to pack 3 bytes into the keyCode field in + * the XEvent. In the real X.h, a KeyCode is + * defined as a short, which wouldn't be big + * enough. */ /***************************************************************** * RESERVED RESOURCE AND CONSTANT DEFINITIONS diff --git a/xlib/X11/Xlib.h b/xlib/X11/Xlib.h index 44358bd..b185394 100644 --- a/xlib/X11/Xlib.h +++ b/xlib/X11/Xlib.h @@ -546,7 +546,7 @@ typedef struct { Bool same_screen; /* same screen flag */ char trans_chars[XMaxTransChars]; /* translated characters */ - int nchars; + int nbytes; } XKeyEvent; typedef XKeyEvent XKeyPressedEvent; typedef XKeyEvent XKeyReleasedEvent; @@ -1190,24 +1190,6 @@ typedef int (*XErrorHandler) ( /* WARNING, this type not in Xlib spec */ _XFUNCPROTOBEGIN -extern Atom XInternAtom( -#if NeedFunctionPrototypes - Display* /* display */, - _Xconst char* /* atom_name */, - Bool /* only_if_exists */ -#endif -); - - -extern GC XCreateGC( -#if NeedFunctionPrototypes - Display* /* display */, - Drawable /* d */, - unsigned long /* valuemask */, - XGCValues* /* values */ -#endif -); - extern void XDrawLine( #if NeedFunctionPrototypes @@ -1234,57 +1216,6 @@ extern void XFillRectangle( #endif ); -extern void XFreeGC( -#if NeedFunctionPrototypes - Display* /* display */, - GC /* gc */ -#endif -); - -extern Status XParseColor( -#if NeedFunctionPrototypes - Display* /* display */, - Colormap /* colormap */, - _Xconst char* /* spec */, - XColor* /* exact_def_return */ -#endif -); - -extern void XSetClipMask( -#if NeedFunctionPrototypes - Display* /* display */, - GC /* gc */, - Pixmap /* pixmap */ -#endif -); - - -extern void XSetClipOrigin( -#if NeedFunctionPrototypes - Display* /* display */, - GC /* gc */, - int /* clip_x_origin */, - int /* clip_y_origin */ -#endif -); - -extern void XSetForeground( -#if NeedFunctionPrototypes - Display* /* display */, - GC /* gc */, - unsigned long /* foreground */ -#endif -); - -extern void XSetTSOrigin( -#if NeedFunctionPrototypes - Display* /* display */, - GC /* gc */, - int /* ts_x_origin */, - int /* ts_y_origin */ -#endif -); - #include "tkIntXlibDecls.h" diff --git a/xlib/X11/Xutil.h b/xlib/X11/Xutil.h index 6332850..f6c0a36 100644 --- a/xlib/X11/Xutil.h +++ b/xlib/X11/Xutil.h @@ -448,14 +448,6 @@ extern Status XGetTextProperty( #endif ); -extern XVisualInfo *XGetVisualInfo( -#if NeedFunctionPrototypes - Display* /* display */, - long /* vinfo_mask */, - XVisualInfo* /* vinfo_template */, - int* /* nitems_return */ -#endif -); extern Status XGetWMClientMachine( #if NeedFunctionPrototypes @@ -652,14 +644,6 @@ extern void XSetTextProperty( #endif ); -extern void XSetWMClientMachine( -#if NeedFunctionPrototypes - Display* /* display */, - Window /* w */, - XTextProperty* /* text_prop */ -#endif -); - extern void XSetWMHints( #if NeedFunctionPrototypes Display* /* display */, @@ -762,14 +746,6 @@ extern void XShrinkRegion( #endif ); -extern Status XStringListToTextProperty( -#if NeedFunctionPrototypes - char** /* list */, - int /* count */, - XTextProperty* /* text_prop_return */ -#endif -); - extern void XSubtractRegion( #if NeedFunctionPrototypes Region /* sra */, diff --git a/xlib/xdraw.c b/xlib/xdraw.c index e62f90b..796f2f7 100644 --- a/xlib/xdraw.c +++ b/xlib/xdraw.c @@ -9,10 +9,10 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: xdraw.c,v 1.3 1999/03/10 07:04:47 stanton Exp $ + * RCS: @(#) $Id: xdraw.c,v 1.4 1999/04/16 01:51:55 stanton Exp $ */ -#include "tkInt.h" +#include "tk.h" /* *---------------------------------------------------------------------- @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: xgc.c,v 1.2 1998/09/14 18:24:03 stanton Exp $ + * RCS: @(#) $Id: xgc.c,v 1.3 1999/04/16 01:51:55 stanton Exp $ */ #include <tkInt.h> @@ -150,8 +150,7 @@ XChangeGC(d, gc, mask, values) *---------------------------------------------------------------------- */ -void -XFreeGC(d, gc) +void XFreeGC(d, gc) Display * d; GC gc; { |
