diff options
author | dgp <dgp@users.sourceforge.net> | 2001-07-03 20:01:07 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2001-07-03 20:01:07 (GMT) |
commit | acb44d9f5c12d2a4c9d00fe67ce6ed9a06a3e0cd (patch) | |
tree | 9c44f5571f5e10f7994f13677b54b497cb9411e4 | |
parent | 606071581d513fe5326526b43a2ff4ef0cd4285d (diff) | |
download | tk-acb44d9f5c12d2a4c9d00fe67ce6ed9a06a3e0cd.zip tk-acb44d9f5c12d2a4c9d00fe67ce6ed9a06a3e0cd.tar.gz tk-acb44d9f5c12d2a4c9d00fe67ce6ed9a06a3e0cd.tar.bz2 |
* Merged in updates from HEAD branch.
99 files changed, 4091 insertions, 1500 deletions
@@ -1,3 +1,505 @@ +2001-07-03 Don Porter <dgp@users.sourceforge.net> + + BRANCH dgp-privates-into-namespace: + * ChangeLog: + * README: + * deleted_files/xlib/ximage.c: + * doc/TkInitStubs.3: + * doc/canvas.n: + * doc/clipboard.n: + * doc/colors.n: + * doc/console.n: + * doc/image.n: + * doc/menubutton.n: + * doc/selection.n: + * generic/tk.h: + * generic/tkBind.c: + * generic/tkCanvArc.c: + * generic/tkCanvBmap.c: + * generic/tkCanvLine.c: + * generic/tkCanvPoly.c: + * generic/tkCanvText.c: + * generic/tkCanvWind.c: + * generic/tkCanvas.c: + * generic/tkEntry.c: + * generic/tkFrame.c: + * generic/tkImage.c: + * generic/tkImgGIF.c: + * generic/tkImgPhoto.c: + * generic/tkInt.h: + * generic/tkListbox.c: + * generic/tkMenu.c: + * generic/tkMenubutton.c: + * generic/tkMenubutton.h: + * generic/tkObj.c: + * generic/tkRectOval.c: + * generic/tkSelect.c: + * generic/tkStubLib.c: + * generic/tkWindow.c: + * library/bgerror.tcl: + * library/clrpick.tcl: + * library/console.tcl: + * library/entry.tcl: + * library/msgbox.tcl: + * library/spinbox.tcl: + * library/text.tcl: + * library/tk.tcl: + * library/tkfbox.tcl: + * library/xmfbox.tcl: + * library/demos/arrow.tcl: + * library/demos/clrpick.tcl: + * library/demos/cscroll.tcl: + * library/demos/ctext.tcl: + * library/demos/filebox.tcl: + * library/demos/floor.tcl: + * library/demos/hscale.tcl: + * library/demos/items.tcl: + * library/demos/plot.tcl: + * library/demos/puzzle.tcl: + * library/demos/ruler.tcl: + * library/demos/twind.tcl: + * library/demos/vscale.tcl: + * library/msgs/de.msg: + * mac/README: + * mac/tkMacMenubutton.c: + * tests/bind.test: + * tests/canvas.test: + * tests/cursor.test: + * tests/entry.test: + * tests/event.test: + * tests/focus.test: + * tests/frame.test: + * tests/listbox.test: + * tests/macEmbed.test: + * tests/macMenu.test: + * tests/menu.test: + * tests/menubut.test: + * tests/safe.test: + * tests/select.test: + * tests/unixEmbed.test: + * tests/unixWm.test: + * tests/winClipboard.test: + * tests/winDialog.test: + * unix/Makefile.in: + * unix/configure: + * unix/configure.in: + * unix/tcl.m4: + * unix/tk.spec: + * unix/tkUnixFont.c: + * unix/tkUnixMenubu.c: + * unix/tkUnixScale.c: + * unix/tkUnixSelect.c: + * win/Makefile.in: + * win/configure: + * win/configure.in: + * win/makefile.vc: + * win/tcl.m4: + * win/tkWinDialog.c: + * win/tkWinInt.h: + * win/tkWinKey.c: + * win/tkWinMenu.c: + * win/tkWinWm.c: + * win/tkWinX.c: Merged in updates from HEAD branch. + +2001-07-03 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * library/xmfbox.tcl (tkMotifFDialog_ActivateSEnt): Added missing + backslash [Bug #438247] + +2001-07-02 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkWindow.c (Tk_DestroyWindow): changed to use + Tcl_EventuallyFree instead of ckfree so that widgets that have + references to a tkwin can use them. + + * generic/tkCanvArc.c: + * generic/tkCanvBmap.c: + * generic/tkCanvLine.c: + * generic/tkCanvPoly.c: + * generic/tkCanvText.c: + * generic/tkCanvWind.c: + * generic/tkRectOval.c: corrected argument handling in + Create<Item> functions that could lead to ABRs or FMRs and + corrected names of argc/argv to objc/objv. + + * generic/tkImgGIF.c (Mgetc): corrected screwy use of ternary + operator and possible FMR. + + * generic/tkEntry.c: corrected missing Tcl_Release that caused + font not freed complaints when trying valid cleanup calls. + * generic/tkListbox.c: made use of Tcl_Preserve/Tcl_Release to + prevent FMR errors in Display functions. + + * unix/tkUnixScale.c (TkpDisplayScale): corrected FMR when scale + was deleted while calling its command. + + * library/console.tcl: + * library/entry.tcl: + * library/spinbox.tcl: + * library/text.tcl: + * library/tk.tcl: added private ::tk::GetSelection command to + handle requesting selection. This is to support requesting + UTF8_STRING before generic STRING on Unix. Changed Text, Spinbox, + Entry and Console to use this command. + + * tests/select.test: + * generic/tkSelect.c (Tk_CreateSelHandler, Tk_DeleteSelHandler): + on Unix, a UTF8_STRING handler will be created when the user + requests a STRING handler (in addition to the STRING handler). + This provides implicit support for the new UTF8_STRING selection + target. + * unix/tkUnixSelect.c (TkSelEventProc, ConvertSelection): Added + support for UTF8_STRING target. [RFE #418653, Patch #433283] + + * generic/tkInt.h: added utf8Atom to TkDisplay structure. + + * tests/listbox.test: changed 'darkblue' to 'white' in a test + because it isn't a portable color name. + + * generic/tkEntry.c (DestroyEntry): used Tcl_EventuallyFree + instead of ckfree for entryPtr to prevent FMRs. [Bug #413904] + +2001-06-26 Mo DeJong <mdejong@redhat.com> + + * unix/Makefile.in: + * win/Makefile.in: Add `make shell` target. This target + will set the proper env vars before invoking wish + from the build directory. + +2001-06-26 Mo DeJong <mdejong@redhat.com> + + * win/configure: + * win/configure.in: Revert cross compiling change + accidently added during last checkin. + +2001-06-26 Mo DeJong <mdejong@redhat.com> + + * unix/configure: Regen. + * unix/configure.in: Fix last checkin by removing + export since that only works in bash. + * win/configure: Regen. + * win/configure.in: Ditto. + +2001-06-26 Mo DeJong <mdejong@redhat.com> + + * unix/configure: Regen. + * unix/configure.in: Set CFLAGS to "" if the user + did not set CFLAGS in the env. This keeps AC_PROG_CC + from adding "-g -O2" to the CFLAGS by default. + * win/configure: Regen. + * win/configure.in: Ditto. + +2001-06-22 Mo DeJong <mdejong@redhat.com> + + * win/configure: Regen. + * win/configure.in: Use RC_DEFINE flag from tcl.m4. + * win/tcl.m4: Update from Tcl. + +2001-06-22 Mo DeJong <mdejong@redhat.com> + + * win/configure: Regen. + * win/tcl.m4: Update from Tcl. + +2001-06-22 Mo DeJong <mdejong@redhat.com> + + * win/configure: Regen. + * win/tcl.m4 (SC_CONFIG_CFLAGS): Link to the + imm32 library when building with mingw gcc. + * win/tkWinX.c: Include the imm.h header + to fix compiling with mingw gcc. + +2001-06-22 Mo DeJong <mdejong@redhat.com> + + * win/configure: Regen. + * win/configure.in: Add resource compiler fix from + 8.3.3 to fix compiling with mingw. + +2001-06-22 Mo DeJong <mdejong@redhat.com> + + * win/configure: Regen. + * win/tcl.m4: Fix silly typo in last checkin. + +2001-06-22 Mo DeJong <mdejong@redhat.com> + + * unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. + Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG + and LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works. Use + new LDFLAGS variable in the Makefile instead of @LDFLAGS@. + * unix/configure: Regen. + * unix/configure.in: Don't set CFLAGS to CFLAGS_DEFAULT, instead + subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for CFLAGS_DEBUG, + CFLAGS_OPTIMIZE, LDFLAGS_DEFAULT, LDFLAGS_DEBUG, and LDFLAGS_OPTIMIZE. + Remove unused LD_FLAGS subst. + * unix/tcl.m4: Update from Tcl. + * win/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. + Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. + * win/configure: Regen. + * win/configure.in: Don't set CFLAGS or LDFLAGS, instead subst + CFLAGS_DEFAULT and LDFLAGS_DEFAULT into the Makefile. + * win/tcl.m4: Update from Tcl. + +2001-06-22 Mo DeJong <mdejong@redhat.com> + + * win/configure: + * win/tcl.m4: Update From Tcl. + +2001-06-21 eric melski <ericm@interwoven.com> + + * doc/colors.n: Corrected bogus documentation with respect to + several shades of blue, all of which were listed as RGB 0 0 0. + [Bug #432104]. + +2001-06-14 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * library/demos/floor.tcl, library/demos/filebox.tcl, + * library/demos/clrpick.tcl, library/demos/vscale.tcl, + * library/demos/twind.tcl, library/demos/ruler.tcl, + * library/demos/plot.tcl, library/demos/items.tcl, + * library/demos/hscale.tcl, library/demos/ctext.tcl, + * library/demos/cscroll.tcl, library/demos/arrow.tcl, + * library/xmfbox.tcl, library/msgbox.tcl, + * library/clrpick.tcl, library/bgerror.tcl: Braced expressions. + +2001-06-06 Mo DeJong <mdejong@redhat.com> + + * win/configure: Regen. + * win/configure.in: Handle the --prefix option correctly + it should default to /usr/local like the unix version. + +2001-06-03 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/selection.n: + * doc/clipboard.n: added SEE ALSOs to cross-reference selection + and clipboard, with extra note for clipboard command in selection + docs. [Patch #422256] + + * unix/tkUnixFont.c: Corrected support for iso10646 (X11 Unicode) + fonts on Unix. This adds a ucs-2be (UCS-2 Big Endian) encoding in + Tk on Unix that is used for those fonts (X11 requires + big-endianness). (welch) [Patch #406411; Bug #220890 #220899] + This differs from the 8.3.3 patch by not adding ucs-2be in the + preferred encodingList (seems works fine without). + Added alias for jisx0201* fonts to jis0201 encoding. [Bug #414033] + +2001-05-30 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinKey.c (TkpSetKeycodeAndState): removed old debug info + +2001-05-29 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinX.c: moved the initialization of tkPlatformId from + TkWinXInit to TkWinGetPlatformId because static builds could call + it before it was initialized. [Bug #427278] + +2001-05-28 Peter Spjuth <peter.spjuth@space.se> + + * generic/tkFrame.c: + * generic/tkWindow.c: + * tests/frame.test: Upgraded frame to use the newer TK_OPTION + style when processing configuration options. Some cleanup of + bad comments and bad code. [part of patch #420861] + +2001-05-23 Mo DeJong <mdejong@redhat.com> + + * unix/configure: + * unix/tcl.m4: + * win/configure: + * win/tcl.m4: Sync from Tcl sources. + +2001-05-21 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tcl.m4: sync'ed up wih Tcl tcl.m4. [Bug #419812] + + * doc/TkInitStubs.3: + * generic/tk.h: + * generic/tkStubLib.c: CONST'ified Tk_InitStubs to match CONST + changes to Tcl_PkgRequireEx. + +2001-05-21 Todd M. Helfter <tmh@purdue.edu> + + * doc/menubutton.n: + * generic/tkMenubutton.c: + * generic/tkMenubutton.h: + * mac/tkMacMenubutton.c: + * tests/menubut.test: + * unix/tkUnixMenubu.c: Implementation of TIP #11, the addition of + a -compound option to the menubutton allowing text and an image to + be displayed at the same time. This behavior is identical to the + behavior of the button widget. + +2001-05-16 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * doc/console.n: Added - was erroneously placed in Tcl before... + +2001-04-25 Mo DeJong <mdejong@redhat.com> + + * unix/configure: Regen. + * unix/tcl.m4: Update from Tcl. + * win/configure: Regen. + * win/tcl.m4: Update from Tcl. + +2001-04-25 Mo DeJong <mdejong@redhat.com> + + * unix/configure: Regen. + * unix/configure.in: Use $@ in MAKE_LIB and MAKE_STUB_LIB + commands instead of using a delayed subst variable. Replace + instances of STUB_LIB_FILE with TK_STUB_LIB_FILE. + +2001-04-25 Mo DeJong <mdejong@redhat.com> + + * unix/Makefile.in: Use TCL_STUB_LIB_FILE instead of STUB_LIB_FILE. + * unix/configure: Regen. + * unix/configure.in: Don't subst STUB_LIB_FILE, use TCL_STUB_LIB_FILE + instead. + +2001-04-12 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * generic/tkImage.c (Tk_ImageObjCmd,DeleteImage): Better detection + of deletion when world is falling apart. [Bug #220819] + +2001-04-04 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinMenu.c (TkWinHandleMenuEvent): corrected reseting of + service mode to only occur when it was set. [Bug #220948] + +2001-04-03 Jeff Hobbs <jeffh@ActiveState.com> + + * tests/winClipboard.test: improved results for understanding when + tests fail. + + * tests/winDialog.test: string totitle'd some results that + expected [pwd] to return a capital drive letter. + + * tests/cursor.test: changed tests to use 'heart' cursor because + 'arrow' on windows has a pre-skewed use count. + + * win/tkWinDialog.c (GetFileNameA): initialize multi to 0. + +2001-04-02 Jeff Hobbs <jeffh@ActiveState.com> + + * win/configure: + * win/tcl.m4 (SHLIB_LD): added -incremental:no. [Bug #219381] + + * generic/tkMenu.c (TkInvokeMenu): checked for menu deletion + before calling associated menu entry command. [Bug #220821] + + * doc/image.n: added warning about names chosen for images. + + * generic/tkImgPhoto.c (ImgPhotoCmd): corrected the src and dest + values for $imageName put when -format and -to are used. + [Bug #232741] + + * tests/listbox.test: added test listbox-27.1, delete during + scrollbar update + * generic/tkListbox.c (DestroyListbox, ListboxEventProc): + corrected listbox to make proper use of Tcl_EventuallyFree and + protect against unusual listbox deletion. + + * tests/entry.test: added tests entry-20.*, delete during widget + activity + * generic/tkEntry.c (DestroyEntry, EntryEventProc): fixed the + entry widget to survive deletion while processing scrollbar + updates and validation. + + * tests/canvas.test: test of canvas delete during event + * generic/tkCanvas.c (DestroyCanvas, CanvasEventProc): fixed the + canvas to survive deletion during event processing. [Bug #228024] + +2001-04-01 Jeff Hobbs <jeffh@ActiveState.com> + + * README: + * mac/README: updated patchlevel to 8.4a3 and corrected links and + notes. + + * generic/tk.h: + * unix/configure.in (TK_PATCH_LEVEL): + * unix/configure: + * unix/tk.spec: + * win/configure.in (TK_PATCH_LEVEL): + * win/configure: updated patchlevel to 8.4a3 + +2001-03-30 Jeff Hobbs <jeffh@ActiveState.com> + + * tests/safe.test: added note about correcting failures in + safe.test. + * library/tk.tcl: moved package require msgcat inside if case to + not be used in safe interps. + + * win/makefile.vc: + * win/configure: + * win/tcl.m4: added imm32.lib to LIBS_GUI for Tk IME support. + * win/tkWinInt.h: + * win/tkWinKey.c: + * win/tkWinX.c: added support for changing IME on the fly in + Windows (2000). (lam) [Patch #402993] + + * tests/bind.test (bind-22.18): + * generic/tkBind.c (NameToWindow): handled the error case where a + valid-looking but invalid identifier could be passed in certain + event generate options causing a crash. [Bug #411307] + + * win/tkWinWm.c (UpdateWrapper): ensured that the passed in winPtr + had an existent window to operate on. [Bug #409172] + + * win/Makefile.in (install-*): improved install-* targets to use + their base build dependency. + + * generic/tkImage.c (Tk_ImageObjCmd, EventuallyDeleteImage): + added casts to allow compiling on Windows with debbuging. + +2001-03-29 Jeff Hobbs <jeffh@ActiveState.com> + + * library/msgs/de.msg: fixed translations. [Patch #403525] + + * doc/canvas.n: Noted ability to specify coords as a list in the + docs. (techentin) [Patch #403660] + + * tests/canvas.test: added test case to check obj conversion + * generic/tkObj.c (UpdateStringOfMM, SetMMFromAny): better + obj-aware screen distances. (pgbaum, hobbs) [Patch #403327] + + * library/bgerror.tcl (bgerror): allow focus into details window + for Windows C&P to work. [Bug #220929] + + * library/tk.tcl: put a catch around adding <hpBackTab> to the + <<PrevWindow>> virtual event as it doesn't seem to work on all HP + systems. [Bug #411669] + + * library/tkfbox.tcl: fixed selecting directories and single files + with spaces using tk_getOpenFile -multiple 1. [Bug #411640] + + * win/tkWinDialog.c (GetFileNameA): added support for -multiple to + ascii-based tk_getOpenFile (Win9*). (haneef) [Patch #403047] + (GetFileNameW): increased number of files that could be returned + by tk_getOpenFile -multiple. [Patch #412042] + +2001-03-29 Mo DeJong <mdejong@redhat.com> + + * library/entry.tcl (tkEntryMouseSelect): + * library/text.tcl (tkTextSelectTo): When + the mouse is dragged with the button down, + move the insertion cursor to the current + mouse position. + * tests/event.test: Add a series of tests + for event generation. Add tests for selection, + check the position of the insertion cursor. + +2001-03-28 Jeff Hobbs <jeffh@gimlet.activestate.com> + + * unix/configure: + * unix/tcl.m4: corrected IRIX-5.x config to not use -n32. + (english) [Patch 403626] + +2001-03-28 Don Porter <dgp@users.sourceforge.net> + + * tests/focus.test (focus-6.1): + * tests/macEmbed.test (unixEmbed-5.1): + * tests/macMenu.test (macMenu-21.3): + * tests/menu.test (menu-27.1): + * tests/unixEmbed.test (unixEmbed-8.2): + * tests/unixWm.test (unixWm-50.4): Replaced all [load {} tk] + in Tk test suite with [load {} Tk]. [Bug 220940, Patch 411952] + 2001-03-12 Don Porter <dgp@users.sourceforge.net> BRANCH dgp-privates-into-namespace: @@ -1,11 +1,11 @@ README: Tk - This is the Tk 8.4a2 source distribution. + This is the Tk 8.4a3 source distribution. You can get any release of Tcl from: http://dev.scriptics.com/registration/<version>.html Tcl/Tk is also available through NetCVS: - http://dev.scriptics.com/software/tcltk/netcvs.html + http://tcl.sourceforge.net/ -RCS: @(#) $Id: README,v 1.27 2000/09/06 19:05:15 hobbs Exp $ +RCS: @(#) $Id: README,v 1.27.4.1 2001/07/03 20:01:07 dgp Exp $ 1. Introduction --------------- @@ -21,9 +21,13 @@ this release, see the Tcl/Tk 8.4 Web page at or refer to the "changes" file in this directory, which contains a historical record of all changes to Tk. -Tk is maintained, enhanced, and distributed freely as a -service to the Tcl community by Scriptics Corporation. -The official home for Tcl/Tk is on the Scriptics Web site: +Tk is maintained, enhanced, and distributed freely by members of the +Tcl community. The home for Tcl/Tk sources and bug database is on +SourceForge at: + + http://tcl.sourceforge.net/ + +with the Tcl Developer Xchange at: http://dev.scriptics.com diff --git a/deleted_files/xlib/ximage.c b/deleted_files/xlib/ximage.c deleted file mode 100644 index 057e973..0000000 --- a/deleted_files/xlib/ximage.c +++ /dev/null @@ -1,115 +0,0 @@ -/* - * ximage.c -- - * - * X bitmap and image routines. - * - * Copyright (c) 1995 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * SCCS: @(#) ximage.c 1.6 96/07/23 16:59:10 - */ - -#include "tkInt.h" - - -/* - *---------------------------------------------------------------------- - * - * XCreateBitmapFromData -- - * - * Construct a single plane pixmap from bitmap data. - * - * Results: - * Returns a new Pixmap. - * - * Side effects: - * Allocates a new bitmap and drawable. - * - *---------------------------------------------------------------------- - */ - -Pixmap -XCreateBitmapFromData(display, d, data, width, height) - Display* display; - Drawable d; - _Xconst char* data; - unsigned int width; - unsigned int height; -{ - XImage ximage; - GC gc; - Pixmap pix; - - pix = Tk_GetPixmap(display, d, width, height, 1); - gc = XCreateGC(display, pix, 0, NULL); - if (gc == NULL) { - return None; - } - ximage.height = height; - ximage.width = width; - ximage.depth = 1; - ximage.bits_per_pixel = 1; - ximage.xoffset = 0; - ximage.format = XYBitmap; - ximage.data = (char *)data; - ximage.byte_order = LSBFirst; - ximage.bitmap_unit = 8; - ximage.bitmap_bit_order = LSBFirst; - ximage.bitmap_pad = 8; - ximage.bytes_per_line = (width+7)/8; - - TkPutImage(NULL, 0, display, pix, gc, &ximage, 0, 0, 0, 0, width, height); - XFreeGC(display, gc); - return pix; -} - -/* - *---------------------------------------------------------------------- - * - * XReadBitmapFile -- - * - * Loads a bitmap image in X bitmap format into the specified - * drawable. - * - * Results: - * Sets the size, hotspot, and bitmap on success. - * - * Side effects: - * Creates a new bitmap from the file data. - * - *---------------------------------------------------------------------- - */ - -int -XReadBitmapFile(display, d, filename, width_return, height_return, - bitmap_return, x_hot_return, y_hot_return) - Display* display; - Drawable d; - _Xconst char* filename; - unsigned int* width_return; - unsigned int* height_return; - Pixmap* bitmap_return; - int* x_hot_return; - int* y_hot_return; -{ - Tcl_Interp *dummy; - char *data; - - dummy = Tcl_CreateInterp(); - - data = TkGetBitmapData(dummy, NULL, (char *) filename, - (int *) width_return, (int *) height_return, x_hot_return, - y_hot_return); - if (data == NULL) { - return BitmapFileInvalid; - } - - *bitmap_return = XCreateBitmapFromData(display, d, data, *width_return, - *height_return); - - Tcl_DeleteInterp(dummy); - ckfree(data); - return BitmapSuccess; -} diff --git a/doc/TkInitStubs.3 b/doc/TkInitStubs.3 index fc95144..4a8077e 100644 --- a/doc/TkInitStubs.3 +++ b/doc/TkInitStubs.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: TkInitStubs.3,v 1.1 1999/05/05 21:46:27 hershey Exp $ +'\" RCS: @(#) $Id: TkInitStubs.3,v 1.1.16.1 2001/07/03 20:01:07 dgp Exp $ '\" .so man.macros -.TH Tk_InitStubs 3 8.1 Tk "Tk Library Procedures" +.TH Tk_InitStubs 3 8.4 Tk "Tk Library Procedures" .BS .SH NAME Tk_InitStubs \- initialize the Tk stubs mechanism @@ -15,7 +15,7 @@ Tk_InitStubs \- initialize the Tk stubs mechanism .nf \fB#include <tk.h>\fR .sp -char * +CONST char * \fBTk_InitStubs\fR(\fIinterp, version, exact\fR) .SH ARGUMENTS .AS Tcl_Interp *interp in @@ -55,9 +55,9 @@ Define the USE_TCL_STUBS symbol. Typically, you would include the .IP 3) 5 Link the extension with the Tcl and Tk stubs libraries instead of the standard Tcl and Tk libraries. On Unix platforms, the library -names are \fIlibtclstub8.1.a\fR and \fIlibtkstub8.1.a\fR; on Windows -platforms, the library names are -\fItclstub81.lib\fR and \fItkstub81.lib\fR. +names are \fIlibtclstub8.4.a\fR and \fIlibtkstub8.4.a\fR; on Windows +platforms, the library names are \fItclstub84.lib\fR and \fItkstub84.lib\fR +(adjust names with appropriate version number). .SH DESCRIPTION \fBTk_InitStubs\fR attempts to initialize the Tk stub table pointers and ensure that the correct version of Tk is loaded. In addition diff --git a/doc/canvas.n b/doc/canvas.n index 06fff31..cda9042 100644 --- a/doc/canvas.n +++ b/doc/canvas.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: canvas.n,v 1.11 2000/09/07 00:23:35 hobbs Exp $ +'\" RCS: @(#) $Id: canvas.n,v 1.11.4.1 2001/07/03 20:01:07 dgp Exp $ '\" .so man.macros .TH canvas n 8.3 Tk "Tk Built-In Commands" @@ -198,6 +198,11 @@ the screen; if it is \fBc\fR then the distance is in centimeters; \fBi\fR means inches, and \fBp\fR means printers points (1/72 inch). Larger y-coordinates refer to points lower on the screen; larger x-coordinates refer to points farther to the right. +.VS +Coordinates can be specified either as an even number of parameters, +or as a single list parameter containing an even number of x and y +coordinate values. +.VE .SH TRANSFORMATIONS .PP @@ -487,6 +492,8 @@ this case the command returns an empty string. command. .TP \fIpathName\fR \fBcoords \fItagOrId \fR?\fIx0 y0 ...\fR? +.TP +\fIpathName\fR \fBcoords \fItagOrId \fR?\fIcoordList\fR? Query or modify the coordinates that define an item. If no coordinates are specified, this command returns a list whose elements are the coordinates of the item named by @@ -497,6 +504,8 @@ If \fItagOrId\fR refers to multiple items, then the first one in the display list is used. .TP \fIpathName \fBcreate \fItype x y \fR?\fIx y ...\fR? ?\fIoption value ...\fR? +.TP +\fIpathName \fBcreate \fItype coordList \fR?\fIoption value ...\fR? Create a new item in \fIpathName\fR of type \fItype\fR. The exact format of the arguments after \fBtype\fR depends on \fBtype\fR, but usually they consist of the coordinates for @@ -1136,8 +1145,9 @@ one of several ways (specified by the \fB\-style\fR option). Arcs are created with widget commands of the following form: .CS \fIpathName \fBcreate arc \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate arc \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR give +The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\fR give the coordinates of two diagonally opposite corners of a rectangular region enclosing the oval that defines the arc. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR @@ -1206,8 +1216,9 @@ two colors, foreground and background. Bitmaps are created with widget commands of the following form: .CS \fIpathName \fBcreate bitmap \fIx y \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate bitmap \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx\fR and \fIy\fR specify the coordinates of a +The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR specify the coordinates of a point used to position the bitmap on the display (see the \fB\-anchor\fR option below for more information on how bitmaps are displayed). After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR @@ -1270,8 +1281,9 @@ canvas. Images are created with widget commands of the following form: .CS \fIpathName \fBcreate image \fIx y \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate image \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx\fR and \fIy\fR specify the coordinates of a +The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR specify the coordinates of a point used to position the image on the display (see the \fB\-anchor\fR option below for more information). After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR @@ -1315,8 +1327,9 @@ widget commands: \fBdchars, index, insert.\fR Lines are created with widget commands of the following form: .CS \fIpathName \fBcreate line \fIx1 y1... xn yn \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate line \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx1\fR through \fIyn\fR give +The arguments \fIx1\fR through \fIyn\fR or \fIcoordList\fR give the coordinates for a series of two or more points that describe a series of connected line segments. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR @@ -1405,8 +1418,9 @@ both. Ovals are created with widget commands of the following form: .CS \fIpathName \fBcreate oval \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate oval \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR give +The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\fR give the coordinates of two diagonally opposite corners of a rectangular region enclosing the oval. The oval will include the top and left edges of the rectangle @@ -1454,8 +1468,9 @@ widget commands: \fBdchars, index, insert.\fR Polygons are created with widget commands of the following form: .CS \fIpathName \fBcreate polygon \fIx1 y1 ... xn yn \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate polygon \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx1\fR through \fIyn\fR specify the coordinates for +The arguments \fIx1\fR through \fIyn\fR or \fIcoordList\fR specify the coordinates for three or more points that define a polygon. The first point should not be repeated as the last to close the shape; Tk will automatically close the periphery between @@ -1532,8 +1547,9 @@ both. Rectangles are created with widget commands of the following form: .CS \fIpathName \fBcreate rectangle \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate rectangle \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR give +The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\fR give the coordinates of two diagonally opposite corners of the rectangle (the rectangle will include its upper and left edges but not its lower or right edges). @@ -1581,8 +1597,9 @@ Text items are created with widget commands of the following form: .CS \fIpathName \fBcreate text \fIx y \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate text \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx\fR and \fIy\fR specify the coordinates of a +The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR specify the coordinates of a point used to position the text on the display (see the options below for more information on how text is displayed). After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR @@ -1653,8 +1670,9 @@ at a given position on the canvas. Window items are created with widget commands of the following form: .CS \fIpathName \fBcreate window \fIx y \fR?\fIoption value option value ...\fR? +\fIpathName \fBcreate window \fIcoordList\fR ?\fIoption value option value ...\fR? .CE -The arguments \fIx\fR and \fIy\fR specify the coordinates of a +The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR specify the coordinates of a point used to position the window on the display (see the \fB\-anchor\fR option below for more information on how bitmaps are displayed). After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR diff --git a/doc/clipboard.n b/doc/clipboard.n index 3417623..3f9518b 100644 --- a/doc/clipboard.n +++ b/doc/clipboard.n @@ -5,10 +5,10 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: clipboard.n,v 1.3 2000/05/14 23:25:03 ericm Exp $ +'\" RCS: @(#) $Id: clipboard.n,v 1.3.4.1 2001/07/03 20:01:07 dgp Exp $ '\" .so man.macros -.TH clipboard n 4.0 Tk "Tk Built-In Commands" +.TH clipboard n 8.4 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -77,12 +77,17 @@ This feature may be convenient if, for example, \fIdata\fR starts with a \fB\-\fR. .RE .TP +.VS 8.4 \fBclipboard get\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-type\fR? Retrieve data from the clipboard on \fIwindow\fR's display. \fIwindow\fR defaults to ".". \fIType\fR specifies the form in which the data is to be returned and should be an atom name such as STRING or FILE_NAME. \fIType\fR defaults to STRING. This command is equivalent to \fBselection get -selection CLIPBOARD\fR. +.VE 8.4 + +.SH "SEE ALSO" +selection .SH KEYWORDS clear, format, clipboard, append, selection, type diff --git a/doc/colors.n b/doc/colors.n index 7168b56..4f90ac8 100644 --- a/doc/colors.n +++ b/doc/colors.n @@ -2,7 +2,7 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -'\" RCS: @(#) $Id: colors.n,v 1.2 2000/06/30 20:33:44 ericm Exp $ +'\" RCS: @(#) $Id: colors.n,v 1.2.4.1 2001/07/03 20:01:07 dgp Exp $ '\" '\" .so man.macros @@ -45,12 +45,12 @@ bisque4 139 125 125 black 0 0 0 blanched almond 255 235 235 BlanchedAlmond 255 235 235 -blue 0 0 0 +blue 0 0 255 blue violet 138 43 43 -blue1 0 0 0 -blue2 0 0 0 -blue3 0 0 0 -blue4 0 0 0 +blue1 0 0 255 +blue2 0 0 238 +blue3 0 0 205 +blue4 0 0 139 BlueViolet 138 43 43 brown 165 42 42 brown1 255 64 64 @@ -95,7 +95,7 @@ cyan1 0 255 255 cyan2 0 238 238 cyan3 0 205 205 cyan4 0 139 139 -dark blue 0 0 0 +dark blue 0 0 139 dark cyan 0 139 139 dark goldenrod 184 134 134 dark gray 169 169 169 @@ -114,7 +114,7 @@ dark slate gray 47 79 79 dark slate grey 47 79 79 dark turquoise 0 206 206 dark violet 148 0 0 -DarkBlue 0 0 0 +DarkBlue 0 0 139 DarkCyan 0 139 139 DarkGoldenrod 184 134 134 DarkGoldenrod1 255 185 185 @@ -538,7 +538,7 @@ maroon2 238 48 48 maroon3 205 41 41 maroon4 139 28 28 medium aquamarine 102 205 205 -medium blue 0 0 0 +medium blue 0 0 205 medium orchid 186 85 85 medium purple 147 112 112 medium sea green 60 179 179 @@ -547,7 +547,7 @@ medium spring green 0 250 250 medium turquoise 72 209 209 medium violet red 199 21 21 MediumAquamarine 102 205 205 -MediumBlue 0 0 0 +MediumBlue 0 0 205 MediumOrchid 186 85 85 MediumOrchid1 224 102 102 MediumOrchid2 209 95 95 @@ -580,9 +580,9 @@ NavajoWhite1 255 222 222 NavajoWhite2 238 207 207 NavajoWhite3 205 179 179 NavajoWhite4 139 121 121 -navy 0 0 0 -navy blue 0 0 0 -NavyBlue 0 0 0 +navy 0 0 128 +navy blue 0 0 128 +NavyBlue 0 0 128 old lace 253 245 245 OldLace 253 245 245 olive drab 107 142 142 diff --git a/doc/console.n b/doc/console.n new file mode 100644 index 0000000..d5167cb --- /dev/null +++ b/doc/console.n @@ -0,0 +1,142 @@ +'\" +'\" Copyright (c) 2001 Donal K. Fellows +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +'\" RCS: @(#) $Id: console.n,v 1.1.2.1 2001/07/03 20:01:07 dgp Exp $ +'\" +.so man.macros +.TH console n 8.4 Tk "Tcl Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +console \- Control the console on systems without a real console +.SH SYNOPSIS +\fBconsole title \fR?\fIstring\fR? +.sp +\fBconsole hide\fR +.sp +\fBconsole show\fR +.sp +\fBconsole eval \fIscript\fR +.BE + +.SH DESCRIPTION +.PP +The console window is a replacement for a real console to allow input +and output on the standard I/O channels on platforms that do not have +a real console. It is implemented as a separate interpreter with the +Tk toolkit loaded, and control over this interpreter is given through +the \fBconsole\fR command. The behaviour of the console window is +defined mainly through the contents of the \fIconsole.tcl\fR file in +the Tk library (or the \fIConsole\fR resource on Macintosh systems.) +.PP +.TP +\fBconsole eval \fIscript\fR +Evaluate the \fIscript\fR argument as a Tcl script in the console +interpreter. The normal interpreter is accessed through the +\fBconsoleinterp\fR command in the console interpreter. +.TP +\fBconsole hide\fR +Hide the console window from view. Precisely equivalent to +withdrawing the \fB.\fR window in the console interpreter. +.TP +\fBconsole show\fR +Display the console window. Precisely equivalent to deiconifying the +\fB.\fR window in the console interpreter. +.TP +\fBconsole title \fR?\fIstring\fR? +Query or modify the title of the console window. If \fIstring\fR is +not specified, queries the title of the console window, and sets the +title of the console window to \fIstring\fR otherwise. Precisely +equivalent to using the \fBwm title\fI command in the console +interpreter. + +.SH "ACCESS TO THE MAIN INTERPRETER" +.PP +The \fBconsoleinterp\fR command in the console interpreter allows +scripts to be evaluated in the main interpreter. It supports two +subcommands: \fBeval\fR and \fBrecord\fR. +.PP +.TP +\fBconsoleinterp eval \fIscript\fR +Evaluates \fIscript\fR as a Tcl script at the global level in the main +interpreter. +.TP +\fBconsoleinterp record \fIscript\fR +Records and evaluates \fIscript\fR as a Tcl script at the global level +in the main interpreter as if \fIscript\fR had been typed in at the +console. + +.SH "ADDITIONAL TRAP CALLS" +.PP +There are several additional commands in the console interpreter that +are called in response to activity in the main interpreter. +\fIThese are documented here for completeness only; they form part of +the internal implementation of the console and are likely to change or +be modified without warning.\fR +.PP +Output to the console from the main interpreter via the stdout and +stderr channels is handled by invoking the \fBtkConsoleOutput\fR +command in the console interpreter with two arguments. The first +argument is the name of the channel being written to, and the second +argument is the string being written to the channel (after encoding +and end-of-line translation processing has been performed.) +.PP +When the \fB.\fR window of the main interpreter is destroyed, the +\fBtkConsoleExit\fR command in the console interpreter is called +(assuming the console interpreter has not already been deleted itself, +that is.) + +.SH "DEFAULT BINDINGS" +.PP +The default script creates a console window (implemented using a text +widget) that has the following behaviour: +.IP [1] +Pressing the tab key inserts a TAB character (as defined by the Tcl +\et escape.) +.IP [2] +Pressing the return key causes the current line (if complete by the +rules of \fBinfo complete\fR) to be passed to the main interpreter for +evaluation. +.IP [3] +Pressing the delete key deletes the selected text (if any text is +selected) or the character to the right of the cursor (if not at the +end of the line.) +.IP [4] +Pressing the backspace key deletes the selected text (if any text is +selected) or the character to the left of the cursor (of not at the +start of the line.) +.IP [5] +Pressing either Control+A or the home key causes the cursor to go to +the start of the line (but after the prompt, if a prompt is present on +the line.) +.IP [6] +Pressing either Control+E or the end key causes the cursor to go to +the end of the line. +.IP [7] +Pressing either Control+P or the up key causes the previous entry in +the command history to be selected. +.IP [8] +Pressing either Control+N or the down key causes the next entry in the +command history to be selected. +.IP [9] +Pressing either Control+B or the left key causes the cursor to move +one character backward as long as the cursor is not at the prompt. +.IP [10] +Pressing either Control+F or the right key causes the cursor to move +one character forward. +.IP [11] +Pressing F9 rebuilds the console window by destroying all its children +and reloading the Tcl script that defined the console's behaviour. +.PP +Most other behaviour is the same as a conventional text widget except +for the way that the \fI<<Cut>>\fR event is handled identically to the +\fI<<Copy>>\fR event. + +.SH KEYWORDS +console, interpreter, window, interactive, output channels + +.SH "SEE ALSO" +destroy(n), fconfigure(n), history(n), interp(n), puts(n), text(n), wm(n) diff --git a/doc/image.n b/doc/image.n index 930dca9..c77dcfe 100644 --- a/doc/image.n +++ b/doc/image.n @@ -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: image.n,v 1.5 2000/11/28 11:16:04 dkf Exp $ +'\" RCS: @(#) $Id: image.n,v 1.5.2.1 2001/07/03 20:01:07 dgp Exp $ '\" .so man.macros .TH image n 4.0 Tk "Tk Built-In Commands" @@ -37,6 +37,10 @@ type; see below for details on the options for built-in image types. If an image already exists by the given name then it is replaced with the new image and any instances of that image will redisplay with the new contents. +It is important to note that the image command will silently overwrite any +procedure that may currently be defined by the given name, so choose the +name wisely. It is recommended to use a separate namespace for image names +(e.g., \fB::img::logo\fR, \fB::img::large\fR). .TP \fBimage delete \fR?\fIname name\fR ...? Deletes each of the named images and returns an empty string. diff --git a/doc/menubutton.n b/doc/menubutton.n index 6501337..df18bfa 100644 --- a/doc/menubutton.n +++ b/doc/menubutton.n @@ -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: menubutton.n,v 1.3 2000/08/25 06:58:32 ericm Exp $ +'\" RCS: @(#) $Id: menubutton.n,v 1.3.4.1 2001/07/03 20:01:07 dgp Exp $ '\" .so man.macros .TH menubutton n 4.0 Tk "Tk Built-In Commands" @@ -26,6 +26,14 @@ menubutton \- Create and manipulate menubutton widgets \-disabledforeground \-padx .SE .SH "WIDGET-SPECIFIC OPTIONS" +.OP \-compound compound Compound +Specifies whether the menubutton should display both an image and text, +and if so, where the image should be placed relative to the text. +Valid values for this option are \fBbottom\fR, \fBcenter\fR, +\fBleft\fR, \fBnone\fR, \fBright\fR and \fBtop\fR. The default value +is \fBnone\fR, meaning that the menubutton will display either an image or +text, depending on the values of the \fB\-image\fR and \fB\-bitmap\fR +options. .VS .OP \-direction direction Height Specifies where the menu is going to be popup up. \fBabove\fR tries to diff --git a/doc/selection.n b/doc/selection.n index a67678b..40f1962 100644 --- a/doc/selection.n +++ b/doc/selection.n @@ -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: selection.n,v 1.3 1999/06/03 18:50:45 stanton Exp $ +'\" RCS: @(#) $Id: selection.n,v 1.3.14.1 2001/07/03 20:01:07 dgp Exp $ '\" .so man.macros .TH selection n 8.1 Tk "Tk Built-In Commands" @@ -23,6 +23,9 @@ This command provides a Tcl interface to the X selection mechanism and implements the full selection functionality described in the X Inter-Client Communication Conventions Manual (ICCCM). .PP +Note that for management of the CLIPBOARD selection (see below), the +\fBclipboard\fR command may also be used. +.PP The first argument to \fBselection\fR determines the format of the rest of the arguments and the behavior of the command. The following forms are currently supported: @@ -126,5 +129,8 @@ If \fIcommand\fR is specified, it is a Tcl script to execute when some other window claims ownership of the selection away from \fIwindow\fR. \fISelection\fR defaults to PRIMARY. +.SH "SEE ALSO" +clipboard + .SH KEYWORDS clear, format, handler, ICCCM, own, selection, target, type diff --git a/generic/tk.h b/generic/tk.h index d91da04..9d9b758 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -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: tk.h,v 1.53 2000/11/22 01:49:37 ericm Exp $ + * RCS: @(#) $Id: tk.h,v 1.53.2.1 2001/07/03 20:01:07 dgp Exp $ */ #ifndef _TK @@ -39,7 +39,7 @@ extern "C" { * win/README (not patchlevel) * unix/README (not patchlevel) * unix/tk.spec (3 LOC Major/Minor, 2 LOC patch) - * win/aclocal.m4 (not patchlevel) + * win/tcl.m4 (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. @@ -48,10 +48,10 @@ extern "C" { #define TK_MAJOR_VERSION 8 #define TK_MINOR_VERSION 4 #define TK_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TK_RELEASE_SERIAL 2 +#define TK_RELEASE_SERIAL 3 #define TK_VERSION "8.4" -#define TK_PATCH_LEVEL "8.4a2" +#define TK_PATCH_LEVEL "8.4a3" /* * The following definitions set up the proper options for Macintosh @@ -1389,7 +1389,7 @@ EXTERN void Tk_CreateOldPhotoImageFormat _ANSI_ARGS_(( #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)); +CONST char *Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version, int exact)); #ifndef USE_TK_STUBS diff --git a/generic/tkBind.c b/generic/tkBind.c index 337e05f..ebf08bb 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.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: tkBind.c,v 1.14.2.1 2001/02/28 23:29:55 dgp Exp $ + * RCS: @(#) $Id: tkBind.c,v 1.14.2.2 2001/07/03 20:01:07 dgp Exp $ */ #include "tkPort.h" @@ -3716,7 +3716,7 @@ NameToWindow(interp, mainWin, objPtr, tkwinPtr) char *name; Tk_Window tkwin; int id; - + name = Tcl_GetStringFromObj(objPtr, NULL); if (name[0] == '.') { tkwin = Tk_NameToWindow(interp, name, mainWin); @@ -3725,12 +3725,18 @@ NameToWindow(interp, mainWin, objPtr, tkwinPtr) } *tkwinPtr = tkwin; } else { - if (TkpScanWindowId(NULL, name, &id) != TCL_OK) { + /* + * Check for the winPtr being valid, even if it looks ok to + * TkpScanWindowId. [Bug #411307] + */ + + if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) || + ((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), (Window) id)) + == NULL)) { Tcl_AppendResult(interp, "bad window name/identifier \"", name, "\"", (char *) NULL); return TCL_ERROR; } - *tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), (Window) id); } return TCL_OK; } diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index f90061f..b0b4f0e 100644 --- a/generic/tkCanvArc.c +++ b/generic/tkCanvArc.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: tkCanvArc.c,v 1.8 2000/02/01 11:41:09 hobbs Exp $ + * RCS: @(#) $Id: tkCanvArc.c,v 1.8.6.1 2001/07/03 20:01:07 dgp Exp $ */ #include <stdio.h> @@ -196,19 +196,19 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputeArcBbox _ANSI_ARGS_((Tk_Canvas canvas, ArcItem *arcPtr)); static int ConfigureArc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags)); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[], int flags)); static int CreateArc _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void DeleteArc _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); static void DisplayArc _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display, Drawable dst, int x, int y, int width, int height)); static int ArcCoords _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[])); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[])); static int ArcToArea _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double *rectPtr)); static double ArcToPoint _ANSI_ARGS_((Tk_Canvas canvas, @@ -286,29 +286,27 @@ Tk_ItemType tkArcType = { */ static int -CreateArc(interp, canvas, itemPtr, argc, argv) +CreateArc(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Arguments describing arc. */ + int objc; /* Number of arguments in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing arc. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; - int i; + int i = 4; - if (argc==1) { + if (objc == 1) { i = 1; - } else { - char *arg = Tcl_GetStringFromObj(argv[1], NULL); - if ((argc>1) && (arg[0] == '-') - && (arg[1] >= 'a') && (arg[1] <= 'z')) { + } else if (objc > 1) { + char *arg = Tcl_GetString(objv[1]); + if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; - } else { - i = 4; } } - if (argc < i) { + + if (objc < i) { Tcl_AppendResult(interp, "wrong # args: should be \"", Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"", @@ -342,10 +340,10 @@ CreateArc(interp, canvas, itemPtr, argc, argv) * Process the arguments to fill in the item record. */ - if ((ArcCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) { + if ((ArcCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) { goto error; } - if (ConfigureArc(interp, canvas, itemPtr, argc-4, argv+4, 0) == TCL_OK) { + if (ConfigureArc(interp, canvas, itemPtr, objc-4, objv+4, 0) == TCL_OK) { return TCL_OK; } error: @@ -372,19 +370,19 @@ CreateArc(interp, canvas, itemPtr, argc, argv) */ static int -ArcCoords(interp, canvas, itemPtr, argc, argv) +ArcCoords(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1, + int objc; /* Number of coordinates supplied in + * objv. */ + Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, * x2, y2, ... */ { ArcItem *arcPtr = (ArcItem *) itemPtr; - if (argc == 0) { + if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); Tcl_Obj *subobj = Tcl_NewDoubleObj(arcPtr->bbox[0]); Tcl_ListObjAppendElement(interp, obj, subobj); @@ -395,26 +393,26 @@ ArcCoords(interp, canvas, itemPtr, argc, argv) subobj = Tcl_NewDoubleObj(arcPtr->bbox[3]); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } else if ((argc == 1)||(argc == 4)) { - if (argc==1) { - if (Tcl_ListObjGetElements(interp, argv[0], &argc, - (Tcl_Obj ***) &argv) != TCL_OK) { + } else if ((objc == 1)||(objc == 4)) { + if (objc==1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; - } else if (argc != 4) { + } else if (objc != 4) { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 4, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 4, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &arcPtr->bbox[0]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &arcPtr->bbox[1]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[2], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2], &arcPtr->bbox[2]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[3], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3], &arcPtr->bbox[3]) != TCL_OK)) { return TCL_ERROR; } @@ -422,7 +420,7 @@ ArcCoords(interp, canvas, itemPtr, argc, argv) } else { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } @@ -449,12 +447,12 @@ ArcCoords(interp, canvas, itemPtr, argc, argv) */ static int -ConfigureArc(interp, canvas, itemPtr, argc, argv, flags) +ConfigureArc(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Arc item to reconfigure. */ - int argc; /* Number of elements in argv. */ - Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */ + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; @@ -469,7 +467,7 @@ ConfigureArc(interp, canvas, itemPtr, argc, argv, flags) Tk_State state; tkwin = Tk_CanvasTkwin(canvas); - if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv, + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, (char **) objv, (char *) arcPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index bcef7f3..6d4321d 100644 --- a/generic/tkCanvBmap.c +++ b/generic/tkCanvBmap.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: tkCanvBmap.c,v 1.4 1999/12/14 06:52:25 hobbs Exp $ + * RCS: @(#) $Id: tkCanvBmap.c,v 1.4.6.1 2001/07/03 20:01:07 dgp Exp $ */ #include <stdio.h> @@ -92,8 +92,8 @@ static Tk_ConfigSpec configSpecs[] = { */ static int BitmapCoords _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[])); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[])); static int BitmapToArea _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double *rectPtr)); static double BitmapToPoint _ANSI_ARGS_((Tk_Canvas canvas, @@ -103,11 +103,11 @@ static int BitmapToPostscript _ANSI_ARGS_((Tcl_Interp *interp, static void ComputeBitmapBbox _ANSI_ARGS_((Tk_Canvas canvas, BitmapItem *bmapPtr)); static int ConfigureBitmap _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags)); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[], int flags)); static int CreateBitmap _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void DeleteBitmap _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); static void DisplayBitmap _ANSI_ARGS_((Tk_Canvas canvas, @@ -168,22 +168,22 @@ Tk_ItemType tkBitmapType = { */ static int -CreateBitmap(interp, canvas, itemPtr, argc, argv) +CreateBitmap(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */ + int objc; /* Number of arguments in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */ { BitmapItem *bmapPtr = (BitmapItem *) itemPtr; int i; - if (argc==1) { + if (objc==1) { i = 1; } else { - char *arg = Tcl_GetStringFromObj(argv[1], NULL); - if (((argc>1) && (arg[0] == '-') + char *arg = Tcl_GetStringFromObj(objv[1], NULL); + if (((objc>1) && (arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z'))) { i = 1; } else { @@ -191,7 +191,7 @@ CreateBitmap(interp, canvas, itemPtr, argc, argv) } } - if (argc < i) { + if (objc < i) { Tcl_AppendResult(interp, "wrong # args: should be \"", Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", itemPtr->typePtr->name, " x y ?options?\"", @@ -219,10 +219,10 @@ CreateBitmap(interp, canvas, itemPtr, argc, argv) * Process the arguments to fill in the item record. */ - if ((BitmapCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) { + if ((BitmapCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) { goto error; } - if (ConfigureBitmap(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) { + if (ConfigureBitmap(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) { return TCL_OK; } @@ -250,40 +250,40 @@ CreateBitmap(interp, canvas, itemPtr, argc, argv) */ static int -BitmapCoords(interp, canvas, itemPtr, argc, argv) +BitmapCoords(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1, + int objc; /* Number of coordinates supplied in + * objv. */ + Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, * x2, y2, ... */ { BitmapItem *bmapPtr = (BitmapItem *) itemPtr; - if (argc == 0) { + if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); Tcl_Obj *subobj = Tcl_NewDoubleObj(bmapPtr->x); Tcl_ListObjAppendElement(interp, obj, subobj); subobj = Tcl_NewDoubleObj(bmapPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } else if (argc <3) { - if (argc==1) { - if (Tcl_ListObjGetElements(interp, argv[0], &argc, - (Tcl_Obj ***) &argv) != TCL_OK) { + } else if (objc <3) { + if (objc==1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; - } else if (argc != 2) { + } else if (objc != 2) { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 2, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1], &bmapPtr->y) + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &bmapPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &bmapPtr->y) != TCL_OK)) { return TCL_ERROR; } @@ -291,7 +291,7 @@ BitmapCoords(interp, canvas, itemPtr, argc, argv) } else { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } @@ -317,12 +317,12 @@ BitmapCoords(interp, canvas, itemPtr, argc, argv) */ static int -ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags) +ConfigureBitmap(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Bitmap item to reconfigure. */ - int argc; /* Number of elements in argv. */ - Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */ + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { BitmapItem *bmapPtr = (BitmapItem *) itemPtr; @@ -336,7 +336,7 @@ ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags) Tk_State state; tkwin = Tk_CanvasTkwin(canvas); - if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv, + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, (char **) objv, (char *) bmapPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c index 708490d..03623d1 100644 --- a/generic/tkCanvLine.c +++ b/generic/tkCanvLine.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: tkCanvLine.c,v 1.8 2000/10/24 23:51:33 ericm Exp $ + * RCS: @(#) $Id: tkCanvLine.c,v 1.8.4.1 2001/07/03 20:01:07 dgp Exp $ */ #include <stdio.h> @@ -83,13 +83,13 @@ static int ArrowheadPostscript _ANSI_ARGS_((Tcl_Interp *interp, static void ComputeLineBbox _ANSI_ARGS_((Tk_Canvas canvas, LineItem *linePtr)); static int ConfigureLine _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags)); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[], int flags)); static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas, LineItem *linePtr)); static int CreateLine _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void DeleteLine _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); static void DisplayLine _ANSI_ARGS_((Tk_Canvas canvas, @@ -100,7 +100,7 @@ static int GetLineIndex _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *obj, int *indexPtr)); static int LineCoords _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void LineDeleteCoords _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, int first, int last)); static void LineInsert _ANSI_ARGS_((Tk_Canvas canvas, @@ -291,13 +291,13 @@ Tk_ItemType tkLineType = { */ static int -CreateLine(interp, canvas, itemPtr, argc, argv) +CreateLine(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Arguments describing line. */ + int objc; /* Number of arguments in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing line. */ { LineItem *linePtr = (LineItem *) itemPtr; int i; @@ -330,17 +330,16 @@ CreateLine(interp, canvas, itemPtr, argc, argv) * start with a digit or a minus sign followed by a digit. */ - for (i = 0; i < argc; i++) { - char *arg = Tcl_GetStringFromObj(argv[i], NULL); - if ((arg[0] == '-') && (arg[1] >= 'a') - && (arg[1] <= 'z')) { + for (i = 0; i < objc; i++) { + char *arg = Tcl_GetString(objv[i]); + if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { break; } } - if (i && (LineCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) { + if (i && (LineCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) { goto error; } - if (ConfigureLine(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) { + if (ConfigureLine(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) { return TCL_OK; } @@ -368,21 +367,21 @@ CreateLine(interp, canvas, itemPtr, argc, argv) */ static int -LineCoords(interp, canvas, itemPtr, argc, argv) +LineCoords(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1, + int objc; /* Number of coordinates supplied in + * objv. */ + Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, * x2, y2, ... */ { LineItem *linePtr = (LineItem *) itemPtr; int i, numPoints; double *coordPtr; - if (argc == 0) { + if (objc == 0) { int numCoords; Tcl_Obj *subobj, *obj = Tcl_NewObj(); @@ -405,27 +404,27 @@ LineCoords(interp, canvas, itemPtr, argc, argv) Tcl_SetObjResult(interp, obj); return TCL_OK; } - if (argc == 1) { - if (Tcl_ListObjGetElements(interp, argv[0], &argc, - (Tcl_Obj ***) &argv) != TCL_OK) { + if (objc == 1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } } - if (argc & 1) { + if (objc & 1) { Tcl_AppendResult(interp, "odd number of coordinates specified for line", (char *) NULL); return TCL_ERROR; - } else if (argc < 4) { + } else if (objc < 4) { Tcl_AppendResult(interp, "too few coordinates specified for line", (char *) NULL); return TCL_ERROR; } else { - numPoints = argc/2; + numPoints = objc/2; if (linePtr->numPoints != numPoints) { coordPtr = (double *) ckalloc((unsigned) - (sizeof(double) * argc)); + (sizeof(double) * objc)); if (linePtr->coordPtr != NULL) { ckfree((char *) linePtr->coordPtr); } @@ -433,8 +432,8 @@ LineCoords(interp, canvas, itemPtr, argc, argv) linePtr->numPoints = numPoints; } coordPtr = linePtr->coordPtr; - for (i = 0; i <argc; i++) { - if (Tk_CanvasGetCoordFromObj(interp, canvas, argv[i], + for (i = 0; i <objc; i++) { + if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], coordPtr++) != TCL_OK) { return TCL_ERROR; } @@ -481,12 +480,12 @@ LineCoords(interp, canvas, itemPtr, argc, argv) */ static int -ConfigureLine(interp, canvas, itemPtr, argc, argv, flags) +ConfigureLine(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Line item to reconfigure. */ - int argc; /* Number of elements in argv. */ - Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */ + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { LineItem *linePtr = (LineItem *) itemPtr; @@ -497,7 +496,7 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags) Tk_State state; tkwin = Tk_CanvasTkwin(canvas); - if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv, + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, (char **) objv, (char *) linePtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } @@ -981,7 +980,7 @@ LineInsert(canvas, itemPtr, beforeThis, obj) Tcl_Obj *obj; /* New coordinates to be inserted. */ { LineItem *linePtr = (LineItem *) itemPtr; - int length, argc, i; + int length, objc, i; double *new, *coordPtr; Tk_State state = itemPtr->state; Tcl_Obj **objv; @@ -990,8 +989,8 @@ LineInsert(canvas, itemPtr, beforeThis, obj) state = ((TkCanvas *)canvas)->canvas_state; } - if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &argc, &objv) != TCL_OK) - || !argc || argc&1) { + if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &objc, &objv) != TCL_OK) + || !objc || objc&1) { return; } length = 2*linePtr->numPoints; @@ -1009,11 +1008,11 @@ LineInsert(canvas, itemPtr, beforeThis, obj) linePtr->coordPtr[length-2] = linePtr->lastArrowPtr[0]; linePtr->coordPtr[length-1] = linePtr->lastArrowPtr[1]; } - new = (double *) ckalloc((unsigned)(sizeof(double) * (length + argc))); + new = (double *) ckalloc((unsigned)(sizeof(double) * (length + objc))); for(i=0; i<beforeThis; i++) { new[i] = linePtr->coordPtr[i]; } - for(i=0; i<argc; i++) { + for(i=0; i<objc; i++) { if (Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,objv[i], new+(i+beforeThis))!=TCL_OK) { Tcl_ResetResult(((TkCanvas *)canvas)->interp); @@ -1023,11 +1022,11 @@ LineInsert(canvas, itemPtr, beforeThis, obj) } for(i=beforeThis; i<length; i++) { - new[i+argc] = linePtr->coordPtr[i]; + new[i+objc] = linePtr->coordPtr[i]; } if(linePtr->coordPtr) ckfree((char *)linePtr->coordPtr); linePtr->coordPtr = new; - linePtr->numPoints = (length + argc)/2; + linePtr->numPoints = (length + objc)/2; if ((length>3) && (state != TK_STATE_HIDDEN)) { /* @@ -1040,14 +1039,14 @@ LineInsert(canvas, itemPtr, beforeThis, obj) */ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW; - if (beforeThis>0) {beforeThis -= 2; argc+=2; } - if ((beforeThis+argc)<length) argc+=2; + if (beforeThis>0) {beforeThis -= 2; objc+=2; } + if ((beforeThis+objc)<length) objc+=2; if (linePtr->smooth) { if(beforeThis>0) { - beforeThis-=2; argc+=2; + beforeThis-=2; objc+=2; } - if((beforeThis+argc+2)<length) { - argc+=2; + if((beforeThis+objc+2)<length) { + objc+=2; } } itemPtr->x1 = itemPtr->x2 = (int) linePtr->coordPtr[beforeThis]; @@ -1059,7 +1058,7 @@ LineInsert(canvas, itemPtr, beforeThis, obj) TkIncludePoint(itemPtr, coordPtr); } } - if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+argc)>=length)) { + if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+objc)>=length)) { /* include old last arrow */ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW; i++, coordPtr += 2) { @@ -1067,7 +1066,7 @@ LineInsert(canvas, itemPtr, beforeThis, obj) } } coordPtr = linePtr->coordPtr+beforeThis+2; - for(i=2; i<argc; i+=2) { + for(i=2; i<objc; i+=2) { TkIncludePoint(itemPtr, coordPtr); coordPtr+=2; } @@ -1094,7 +1093,7 @@ LineInsert(canvas, itemPtr, beforeThis, obj) TkIncludePoint(itemPtr, coordPtr); } } - if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+argc)<(length-2))) { + if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+objc)<(length-2))) { /* include new right arrow */ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW; i++, coordPtr += 2) { diff --git a/generic/tkCanvPoly.c b/generic/tkCanvPoly.c index 3b6568e..5b2761e 100644 --- a/generic/tkCanvPoly.c +++ b/generic/tkCanvPoly.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: tkCanvPoly.c,v 1.6 2000/06/03 08:38:12 hobbs Exp $ + * RCS: @(#) $Id: tkCanvPoly.c,v 1.6.4.1 2001/07/03 20:01:07 dgp Exp $ */ #include <stdio.h> @@ -165,11 +165,11 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputePolygonBbox _ANSI_ARGS_((Tk_Canvas canvas, PolygonItem *polyPtr)); static int ConfigurePolygon _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags)); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[], int flags)); static int CreatePolygon _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void DeletePolygon _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); static void DisplayPolygon _ANSI_ARGS_((Tk_Canvas canvas, @@ -180,7 +180,7 @@ static int GetPolygonIndex _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *obj, int *indexPtr)); static int PolygonCoords _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void PolygonDeleteCoords _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, int first, int last)); static void PolygonInsert _ANSI_ARGS_((Tk_Canvas canvas, @@ -255,13 +255,13 @@ Tk_ItemType tkPolygonType = { */ static int -CreatePolygon(interp, canvas, itemPtr, argc, argv) +CreatePolygon(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Arguments describing polygon. */ + int objc; /* Number of arguments in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing polygon. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; int i; @@ -296,18 +296,17 @@ CreatePolygon(interp, canvas, itemPtr, argc, argv) * start with a digit or a minus sign followed by a digit. */ - for (i = 0; i < argc; i++) { - char *arg = Tcl_GetStringFromObj((Tcl_Obj *) argv[i], NULL); - if ((arg[0] == '-') && (arg[1] >= 'a') - && (arg[1] <= 'z')) { + for (i = 0; i < objc; i++) { + char *arg = Tcl_GetString(objv[i]); + if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { break; } } - if (i && PolygonCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) { + if (i && PolygonCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) { goto error; } - if (ConfigurePolygon(interp, canvas, itemPtr, argc-i, argv+i, 0) + if (ConfigurePolygon(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) { return TCL_OK; } @@ -336,20 +335,20 @@ CreatePolygon(interp, canvas, itemPtr, argc, argv) */ static int -PolygonCoords(interp, canvas, itemPtr, argc, argv) +PolygonCoords(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1, + int objc; /* Number of coordinates supplied in + * objv. */ + Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, * x2, y2, ... */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; int i, numPoints; - if (argc == 0) { + if (objc == 0) { /* * Print the coords used to create the polygon. If we auto * closed the polygon then we don't report the last point. @@ -362,19 +361,19 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv) Tcl_SetObjResult(interp, obj); return TCL_OK; } - if (argc == 1) { - if (Tcl_ListObjGetElements(interp, argv[0], &argc, - (Tcl_Obj ***) &argv) != TCL_OK) { + if (objc == 1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } } - if (argc & 1) { + if (objc & 1) { Tcl_AppendResult(interp, "odd number of coordinates specified for polygon", (char *) NULL); return TCL_ERROR; } else { - numPoints = argc/2; + numPoints = objc/2; if (polyPtr->pointsAllocated <= numPoints) { if (polyPtr->coordPtr != NULL) { ckfree((char *) polyPtr->coordPtr); @@ -386,11 +385,11 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv) */ polyPtr->coordPtr = (double *) ckalloc((unsigned) - (sizeof(double) * (argc+2))); + (sizeof(double) * (objc+2))); polyPtr->pointsAllocated = numPoints+1; } - for (i = argc-1; i >= 0; i--) { - if (Tk_CanvasGetCoordFromObj(interp, canvas, argv[i], + for (i = objc-1; i >= 0; i--) { + if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], &polyPtr->coordPtr[i]) != TCL_OK) { return TCL_ERROR; } @@ -402,12 +401,12 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv) * Close the polygon if it isn't already closed. */ - if (argc>2 && ((polyPtr->coordPtr[argc-2] != polyPtr->coordPtr[0]) - || (polyPtr->coordPtr[argc-1] != polyPtr->coordPtr[1]))) { + if (objc>2 && ((polyPtr->coordPtr[objc-2] != polyPtr->coordPtr[0]) + || (polyPtr->coordPtr[objc-1] != polyPtr->coordPtr[1]))) { polyPtr->autoClosed = 1; polyPtr->numPoints++; - polyPtr->coordPtr[argc] = polyPtr->coordPtr[0]; - polyPtr->coordPtr[argc+1] = polyPtr->coordPtr[1]; + polyPtr->coordPtr[objc] = polyPtr->coordPtr[0]; + polyPtr->coordPtr[objc+1] = polyPtr->coordPtr[1]; } ComputePolygonBbox(canvas, polyPtr); } @@ -434,12 +433,12 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv) */ static int -ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags) +ConfigurePolygon(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Interpreter for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Polygon item to reconfigure. */ - int argc; /* Number of elements in argv. */ - Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */ + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; @@ -452,7 +451,7 @@ ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags) Tk_State state; tkwin = Tk_CanvasTkwin(canvas); - if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv, + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, (char **) objv, (char *) polyPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } @@ -1022,7 +1021,7 @@ PolygonInsert(canvas, itemPtr, beforeThis, obj) Tcl_Obj *obj; /* New coordinates to be inserted. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; - int length, argc, i; + int length, objc, i; Tcl_Obj **objv; double *new; Tk_State state = itemPtr->state; @@ -1031,18 +1030,18 @@ PolygonInsert(canvas, itemPtr, beforeThis, obj) state = ((TkCanvas *)canvas)->canvas_state; } - if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &argc, &objv) != TCL_OK) - || !argc || argc&1) { + if (!obj || (Tcl_ListObjGetElements((Tcl_Interp *) NULL, obj, &objc, &objv) != TCL_OK) + || !objc || objc&1) { return; } length = 2*(polyPtr->numPoints - polyPtr->autoClosed); while(beforeThis>length) beforeThis-=length; while(beforeThis<0) beforeThis+=length; - new = (double *) ckalloc((unsigned)(sizeof(double) * (length + 2 + argc))); + new = (double *) ckalloc((unsigned)(sizeof(double) * (length + 2 + objc))); for (i=0; i<beforeThis; i++) { new[i] = polyPtr->coordPtr[i]; } - for (i=0; i<argc; i++) { + for (i=0; i<objc; i++) { if (Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,objv[i], new+(i+beforeThis))!=TCL_OK) { ckfree((char *) new); @@ -1051,10 +1050,10 @@ PolygonInsert(canvas, itemPtr, beforeThis, obj) } for(i=beforeThis; i<length; i++) { - new[i+argc] = polyPtr->coordPtr[i]; + new[i+objc] = polyPtr->coordPtr[i]; } if(polyPtr->coordPtr) ckfree((char *) polyPtr->coordPtr); - length+=argc; + length+=objc; polyPtr->coordPtr = new; polyPtr->numPoints = (length/2) + polyPtr->autoClosed; @@ -1078,7 +1077,7 @@ PolygonInsert(canvas, itemPtr, beforeThis, obj) new[length] = new[0]; new[length+1] = new[1]; - if (((length-argc)>3) && (state != TK_STATE_HIDDEN)) { + if (((length-objc)>3) && (state != TK_STATE_HIDDEN)) { /* * This is some optimizing code that will result that only the part * of the polygon that changed (and the objects that are overlapping @@ -1101,11 +1100,11 @@ PolygonInsert(canvas, itemPtr, beforeThis, obj) itemPtr->x1 = itemPtr->x2 = (int) polyPtr->coordPtr[beforeThis]; itemPtr->y1 = itemPtr->y2 = (int) polyPtr->coordPtr[beforeThis+1]; - beforeThis-=2; argc+=4; + beforeThis-=2; objc+=4; if(polyPtr->smooth) { - beforeThis-=2; argc+=4; + beforeThis-=2; objc+=4; } /* be carefull; beforeThis could now be negative */ - for(i=beforeThis; i<beforeThis+argc; i+=2) { + for(i=beforeThis; i<beforeThis+objc; i+=2) { j=i; if(j<0) j+=length; if(j>=length) j-=length; diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index fa419c3..88418f5 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.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: tkCanvText.c,v 1.8 1999/12/21 23:55:10 hobbs Exp $ + * RCS: @(#) $Id: tkCanvText.c,v 1.8.6.1 2001/07/03 20:01:07 dgp Exp $ */ #include <stdio.h> @@ -141,10 +141,10 @@ static void ComputeTextBbox _ANSI_ARGS_((Tk_Canvas canvas, TextItem *textPtr)); static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags)); + Tcl_Obj *CONST objv[], int flags)); static int CreateText _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int argc, Tcl_Obj *CONST objv[])); static void DeleteText _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); static void DisplayCanvText _ANSI_ARGS_((Tk_Canvas canvas, @@ -163,7 +163,7 @@ static void SetTextCursor _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, int index)); static int TextCoords _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int argc, Tcl_Obj *CONST objv[])); static void TextDeleteChars _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, int first, int last)); static void TextInsert _ANSI_ARGS_((Tk_Canvas canvas, @@ -226,30 +226,27 @@ Tk_ItemType tkTextType = { */ static int -CreateText(interp, canvas, itemPtr, argc, argv) +CreateText(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */ + int objc; /* Number of arguments in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */ { TextItem *textPtr = (TextItem *) itemPtr; - int i; + int i = 2; - if (argc==1) { + if (objc == 1) { i = 1; - } else { - char *arg = Tcl_GetStringFromObj(argv[1], NULL); - if ((argc>1) && (arg[0] == '-') - && (arg[1] >= 'a') && (arg[1] <= 'z')) { + } else if (objc > 1) { + char *arg = Tcl_GetString(objv[1]); + if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; - } else { - i = 2; } } - if (argc < i) { + if (objc < i) { Tcl_AppendResult(interp, "wrong # args: should be \"", Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", itemPtr->typePtr->name, " x y ?options?\"", (char *) NULL); @@ -293,10 +290,10 @@ CreateText(interp, canvas, itemPtr, argc, argv) * Process the arguments to fill in the item record. */ - if ((TextCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) { + if ((TextCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) { goto error; } - if (ConfigureText(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) { + if (ConfigureText(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) { return TCL_OK; } @@ -324,38 +321,38 @@ CreateText(interp, canvas, itemPtr, argc, argv) */ static int -TextCoords(interp, canvas, itemPtr, argc, argv) +TextCoords(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1, x2, y2, ... */ + int objc; /* Number of coordinates supplied in objv. */ + Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, x2, y2, ... */ { TextItem *textPtr = (TextItem *) itemPtr; - if (argc == 0) { + if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); Tcl_Obj *subobj = Tcl_NewDoubleObj(textPtr->x); Tcl_ListObjAppendElement(interp, obj, subobj); subobj = Tcl_NewDoubleObj(textPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } else if (argc < 3) { - if (argc==1) { - if (Tcl_ListObjGetElements(interp, argv[0], &argc, - (Tcl_Obj ***) &argv) != TCL_OK) { + } else if (objc < 3) { + if (objc==1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; - } else if (argc != 2) { + } else if (objc != 2) { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 2, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0], &textPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &textPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &textPtr->y) != TCL_OK)) { return TCL_ERROR; } @@ -363,7 +360,7 @@ TextCoords(interp, canvas, itemPtr, argc, argv) } else { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } @@ -390,12 +387,12 @@ TextCoords(interp, canvas, itemPtr, argc, argv) */ static int -ConfigureText(interp, canvas, itemPtr, argc, argv, flags) +ConfigureText(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Interpreter for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */ - int argc; /* Number of elements in argv. */ - Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */ + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { TextItem *textPtr = (TextItem *) itemPtr; @@ -410,7 +407,7 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags) Tk_State state; tkwin = Tk_CanvasTkwin(canvas); - if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv, + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, (char **) objv, (char *) textPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c index fab0015..1319acb 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.4 1999/12/14 06:52:26 hobbs Exp $ + * RCS: @(#) $Id: tkCanvWind.c,v 1.4.6.1 2001/07/03 20:01:07 dgp Exp $ */ #include <stdio.h> @@ -75,11 +75,11 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputeWindowBbox _ANSI_ARGS_((Tk_Canvas canvas, WindowItem *winItemPtr)); static int ConfigureWinItem _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags)); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[], int flags)); static int CreateWinItem _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void DeleteWinItem _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); static void DisplayWinItem _ANSI_ARGS_((Tk_Canvas canvas, @@ -91,8 +91,8 @@ static void ScaleWinItem _ANSI_ARGS_((Tk_Canvas canvas, static void TranslateWinItem _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double deltaX, double deltaY)); static int WinItemCoords _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[])); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[])); static void WinItemLostSlaveProc _ANSI_ARGS_(( ClientData clientData, Tk_Window tkwin)); static void WinItemRequestProc _ANSI_ARGS_((ClientData clientData, @@ -175,30 +175,27 @@ static Tk_GeomMgr canvasGeomType = { */ static int -CreateWinItem(interp, canvas, itemPtr, argc, argv) +CreateWinItem(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Arguments describing window. */ + int objc; /* Number of arguments in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing window. */ { WindowItem *winItemPtr = (WindowItem *) itemPtr; - int i; + int i = 2; - if (argc==1) { + if (objc == 1) { i = 1; - } else { - char *arg = Tcl_GetStringFromObj(argv[1], NULL); - if (((argc>1) && (arg[0] == '-') - && (arg[1] >= 'a') && (arg[1] <= 'z'))) { + } else if (objc > 1) { + char *arg = Tcl_GetString(objv[1]); + if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; - } else { - i = 2; } } - if (argc < i) { + if (objc < i) { Tcl_AppendResult(interp, "wrong # args: should be \"", Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", itemPtr->typePtr->name, " x y ?options?\"", @@ -220,10 +217,10 @@ CreateWinItem(interp, canvas, itemPtr, argc, argv) * Process the arguments to fill in the item record. */ - if ((WinItemCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) { + if ((WinItemCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) { goto error; } - if (ConfigureWinItem(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) { + if (ConfigureWinItem(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) { return TCL_OK; } @@ -251,40 +248,40 @@ CreateWinItem(interp, canvas, itemPtr, argc, argv) */ static int -WinItemCoords(interp, canvas, itemPtr, argc, argv) +WinItemCoords(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1, + int objc; /* Number of coordinates supplied in + * objv. */ + Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, * x2, y2, ... */ { WindowItem *winItemPtr = (WindowItem *) itemPtr; - if (argc == 0) { + if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); Tcl_Obj *subobj = Tcl_NewDoubleObj(winItemPtr->x); Tcl_ListObjAppendElement(interp, obj, subobj); subobj = Tcl_NewDoubleObj(winItemPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } else if (argc < 3) { - if (argc==1) { - if (Tcl_ListObjGetElements(interp, argv[0], &argc, - (Tcl_Obj ***) &argv) != TCL_OK) { + } else if (objc < 3) { + if (objc==1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; - } else if (argc != 2) { + } else if (objc != 2) { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 2, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0], &winItemPtr->x) - != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &winItemPtr->x) + != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &winItemPtr->y) != TCL_OK)) { return TCL_ERROR; } @@ -292,7 +289,7 @@ WinItemCoords(interp, canvas, itemPtr, argc, argv) } else { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } @@ -318,12 +315,12 @@ WinItemCoords(interp, canvas, itemPtr, argc, argv) */ static int -ConfigureWinItem(interp, canvas, itemPtr, argc, argv, flags) +ConfigureWinItem(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Window item to reconfigure. */ - int argc; /* Number of elements in argv. */ - Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */ + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { WindowItem *winItemPtr = (WindowItem *) itemPtr; @@ -332,7 +329,7 @@ ConfigureWinItem(interp, canvas, itemPtr, argc, argv, flags) oldWindow = winItemPtr->tkwin; canvasTkwin = Tk_CanvasTkwin(canvas); - if (Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, argc, (char **) argv, + if (Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, objc, (char **) objv, (char *) winItemPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 0820e02..025afdc 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.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: tkCanvas.c,v 1.15 2000/11/22 01:49:37 ericm Exp $ + * RCS: @(#) $Id: tkCanvas.c,v 1.15.2.1 2001/07/03 20:01:07 dgp Exp $ */ /* #define USE_OLD_TAG_SEARCH 1 */ @@ -1929,14 +1929,10 @@ DestroyCanvas(memPtr) { TkCanvas *canvasPtr = (TkCanvas *) memPtr; Tk_Item *itemPtr; +#ifndef USE_OLD_TAG_SEARCH + TagSearchExpr *expr, *next; +#endif - if (canvasPtr->tkwin != NULL) { - Tcl_DeleteCommandFromToken(canvasPtr->interp, canvasPtr->widgetCmd); - } - if (canvasPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr); - } - /* * Free up all of the items in the canvas. */ @@ -1963,15 +1959,11 @@ DestroyCanvas(memPtr) Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC); } #ifndef USE_OLD_TAG_SEARCH - { - TagSearchExpr *expr, *next; - - expr = canvasPtr->bindTagExprs; - while (expr) { - next = expr->next; - TagSearchExprDestroy(expr); - expr = next; - } + expr = canvasPtr->bindTagExprs; + while (expr) { + next = expr->next; + TagSearchExprDestroy(expr); + expr = next; } #endif Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler); @@ -2447,7 +2439,16 @@ CanvasEventProc(clientData, eventPtr) canvasPtr->flags |= REDRAW_BORDERS; } } else if (eventPtr->type == DestroyNotify) { - DestroyCanvas((char *) canvasPtr); + if (canvasPtr->tkwin != NULL) { + canvasPtr->tkwin = NULL; + Tcl_DeleteCommandFromToken(canvasPtr->interp, + canvasPtr->widgetCmd); + } + if (canvasPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr); + } + Tcl_EventuallyFree((ClientData) canvasPtr, + (Tcl_FreeProc *) DestroyCanvas); } else if (eventPtr->type == ConfigureNotify) { canvasPtr->flags |= UPDATE_SCROLLBARS; diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 4a01d12..ee5f94f 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.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: tkEntry.c,v 1.18 2000/11/22 01:49:37 ericm Exp $ + * RCS: @(#) $Id: tkEntry.c,v 1.18.2.1 2001/07/03 20:01:08 dgp Exp $ */ #include "tkInt.h" @@ -837,6 +837,13 @@ Tk_EntryObjCmd(clientData, interp, objc, objv) entryPtr->avgWidth = 1; entryPtr->validate = VALIDATE_NONE; + /* + * Keep a hold of the associated tkwin until we destroy the listbox, + * otherwise Tk might free it while we still need it. + */ + + Tcl_Preserve((ClientData) entryPtr->tkwin); + Tk_SetClass(entryPtr->tkwin, "Entry"); Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr); Tk_CreateEventHandler(entryPtr->tkwin, @@ -851,7 +858,7 @@ Tk_EntryObjCmd(clientData, interp, objc, objv) Tk_DestroyWindow(entryPtr->tkwin); return TCL_ERROR; } - + Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); return TCL_OK; } @@ -889,7 +896,6 @@ EntryWidgetObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } - Tcl_Preserve((ClientData) entryPtr); /* * Parse the widget command by looking up the second token in @@ -902,6 +908,7 @@ EntryWidgetObjCmd(clientData, interp, objc, objv) return result; } + Tcl_Preserve((ClientData) entryPtr); switch ((enum entryCmd) cmdIndex) { case COMMAND_BBOX: { int index, x, y, width, height; @@ -1323,12 +1330,6 @@ DestroyEntry(memPtr) char *memPtr; /* Info about entry widget. */ { 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 @@ -1366,7 +1367,9 @@ DestroyEntry(memPtr) Tk_FreeTextLayout(entryPtr->textLayout); Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable, entryPtr->tkwin); + Tcl_Release((ClientData) entryPtr->tkwin); entryPtr->tkwin = NULL; + ckfree((char *) entryPtr); } @@ -1794,7 +1797,7 @@ DisplayEntry(clientData) Tk_3DBorder border; entryPtr->flags &= ~REDRAW_PENDING; - if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { + if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) { return; } @@ -1806,7 +1809,20 @@ DisplayEntry(clientData) if (entryPtr->flags & UPDATE_SCROLLBAR) { entryPtr->flags &= ~UPDATE_SCROLLBAR; + + /* + * Preserve/Release because updating the scrollbar can have + * the side-effect of destroying or unmapping the entry widget. + */ + + Tcl_Preserve((ClientData) entryPtr); EntryUpdateScrollbar(entryPtr); + + if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) { + Tcl_Release((ClientData) entryPtr); + return; + } + Tcl_Release((ClientData) entryPtr); } /* @@ -2606,6 +2622,7 @@ EntryEventProc(clientData, eventPtr) Tk_UndefineCursor(entryPtr->tkwin); } } + return; } switch (eventPtr->type) { @@ -2614,7 +2631,15 @@ EntryEventProc(clientData, eventPtr) entryPtr->flags |= BORDER_NEEDED; break; case DestroyNotify: - DestroyEntry((char *) clientData); + if (!(entryPtr->flags & ENTRY_DELETED)) { + entryPtr->flags |= (ENTRY_DELETED | VALIDATE_ABORT); + Tcl_DeleteCommandFromToken(entryPtr->interp, + entryPtr->widgetCmd); + if (entryPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayEntry, clientData); + } + Tcl_EventuallyFree(clientData, DestroyEntry); + } break; case ConfigureNotify: Tcl_Preserve((ClientData) entryPtr); @@ -3027,7 +3052,7 @@ static void EventuallyRedraw(entryPtr) Entry *entryPtr; /* Information about widget. */ { - if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(entryPtr->tkwin)) { + if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(entryPtr->tkwin)) { return; } @@ -3424,15 +3449,27 @@ EntryValidateChange(entryPtr, change, new, index, type) * it means that a loop condition almost occured. Do not allow * this validation result to finish. */ + if (entryPtr->validate == VALIDATE_NONE || (!varValidate && (entryPtr->flags & VALIDATE_VAR))) { code = TCL_ERROR; } + + /* + * It's possible that the user deleted the entry during validation. + * In that case, abort future validation and return an error. + */ + + if (entryPtr->flags & ENTRY_DELETED) { + return TCL_ERROR; + } + /* * If validate will return ERROR, then disallow further validations * Otherwise, if it didn't accept the new string (returned TCL_BREAK) * then eval the invalidCmd (if it's set) */ + if (code == TCL_ERROR) { entryPtr->validate = VALIDATE_NONE; } else if (code == TCL_BREAK) { @@ -3444,6 +3481,7 @@ EntryValidateChange(entryPtr, change, new, index, type) * may want to do entry manipulation which the setting of the * var will later wipe anyway. */ + if (varValidate) { entryPtr->validate = VALIDATE_NONE; } else if (entryPtr->invalidCmd != NULL) { @@ -3461,6 +3499,15 @@ EntryValidateChange(entryPtr, change, new, index, type) entryPtr->validate = VALIDATE_NONE; } Tcl_DStringFree(&script); + + /* + * It's possible that the user deleted the entry during validation. + * In that case, abort future validation and return an error. + */ + + if (entryPtr->flags & ENTRY_DELETED) { + return TCL_ERROR; + } } } @@ -3738,6 +3785,13 @@ Tk_SpinboxObjCmd(clientData, interp, objc, objv) sbPtr->bdRelief = TK_RELIEF_FLAT; sbPtr->buRelief = TK_RELIEF_FLAT; + /* + * Keep a hold of the associated tkwin until we destroy the listbox, + * otherwise Tk might free it while we still need it. + */ + + Tcl_Preserve((ClientData) entryPtr->tkwin); + Tk_SetClass(entryPtr->tkwin, "Spinbox"); Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr); Tk_CreateEventHandler(entryPtr->tkwin, @@ -3797,7 +3851,6 @@ SpinboxWidgetObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } - Tcl_Preserve((ClientData) entryPtr); /* * Parse the widget command by looking up the second token in @@ -3810,6 +3863,7 @@ SpinboxWidgetObjCmd(clientData, interp, objc, objv) return result; } + Tcl_Preserve((ClientData) entryPtr); switch ((enum sbCmd) cmdIndex) { case SB_CMD_BBOX: { int index, x, y, width, height; diff --git a/generic/tkFrame.c b/generic/tkFrame.c index cf356ce..074a315 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.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: tkFrame.c,v 1.7 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkFrame.c,v 1.7.2.1 2001/07/03 20:01:08 dgp Exp $ */ #include "default.h" @@ -20,6 +20,14 @@ #include "tkInt.h" /* + * The following enum is used to define the type of the frame. + */ + +enum FrameType { + TYPE_FRAME, TYPE_TOPLEVEL +}; + +/* * A data structure of the following type is kept for each * frame that currently exists for this process: */ @@ -35,11 +43,11 @@ typedef struct { Tcl_Interp *interp; /* Interpreter associated with widget. Used * to delete widget command. */ Tcl_Command widgetCmd; /* Token for frame's widget command. */ + Tk_OptionTable optionTable; /* Table that defines configuration options + * available for this widget. */ char *className; /* Class name for widget (from configuration * option). Malloc-ed. */ - int mask; /* Either FRAME or TOPLEVEL; used to select - * which configuration options are valid for - * widget. */ + enum FrameType type; /* Type of widget, such as TYPE_FRAME. */ char *screenName; /* Screen on which widget is created. Non-null * only for top-levels. Malloc-ed, may be * NULL. */ @@ -98,68 +106,97 @@ typedef struct { #define GOT_FOCUS 4 /* - * The following flag bits are used so that there can be separate - * defaults for some configuration options for frames and toplevels. + * Information used for parsing configuration options. There are + * one common table used by both, one frame table and one toplevel table. + */ + +static Tk_OptionSpec commonOptSpec[] = { + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_FRAME_BG_COLOR, -1, Tk_Offset(Frame, border), + TK_OPTION_NULL_OK, (ClientData) DEF_FRAME_BG_MONO, 0}, + {TK_OPTION_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_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), + 0, 0, 0}, + {TK_OPTION_STRING, "-colormap", "colormap", "Colormap", + DEF_FRAME_COLORMAP, -1, Tk_Offset(Frame, colormapName), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-container", "container", "Container", + DEF_FRAME_CONTAINER, -1, Tk_Offset(Frame, isContainer), + 0, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_FRAME_CURSOR, -1, Tk_Offset(Frame, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-height", "height", "Height", + DEF_FRAME_HEIGHT, -1, Tk_Offset(Frame, height), + 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_FRAME_HIGHLIGHT_BG, -1, + Tk_Offset(Frame, highlightBgColorPtr), 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_FRAME_HIGHLIGHT, -1, Tk_Offset(Frame, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_FRAME_HIGHLIGHT_WIDTH, -1, + Tk_Offset(Frame, highlightWidth), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief), + 0, 0, 0}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_FRAME_TAKE_FOCUS, -1, Tk_Offset(Frame, takeFocus), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-visual", "visual", "Visual", + DEF_FRAME_VISUAL, -1, Tk_Offset(Frame, visualName), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-width", "width", "Width", + DEF_FRAME_WIDTH, -1, Tk_Offset(Frame, width), + 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0, 0, 0, 0} +}; + +static Tk_OptionSpec frameOptSpec[] = { + {TK_OPTION_STRING, "-class", "class", "Class", + DEF_FRAME_CLASS, -1, Tk_Offset(Frame, className), + 0, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} +}; + +static Tk_OptionSpec toplevelOptSpec[] = { + {TK_OPTION_STRING, "-class", "class", "Class", + DEF_TOPLEVEL_CLASS, -1, Tk_Offset(Frame, className), + 0, 0, 0}, + {TK_OPTION_STRING, "-menu", "menu", "Menu", + DEF_TOPLEVEL_MENU, -1, Tk_Offset(Frame, menuName), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-screen", "screen", "Screen", + DEF_TOPLEVEL_SCREEN, -1, Tk_Offset(Frame, screenName), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-use", "use", "Use", + DEF_FRAME_USE, -1, Tk_Offset(Frame, useThis), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} +}; + +/* + * Class names for widgets, indexed by FrameType. + */ + +static char *classNames[] = {"Frame", "Toplevel"}; + +/* + * The following table maps from FrameType to the option template for + * that class of widgets. */ -#define FRAME TK_CONFIG_USER_BIT -#define TOPLEVEL (TK_CONFIG_USER_BIT << 1) -#define BOTH (FRAME | TOPLEVEL) - -static Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_FRAME_BG_COLOR, Tk_Offset(Frame, border), - BOTH|TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_FRAME_BG_MONO, Tk_Offset(Frame, border), - BOTH|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, BOTH}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, BOTH}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_FRAME_BORDER_WIDTH, Tk_Offset(Frame, borderWidth), BOTH}, - {TK_CONFIG_STRING, "-class", "class", "Class", - DEF_FRAME_CLASS, Tk_Offset(Frame, className), FRAME}, - {TK_CONFIG_STRING, "-class", "class", "Class", - DEF_TOPLEVEL_CLASS, Tk_Offset(Frame, className), TOPLEVEL}, - {TK_CONFIG_STRING, "-colormap", "colormap", "Colormap", - DEF_FRAME_COLORMAP, Tk_Offset(Frame, colormapName), - BOTH|TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-container", "container", "Container", - DEF_FRAME_CONTAINER, Tk_Offset(Frame, isContainer), BOTH}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_FRAME_CURSOR, Tk_Offset(Frame, cursor), BOTH|TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-height", "height", "Height", - DEF_FRAME_HEIGHT, Tk_Offset(Frame, height), BOTH}, - {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", - "HighlightBackground", DEF_FRAME_HIGHLIGHT_BG, - Tk_Offset(Frame, highlightBgColorPtr), BOTH}, - {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_FRAME_HIGHLIGHT, Tk_Offset(Frame, highlightColorPtr), BOTH}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", - "HighlightThickness", - DEF_FRAME_HIGHLIGHT_WIDTH, Tk_Offset(Frame, highlightWidth), BOTH}, - {TK_CONFIG_STRING, "-menu", "menu", "Menu", - DEF_TOPLEVEL_MENU, Tk_Offset(Frame, menuName), - TOPLEVEL|TK_CONFIG_NULL_OK}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_FRAME_RELIEF, Tk_Offset(Frame, relief), BOTH}, - {TK_CONFIG_STRING, "-screen", "screen", "Screen", - DEF_TOPLEVEL_SCREEN, Tk_Offset(Frame, screenName), - TOPLEVEL|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_FRAME_TAKE_FOCUS, Tk_Offset(Frame, takeFocus), - BOTH|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-use", "use", "Use", - DEF_FRAME_USE, Tk_Offset(Frame, useThis), TOPLEVEL|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-visual", "visual", "Visual", - DEF_FRAME_VISUAL, Tk_Offset(Frame, visualName), - BOTH|TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-width", "width", "Width", - DEF_FRAME_WIDTH, Tk_Offset(Frame, width), BOTH}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +static Tk_OptionSpec *optionSpecs[] = { + frameOptSpec, + toplevelOptSpec }; /* @@ -167,11 +204,10 @@ static Tk_ConfigSpec configSpecs[] = { */ static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp, - Frame *framePtr, int objc, Tcl_Obj *CONST objv[], - int flags)); + Frame *framePtr, int objc, Tcl_Obj *CONST objv[])); static int CreateFrame _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST argv[], - int toplevel, char *appName)); + enum FrameType type, char *appName)); static void DestroyFrame _ANSI_ARGS_((char *memPtr)); static void DisplayFrame _ANSI_ARGS_((ClientData clientData)); static void FrameCmdDeletedProc _ANSI_ARGS_(( @@ -196,31 +232,31 @@ static void MapFrame _ANSI_ARGS_((ClientData clientData)); * * Side effects: * See the user documentation. These procedures are just wrappers; - * they call ButtonCreate to do all of the real work. + * they call CreateFrame to do all of the real work. * *-------------------------------------------------------------- */ int Tk_FrameObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window associated with - * interpreter. */ + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - return CreateFrame(clientData, interp, objc, objv, 0, (char *) NULL); + return CreateFrame(clientData, interp, objc, objv, TYPE_FRAME, + (char *) NULL); } int Tk_ToplevelObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window associated with - * interpreter. */ + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - return CreateFrame(clientData, interp, objc, objv, 1, (char *) NULL); + return CreateFrame(clientData, interp, objc, objv, TYPE_TOPLEVEL, + (char *) NULL); } /* @@ -228,10 +264,10 @@ Tk_ToplevelObjCmd(clientData, interp, objc, objv) * * TkCreateFrame -- * - * This procedure is invoked to process the "frame" and "toplevel" - * Tcl commands; it is also invoked directly by Tk_Init to create - * a new main window. See the user documentation for the "frame" - * and "toplevel" commands for details on what it does. + * This procedure is the old command procedure for the "frame" + * and "toplevel" commands. Now it is used directly by Tk_Init to + * create a new main window. See the user documentation for the + * "frame" and "toplevel" commands for details on what it does. * * Results: * A standard Tcl result. @@ -244,16 +280,15 @@ Tk_ToplevelObjCmd(clientData, interp, objc, objv) int TkCreateFrame(clientData, interp, argc, argv, toplevel, appName) - ClientData clientData; /* Main window associated with interpreter. - * If we're called by Tk_Init to create a - * new application, then this is NULL. */ + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ int toplevel; /* Non-zero means create a toplevel window, * zero means create a frame. */ - char *appName; /* Should only be non-NULL if clientData is - * NULL: gives the base name to use for the + char *appName; /* Should only be non-NULL if there is no main + * window associated with the interpreter. + * Gives the base name to use for the * new application. */ { int result, i; @@ -263,7 +298,8 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName) Tcl_IncrRefCount(objv[i]); } objv[argc] = NULL; - result = CreateFrame(clientData, interp, argc, objv, toplevel, appName); + result = CreateFrame(clientData, interp, argc, objv, + toplevel ? TYPE_TOPLEVEL : TYPE_FRAME, appName); for (i=0; i<argc; i++) { Tcl_DecrRefCount(objv[i]); } @@ -272,21 +308,20 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName) } static int -CreateFrame(clientData, interp, objc, objv, toplevel, appName) - ClientData clientData; /* Main window associated with interpreter. - * If we're called by Tk_Init to create a - * new application, then this is NULL. */ +CreateFrame(clientData, interp, objc, objv, type, appName) + ClientData clientData; /* Either NULL or pointer to option table. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ - int toplevel; /* Non-zero means create a toplevel window, - * zero means create a frame. */ - char *appName; /* Should only be non-NULL if clientData is - * NULL: gives the base name to use for the + enum FrameType type; /* What widget type to create. */ + char *appName; /* Should only be non-NULL if there are no + * Main window associated with the interpreter. + * Gives the base name to use for the * new application. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin; Frame *framePtr; + Tk_OptionTable optionTable; Tk_Window new; char *className, *screenName, *visualName, *colormapName, *arg, *useOption; int i, c, depth; @@ -295,6 +330,25 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) Colormap colormap; Visual *visual; + 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[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; @@ -321,10 +375,10 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) } else if ((c == 'c') && (strncmp(arg, "-colormap", length) == 0)) { colormapName = Tcl_GetString(objv[i+1]); - } else if ((c == 's') && toplevel + } else if ((c == 's') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-screen", length) == 0)) { screenName = Tcl_GetString(objv[i+1]); - } else if ((c == 'u') && toplevel + } else if ((c == 'u') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-use", length) == 0)) { useOption = Tcl_GetString(objv[i+1]); } else if ((c == 'v') @@ -349,8 +403,16 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) */ if (screenName == NULL) { - screenName = (toplevel) ? "" : NULL; + screenName = (type == TYPE_TOPLEVEL) ? "" : NULL; } + + /* + * Main window associated with interpreter. + * If we're called by Tk_Init to create a + * new application, then this is NULL. + */ + + tkwin = Tk_MainWindow(interp); if (tkwin != NULL) { new = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]), screenName); @@ -370,7 +432,7 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) if (className == NULL) { className = Tk_GetOption(new, "class", "Class"); if (className == NULL) { - className = (toplevel) ? "Toplevel" : "Frame"; + className = classNames[type]; } } Tk_SetClass(new, className); @@ -410,7 +472,7 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) * doesn't request a size for itself. */ - if (toplevel) { + if (type == TYPE_TOPLEVEL) { Tk_GeometryRequest(new, 200, 200); } @@ -427,11 +489,13 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) framePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(new), FrameWidgetObjCmd, (ClientData) framePtr, FrameCmdDeletedProc); + framePtr->optionTable = optionTable; framePtr->className = NULL; - framePtr->mask = (toplevel) ? TOPLEVEL : FRAME; + framePtr->type = type; framePtr->screenName = NULL; framePtr->visualName = NULL; framePtr->colormapName = NULL; + framePtr->menuName = NULL; framePtr->colormap = colormap; framePtr->border = NULL; framePtr->borderWidth = 0; @@ -446,7 +510,6 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) framePtr->isContainer = 0; framePtr->useThis = NULL; framePtr->flags = 0; - framePtr->menuName = NULL; /* * Store backreference to frame widget in window structure. @@ -454,23 +517,25 @@ CreateFrame(clientData, interp, objc, objv, toplevel, appName) Tk_SetClassProcs(new, NULL, (ClientData) framePtr); mask = ExposureMask | StructureNotifyMask | FocusChangeMask; - if (toplevel) { + if (type == TYPE_TOPLEVEL) { mask |= ActivateMask; } Tk_CreateEventHandler(new, mask, FrameEventProc, (ClientData) framePtr); - if (ConfigureFrame(interp, framePtr, objc-2, objv+2, 0) != TCL_OK) { + if ((Tk_InitOptions(interp, (char *) framePtr, optionTable, new) + != TCL_OK) || + (ConfigureFrame(interp, framePtr, objc-2, objv+2) != TCL_OK)) { goto error; } if ((framePtr->isContainer)) { if (framePtr->useThis == NULL) { TkpMakeContainer(framePtr->tkwin); } else { - Tcl_AppendResult(interp,"A window cannot have both the -use ", - "and the -container option set."); + Tcl_AppendResult(interp, "A window cannot have both the -use ", + "and the -container option set.", (char *) NULL); return TCL_ERROR; } } - if (toplevel) { + if (type == TYPE_TOPLEVEL) { Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr); } Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC); @@ -518,6 +583,7 @@ FrameWidgetObjCmd(clientData, interp, objc, objv) int result = TCL_OK, index; size_t length; int c, i; + Tcl_Obj *objPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); @@ -535,17 +601,28 @@ FrameWidgetObjCmd(clientData, interp, objc, objv) result = TCL_ERROR; goto done; } - result = Tk_ConfigureValue(interp, framePtr->tkwin, configSpecs, - (char *) framePtr, Tcl_GetString(objv[2]), framePtr->mask); + objPtr = Tk_GetOptionValue(interp, (char *) framePtr, + framePtr->optionTable, objv[2], framePtr->tkwin); + if (objPtr == NULL) { + result = TCL_ERROR; + goto done; + } else { + Tcl_SetObjResult(interp, objPtr); + } break; } case FRAME_CONFIGURE: { - if (objc == 2) { - result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs, - (char *) framePtr, (char *) NULL, framePtr->mask); - } else if (objc == 3) { - result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs, - (char *) framePtr, Tcl_GetString(objv[2]), framePtr->mask); + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) framePtr, + framePtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + framePtr->tkwin); + if (objPtr == NULL) { + result = TCL_ERROR; + goto done; + } else { + Tcl_SetObjResult(interp, objPtr); + } } else { /* * Don't allow the options -class, -colormap, -container, @@ -560,17 +637,17 @@ FrameWidgetObjCmd(clientData, interp, objc, objv) c = arg[1]; if (((c == 'c') && (strncmp(arg, "-class", length) == 0) && (length >= 2)) - || ((c == 'c') && (framePtr->mask == TOPLEVEL) + || ((c == 'c') && (framePtr->type == TYPE_TOPLEVEL) && (strncmp(arg, "-colormap", length) == 0) && (length >= 3)) || ((c == 'c') && (strncmp(arg, "-container", length) == 0) && (length >= 3)) - || ((c == 's') && (framePtr->mask == TOPLEVEL) + || ((c == 's') && (framePtr->type == TYPE_TOPLEVEL) && (strncmp(arg, "-screen", length) == 0)) - || ((c == 'u') && (framePtr->mask == TOPLEVEL) + || ((c == 'u') && (framePtr->type == TYPE_TOPLEVEL) && (strncmp(arg, "-use", length) == 0)) - || ((c == 'v') && (framePtr->mask == TOPLEVEL) + || ((c == 'v') && (framePtr->type == TYPE_TOPLEVEL) && (strncmp(arg, "-visual", length) == 0))) { Tcl_AppendResult(interp, "can't modify ", arg, " option after widget is created", (char *) NULL); @@ -578,8 +655,7 @@ FrameWidgetObjCmd(clientData, interp, objc, objv) goto done; } } - result = ConfigureFrame(interp, framePtr, objc-2, objv+2, - TK_CONFIG_ARGV_ONLY); + result = ConfigureFrame(interp, framePtr, objc-2, objv+2); } break; } @@ -614,8 +690,6 @@ DestroyFrame(memPtr) { register Frame *framePtr = (Frame *) memPtr; - Tk_FreeOptions(configSpecs, (char *) framePtr, framePtr->display, - framePtr->mask); if (framePtr->colormap != None) { Tk_FreeColormap(framePtr->display, framePtr->colormap); } @@ -644,16 +718,16 @@ DestroyFrame(memPtr) */ static int -ConfigureFrame(interp, framePtr, objc, objv, flags) +ConfigureFrame(interp, framePtr, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ register Frame *framePtr; /* Information about widget; may or may * not already have values for some fields. */ int objc; /* Number of valid entries in objv. */ Tcl_Obj *CONST objv[]; /* Arguments. */ - int flags; /* Flags to pass to Tk_ConfigureWidget. */ { + Tk_SavedOptions savedOptions; char *oldMenuName; - + /* * Need the old menubar name for the menu code to delete it. */ @@ -665,12 +739,21 @@ ConfigureFrame(interp, framePtr, objc, objv, flags) strcpy(oldMenuName, framePtr->menuName); } - if (Tk_ConfigureWidget(interp, framePtr->tkwin, configSpecs, - objc, (char **) objv, (char *) framePtr, - flags | framePtr->mask | TK_CONFIG_OBJS) != TCL_OK) { + if (Tk_SetOptions(interp, (char *) framePtr, + framePtr->optionTable, objc, objv, + framePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { + if (oldMenuName != NULL) { + ckfree(oldMenuName); + } return TCL_ERROR; + } else { + Tk_FreeSavedOptions(&savedOptions); } + /* + * A few of the options require additional processing. + */ + if (((oldMenuName == NULL) && (framePtr->menuName != NULL)) || ((oldMenuName != NULL) && (framePtr->menuName == NULL)) || ((oldMenuName != NULL) && (framePtr->menuName != NULL) @@ -678,7 +761,11 @@ ConfigureFrame(interp, framePtr, objc, objv, flags) TkSetWindowMenuBar(interp, framePtr->tkwin, oldMenuName, framePtr->menuName); } - + + if (oldMenuName != NULL) { + ckfree(oldMenuName); + } + if (framePtr->border != NULL) { Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border); } else { @@ -695,10 +782,6 @@ ConfigureFrame(interp, framePtr, objc, objv, flags) framePtr->height); } - if (oldMenuName != NULL) { - ckfree(oldMenuName); - } - if (Tk_IsMapped(framePtr->tkwin)) { if (!(framePtr->flags & REDRAW_PENDING)) { Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr); @@ -812,7 +895,15 @@ FrameEventProc(clientData, eventPtr) * could be gone by then. To do so, delete the event handler * explicitly (normally it's done implicitly by Tk_DestroyWindow). */ - + + /* + * Since the tkwin pointer will be gone when we reach + * DestroyFrame, we must free all options now. + */ + + Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable, + framePtr->tkwin); + Tk_DeleteEventHandler(framePtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, FrameEventProc, (ClientData) framePtr); @@ -891,6 +982,14 @@ FrameCmdDeletedProc(clientData) */ if (tkwin != NULL) { + /* + * Some options need tkwin to be freed, so we free them here, + * before setting tkwin to NULL. + */ + + Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable, + framePtr->tkwin); + framePtr->tkwin = NULL; Tk_DestroyWindow(tkwin); } diff --git a/generic/tkImage.c b/generic/tkImage.c index f8d5388..cbe982f 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.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: tkImage.c,v 1.10 2000/11/29 15:47:05 dkf Exp $ + * RCS: @(#) $Id: tkImage.c,v 1.10.2.1 2001/07/03 20:01:08 dgp Exp $ */ #include "tkInt.h" @@ -69,7 +69,9 @@ typedef struct ImageMaster { * entry). */ Image *instancePtr; /* Pointer to first in list of instances * derived from this name. */ - int deleted; /* Flag set when image is being deleted */ + int deleted; /* Flag set when image is being deleted. */ + TkWindow *winPtr; /* Main window of interpreter (used to + * detect when the world is falling apart.) */ } ImageMaster; typedef struct ThreadSpecificData { @@ -254,6 +256,7 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) masterPtr->hPtr = hPtr; masterPtr->instancePtr = NULL; masterPtr->deleted = 0; + masterPtr->winPtr = winPtr->mainPtr->winPtr; Tcl_SetHashValue(hPtr, masterPtr); } else { /* @@ -293,18 +296,18 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) } args[objc] = NULL; } - Tcl_Preserve(masterPtr); + Tcl_Preserve((ClientData) masterPtr); if ((*typePtr->createProc)(interp, name, objc, args, typePtr, (Tk_ImageMaster) masterPtr, &masterPtr->masterData) != TCL_OK) { EventuallyDeleteImage(masterPtr); - Tcl_Release(masterPtr); + Tcl_Release((ClientData) masterPtr); if (oldimage) { ckfree((char *) args); } return TCL_ERROR; } - Tcl_Release(masterPtr); + Tcl_Release((ClientData) masterPtr); if (oldimage) { ckfree((char *) args); } @@ -908,7 +911,9 @@ DeleteImage(masterPtr) (*typePtr->deleteProc)(masterPtr->masterData); } if (masterPtr->instancePtr == NULL) { - Tcl_DeleteHashEntry(masterPtr->hPtr); + if ((masterPtr->winPtr->flags & TK_ALREADY_DEAD) == 0) { + Tcl_DeleteHashEntry(masterPtr->hPtr); + } ckfree((char *) masterPtr); } } @@ -937,7 +942,8 @@ EventuallyDeleteImage(masterPtr) { if (!masterPtr->deleted) { masterPtr->deleted = 1; - Tcl_EventuallyFree(masterPtr, (Tcl_FreeProc *)DeleteImage); + Tcl_EventuallyFree((ClientData) masterPtr, + (Tcl_FreeProc *)DeleteImage); } } diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 3ab6753..1482838 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -29,7 +29,7 @@ * | provided "as is" without express or implied warranty. | * +-------------------------------------------------------------------+ * - * RCS: @(#) $Id: tkImgGIF.c,v 1.16 2000/07/05 23:30:06 ericm Exp $ + * RCS: @(#) $Id: tkImgGIF.c,v 1.16.4.1 2001/07/03 20:01:08 dgp Exp $ */ /* @@ -1083,6 +1083,7 @@ mInit(string, handle) { handle->data = string; handle->state = 0; + handle->c = 0; } /* @@ -1160,7 +1161,7 @@ Mgetc(handle) if (c>GIF_SPECIAL) { handle->state = GIF_DONE; - return(handle->state ? handle->c : GIF_DONE); + return handle->c; } switch (handle->state++) { diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 42647eb..c7a1d68 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -15,7 +15,7 @@ * Department of Computer Science, * Australian National University. * - * RCS: @(#) $Id: tkImgPhoto.c,v 1.22 2000/11/21 16:18:05 dkf Exp $ + * RCS: @(#) $Id: tkImgPhoto.c,v 1.22.2.1 2001/07/03 20:01:08 dgp Exp $ */ #include "tkInt.h" @@ -963,7 +963,7 @@ ImgPhotoCmd(clientData, interp, objc, objv) } if ((*imageFormat->stringReadProc)(interp, data, format, (Tk_PhotoHandle) masterPtr, - 0, 0, imageWidth, imageHeight, options.toX, options.toY) + options.toX, options.toY, imageWidth, imageHeight, 0, 0) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tkInt.h b/generic/tkInt.h index bd7764f..3dc9cef 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.34 2000/11/22 01:49:38 ericm Exp $ + * RCS: $Id: tkInt.h,v 1.34.2.1 2001/07/03 20:01:08 dgp Exp $ */ #ifndef _TKINT @@ -369,6 +369,7 @@ typedef struct TkDisplay { Atom applicationAtom; /* Atom for TK_APPLICATION. */ Atom windowAtom; /* Atom for TK_WINDOW. */ Atom clipboardAtom; /* Atom for CLIPBOARD. */ + Atom utf8Atom; /* Atom for UTF8_STRING. */ Tk_Window clipWindow; /* Window used for clipboard ownership and to * retrieve selections between processes. NULL diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 25e8563..6efca45 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.19 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkListbox.c,v 1.19.2.1 2001/07/03 20:01:08 dgp Exp $ */ #include "tkPort.h" @@ -574,6 +574,13 @@ Tk_ListboxObjCmd(clientData, interp, objc, objv) listPtr->gray = None; listPtr->flags = 0; + /* + * Keep a hold of the associated tkwin until we destroy the listbox, + * otherwise Tk might free it while we still need it. + */ + + Tcl_Preserve((ClientData) listPtr->tkwin); + Tk_SetClass(listPtr->tkwin, "Listbox"); Tk_SetClassProcs(listPtr->tkwin, &listboxClass, (ClientData) listPtr); Tk_CreateEventHandler(listPtr->tkwin, @@ -629,7 +636,6 @@ ListboxWidgetObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } - Tcl_Preserve((ClientData)listPtr); /* * Parse the command by looking up the second argument in the list @@ -638,10 +644,10 @@ ListboxWidgetObjCmd(clientData, interp, objc, objv) result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, "option", 0, &cmdIndex); if (result != TCL_OK) { - Tcl_Release((ClientData)listPtr); return result; } + Tcl_Preserve((ClientData)listPtr); /* The subcommand was valid, so continue processing */ switch (cmdIndex) { case COMMAND_ACTIVATE: { @@ -1456,16 +1462,6 @@ DestroyListbox(memPtr) Tcl_HashEntry *entry; Tcl_HashSearch search; - listPtr->flags |= LISTBOX_DELETED; - - Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd); - if (listPtr->setGrid) { - Tk_UnsetGrid(listPtr->tkwin); - } - if (listPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayListbox, (ClientData) listPtr); - } - /* If we have an internal list object, free it */ if (listPtr->listObj != NULL) { Tcl_DecrRefCount(listPtr->listObj); @@ -1508,6 +1504,7 @@ DestroyListbox(memPtr) Tk_FreeConfigOptions((char *)listPtr, listPtr->optionTable, listPtr->tkwin); + Tcl_Release((ClientData) listPtr->tkwin); listPtr->tkwin = NULL; ckfree((char *) listPtr); } @@ -1834,6 +1831,9 @@ DisplayListbox(clientData) Pixmap pixmap; listPtr->flags &= ~REDRAW_PENDING; + if (listPtr->flags & LISTBOX_DELETED) { + return; + } if (listPtr->flags & MAXWIDTH_IS_STALE) { ListboxComputeGeometry(listPtr, 0, 1, 0); @@ -1841,16 +1841,23 @@ DisplayListbox(clientData) listPtr->flags |= UPDATE_H_SCROLLBAR; } + Tcl_Preserve((ClientData) listPtr); if (listPtr->flags & UPDATE_V_SCROLLBAR) { ListboxUpdateVScrollbar(listPtr); + if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) { + Tcl_Release((ClientData) listPtr); + return; + } } if (listPtr->flags & UPDATE_H_SCROLLBAR) { ListboxUpdateHScrollbar(listPtr); + if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) { + Tcl_Release((ClientData) listPtr); + return; + } } listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR); - if ((listPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { - return; - } + Tcl_Release((ClientData) listPtr); /* * Redrawing is done in a temporary pixmap that is allocated @@ -2453,7 +2460,17 @@ ListboxEventProc(clientData, eventPtr) NearestListboxElement(listPtr, eventPtr->xexpose.y + eventPtr->xexpose.height)); } else if (eventPtr->type == DestroyNotify) { - DestroyListbox((char *) clientData); + if (!(listPtr->flags & LISTBOX_DELETED)) { + listPtr->flags |= LISTBOX_DELETED; + Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd); + if (listPtr->setGrid) { + Tk_UnsetGrid(listPtr->tkwin); + } + if (listPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayListbox, clientData); + } + Tcl_EventuallyFree(clientData, DestroyListbox); + } } else if (eventPtr->type == ConfigureNotify) { int vertSpace; @@ -3067,7 +3084,7 @@ EventuallyRedrawRange(listPtr, first, last) /* We don't have to register a redraw callback if one is already pending, * or if the window doesn't exist, or if the window isn't mapped */ if ((listPtr->flags & REDRAW_PENDING) - || (listPtr->tkwin == NULL) + || (listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(listPtr->tkwin)) { return; } diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 4f510ad..73db464 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.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: tkMenu.c,v 1.9.2.1 2001/02/28 23:29:55 dgp Exp $ + * RCS: @(#) $Id: tkMenu.c,v 1.9.2.2 2001/07/03 20:01:08 dgp Exp $ */ /* @@ -1106,7 +1106,13 @@ TkInvokeMenu(interp, menuPtr, index) } Tcl_DecrRefCount(valuePtr); } - if ((result == TCL_OK) && (mePtr->commandPtr != NULL)) { + /* + * We check numEntries in addition to whether the menu entry + * has a command because that goes to zero if the menu gets + * deleted (e.g., during command evaluation). + */ + if ((menuPtr->numEntries != 0) && (result == TCL_OK) + && (mePtr->commandPtr != NULL)) { Tcl_Obj *commandPtr = mePtr->commandPtr; Tcl_IncrRefCount(commandPtr); @@ -1115,7 +1121,7 @@ TkInvokeMenu(interp, menuPtr, index) } Tcl_Release((ClientData) mePtr); done: - return result; + return result; } /* @@ -1263,14 +1269,14 @@ TkDestroyMenu(menuPtr) if (menuPtr->menuFlags & MENU_DELETION_PENDING) { return; } - + /* * Now destroy all non-tearoff instances of this menu if this is a * parent menu. Is this loop safe enough? Are there going to be * destroy bindings on child menus which kill the parent? If not, * we have to do a slightly more complex scheme. */ - + if (menuPtr->masterMenuPtr == menuPtr) { menuPtr->menuFlags |= MENU_DELETION_PENDING; while (menuPtr->nextInstancePtr != NULL) { @@ -1287,13 +1293,13 @@ TkDestroyMenu(menuPtr) * If any toplevel widgets have this menu as their menubar, * the geometry of the window may have to be recalculated. */ - + topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr; while (topLevelListPtr != NULL) { nextTopLevelPtr = topLevelListPtr->nextPtr; TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL); topLevelListPtr = nextTopLevelPtr; - } + } DestroyMenuInstance(menuPtr); } diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index bfe43d3..eaf3c75 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.5 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkMenubutton.c,v 1.5.2.1 2001/07/03 20:01:08 dgp Exp $ */ #include "tkMenubutton.h" @@ -37,6 +37,15 @@ static char *stateStrings[] = { }; /* + * The following table defines the legal values for the -compound option. + * It is used with the "enum compound" declaration in tkButton.h + */ + +static char *compoundStrings[] = { + "bottom", "center", "left", "none", "right", "top", (char *) NULL +}; + +/* * Information used for parsing configuration specs: */ @@ -113,6 +122,9 @@ static Tk_OptionSpec optionSpecs[] = { {TK_OPTION_RELIEF, "-relief", "relief", "Relief", DEF_MENUBUTTON_RELIEF, -1, Tk_Offset(TkMenuButton, relief), 0, 0, 0}, + {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", + DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkMenuButton, compound), 0, + (ClientData) compoundStrings, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_MENUBUTTON_STATE, -1, Tk_Offset(TkMenuButton, state), 0, (ClientData) stateStrings, 0}, diff --git a/generic/tkMenubutton.h b/generic/tkMenubutton.h index 979f23d..b1cce60 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.6 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkMenubutton.h,v 1.6.2.1 2001/07/03 20:01:08 dgp Exp $ */ #ifndef _TKMENUBUTTON @@ -25,6 +25,15 @@ #endif /* + * Legal values for the "compound" field of TkButton records. + */ + +enum compound { + COMPOUND_BOTTOM, COMPOUND_CENTER, COMPOUND_LEFT, COMPOUND_NONE, + COMPOUND_RIGHT, COMPOUND_TOP +}; + +/* * Legal values for the "orient" field of TkMenubutton records. */ @@ -162,6 +171,10 @@ typedef struct { * Miscellaneous information: */ + int compound; /* Value of -compound option; specifies whether + * the button should show both an image and + * text, and, if so, how. */ + enum direction direction; /* Direction for where to pop the menu. * Valid directions are "above", "below", * "left", "right", and "flush". "flush" diff --git a/generic/tkObj.c b/generic/tkObj.c index e27bd4f..9f09725 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.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: tkObj.c,v 1.3 2000/12/13 19:44:15 hobbs Exp $ + * RCS: @(#) $Id: tkObj.c,v 1.3.2.1 2001/07/03 20:01:08 dgp Exp $ */ #include "tkInt.h" @@ -64,6 +64,7 @@ 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 void UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr)); static int SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp, @@ -95,7 +96,7 @@ static Tcl_ObjType mmObjType = { "mm", /* name */ FreeMMInternalRep, /* freeIntRepProc */ DupMMInternalRep, /* dupIntRepProc */ - NULL, /* updateStringProc */ + UpdateStringOfMM, /* updateStringProc */ SetMMFromAny /* setFromAnyProc */ }; @@ -473,6 +474,48 @@ DupMMInternalRep(srcPtr, copyPtr) /* *---------------------------------------------------------------------- * + * UpdateStringOfMM -- + * + * Update the string representation for a pixel Tcl_Obj + * this function is only called, if the pixel Tcl_Obj has no unit, + * because with units the string representation is created by + * SetMMFromAny + * + * Results: + * None. + * + * Side effects: + * The object's string is set to a valid string that results from + * the double-to-string conversion. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateStringOfMM(objPtr) + register Tcl_Obj *objPtr; /* pixel obj with string rep to update. */ +{ + MMRep *mmPtr; + char buffer[TCL_DOUBLE_SPACE]; + register int len; + + mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; + /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */ + if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) { + panic("UpdateStringOfMM: false precondition"); + } + + Tcl_PrintDouble((Tcl_Interp *) NULL, mmPtr->value, buffer); + len = strlen(buffer); + + objPtr->bytes = (char *) ckalloc((unsigned) len + 1); + strcpy(objPtr->bytes, buffer); + objPtr->length = len; +} + +/* + *---------------------------------------------------------------------- + * * SetMMFromAny -- * * Attempt to generate a mm internal form for the Tcl object @@ -501,11 +544,38 @@ SetMMFromAny(interp, objPtr) int units; MMRep *mmPtr; - if (objPtr->typePtr == &tclDoubleType) { - /* optimize for speed reasons */ + static Tcl_ObjType *tclDoubleObjType = NULL; + static Tcl_ObjType *tclIntObjType = NULL; + + if (tclDoubleObjType == NULL) { + /* + * Cache the object types for comaprison below. + * This allows optimized checks for standard cases. + */ + + tclDoubleObjType = Tcl_GetObjType("double"); + tclIntObjType = Tcl_GetObjType("int"); + } + + if (objPtr->typePtr == tclDoubleObjType) { Tcl_GetDoubleFromObj(interp, objPtr, &d); units = -1; + } else if (objPtr->typePtr == tclIntObjType) { + Tcl_GetIntFromObj(interp, objPtr, &units); + d = (double) units; + units = -1; + + /* + * In the case of ints, we need to ensure that a valid + * string exists in order for int-but-not-string objects + * to be converted back to ints again from mm obj types. + */ + (void) Tcl_GetStringFromObj(objPtr, NULL); } else { + /* + * It wasn't a known int or double, so parse it. + */ + string = Tcl_GetStringFromObj(objPtr, NULL); d = strtod(string, &rest); diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index 95634c5..2defff2 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.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: tkRectOval.c,v 1.7 2000/04/19 22:20:45 ericm Exp $ + * RCS: @(#) $Id: tkRectOval.c,v 1.7.6.1 2001/07/03 20:01:09 dgp Exp $ */ #include <stdio.h> @@ -142,11 +142,11 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputeRectOvalBbox _ANSI_ARGS_((Tk_Canvas canvas, RectOvalItem *rectOvalPtr)); static int ConfigureRectOval _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags)); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[], int flags)); static int CreateRectOval _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[])); + int objc, Tcl_Obj *CONST objv[])); static void DeleteRectOval _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); static void DisplayRectOval _ANSI_ARGS_((Tk_Canvas canvas, @@ -157,8 +157,8 @@ static int OvalToArea _ANSI_ARGS_((Tk_Canvas canvas, static double OvalToPoint _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double *pointPtr)); static int RectOvalCoords _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[])); + Tk_Canvas canvas, Tk_Item *itemPtr, int objc, + Tcl_Obj *CONST objv[])); static int RectOvalToPostscript _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); static int RectToArea _ANSI_ARGS_((Tk_Canvas canvas, @@ -243,31 +243,28 @@ Tk_ItemType tkOvalType = { */ static int -CreateRectOval(interp, canvas, itemPtr, argc, argv) +CreateRectOval(interp, canvas, itemPtr, objc, objv) Tcl_Interp *interp; /* 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. */ - Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */ + int objc; /* Number of arguments in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing rectangle. */ { RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; - int i; + int i = 4; - if (argc==1) { + if (objc == 1) { i = 1; - } else { - char *arg = Tcl_GetStringFromObj(argv[1], NULL); - if ((argc>1) && (arg[0] == '-') - && (arg[1] >= 'a') && (arg[1] <= 'z')) { + } else if (objc > 1) { + char *arg = Tcl_GetString(objv[1]); + if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; - } else { - i = 4; } } - if (argc < i) { + if (objc < i) { Tcl_AppendResult(interp, "wrong # args: should be \"", Tk_PathName(Tk_CanvasTkwin(canvas)), " create ", itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"", @@ -296,10 +293,10 @@ CreateRectOval(interp, canvas, itemPtr, argc, argv) * Process the arguments to fill in the item record. */ - if ((RectOvalCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) { + if ((RectOvalCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) { goto error; } - if (ConfigureRectOval(interp, canvas, itemPtr, argc-i, argv+i, 0) + if (ConfigureRectOval(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) { return TCL_OK; } @@ -328,19 +325,19 @@ CreateRectOval(interp, canvas, itemPtr, argc, argv) */ static int -RectOvalCoords(interp, canvas, itemPtr, argc, argv) +RectOvalCoords(interp, canvas, itemPtr, objc, objv) 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. */ - Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1, + int objc; /* Number of coordinates supplied in + * objv. */ + Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, * x2, y2, ... */ { RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; - if (argc == 0) { + if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); Tcl_Obj *subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]); Tcl_ListObjAppendElement(interp, obj, subobj); @@ -351,26 +348,26 @@ RectOvalCoords(interp, canvas, itemPtr, argc, argv) subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } else if ((argc == 1)||(argc == 4)) { - if (argc==1) { - if (Tcl_ListObjGetElements(interp, argv[0], &argc, - (Tcl_Obj ***) &argv) != TCL_OK) { + } else if ((objc == 1)||(objc == 4)) { + if (objc==1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; - } else if (argc != 4) { + } else if (objc != 4) { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &rectOvalPtr->bbox[0]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &rectOvalPtr->bbox[1]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[2], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2], &rectOvalPtr->bbox[2]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[3], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3], &rectOvalPtr->bbox[3]) != TCL_OK)) { return TCL_ERROR; } @@ -378,7 +375,7 @@ RectOvalCoords(interp, canvas, itemPtr, argc, argv) } else { char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc); + sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } @@ -406,12 +403,12 @@ RectOvalCoords(interp, canvas, itemPtr, argc, argv) */ static int -ConfigureRectOval(interp, canvas, itemPtr, argc, argv, flags) +ConfigureRectOval(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */ - int argc; /* Number of elements in argv. */ - Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */ + int objc; /* Number of elements in objv. */ + Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; @@ -426,7 +423,7 @@ ConfigureRectOval(interp, canvas, itemPtr, argc, argv, flags) tkwin = Tk_CanvasTkwin(canvas); - if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv, + if (Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, (char **) objv, (char *) rectOvalPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tkSelect.c b/generic/tkSelect.c index 951c5c7..e6e446c 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.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: tkSelect.c,v 1.6 2000/08/07 21:49:16 ericm Exp $ + * RCS: @(#) $Id: tkSelect.c,v 1.6.4.1 2001/07/03 20:01:09 dgp Exp $ */ #include "tkInt.h" @@ -177,6 +177,48 @@ Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format) } else { selPtr->size = 32; } + + if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) { + /* + * If the user asked for a STRING handler and we understand + * UTF8_STRING, we implicitly create a UTF8_STRING handler for them. + */ + + target = winPtr->dispPtr->utf8Atom; + for (selPtr = winPtr->selHandlerList; ; + selPtr = selPtr->nextPtr) { + if (selPtr == NULL) { + selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler)); + selPtr->nextPtr = winPtr->selHandlerList; + winPtr->selHandlerList = selPtr; + selPtr->selection = selection; + selPtr->target = target; + selPtr->format = target; /* We want UTF8_STRING format */ + selPtr->proc = proc; + if (selPtr->proc == HandleTclCommand) { + /* + * The clientData is selection controlled memory, so + * we should make a copy for this selPtr. + */ + selPtr->clientData = + (ClientData) ckalloc(sizeof(clientData)); + memcpy(selPtr->clientData, clientData, sizeof(clientData)); + } else { + selPtr->clientData = clientData; + } + selPtr->size = 8; + break; + } + if ((selPtr->selection == selection) + && (selPtr->target == target)) { + /* + * Looks like we had a utf-8 target already. Leave it alone. + */ + + break; + } + } + } } /* @@ -247,6 +289,36 @@ Tk_DeleteSelHandler(tkwin, selection, target) } else { prevPtr->nextPtr = selPtr->nextPtr; } + + if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) { + /* + * If the user asked for a STRING handler and we understand + * UTF8_STRING, we may have implicitly created a UTF8_STRING handler + * for them. Look for it and delete it as necessary. + */ + TkSelHandler *utf8selPtr; + + target = winPtr->dispPtr->utf8Atom; + for (utf8selPtr = winPtr->selHandlerList; utf8selPtr != NULL; + utf8selPtr = utf8selPtr->nextPtr) { + if ((utf8selPtr->selection == selection) + && (utf8selPtr->target == target)) { + break; + } + } + if (utf8selPtr != NULL) { + if ((utf8selPtr->format == target) + && (utf8selPtr->proc == selPtr->proc) + && (utf8selPtr->size == selPtr->size)) { + /* + * This recursive call is OK, because we've + * changed the value of 'target' + */ + Tk_DeleteSelHandler(tkwin, selection, target); + } + } + } + if (selPtr->proc == HandleTclCommand) { /* * Mark the CommandInfo as deleted and free it if we can. @@ -524,8 +596,8 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData) TkSelInProgress ip; for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList; - selPtr != NULL; selPtr = selPtr->nextPtr) { - if ((selPtr->target == target) + selPtr != NULL; selPtr = selPtr->nextPtr) { + if ((selPtr->target == target) && (selPtr->selection == selection)) { break; } @@ -851,10 +923,9 @@ Tk_SelectionObjCmd(clientData, interp, objc, objv) register LostCommand *lostPtr; char *script = NULL; int cmdLength; - static char *ownOptionStrings[] = { "-command", - "-displayof", - "-selection", - (char *) NULL }; + static char *ownOptionStrings[] = { + "-command", "-displayof", "-selection", (char *) NULL + }; enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION }; int ownIndex; @@ -1047,7 +1118,7 @@ TkSelDeadWindow(winPtr) } if (selPtr->proc == HandleTclCommand) { /* - * Mark the CommandInfo as deleted and free it if we can. + * Mark the CommandInfo as deleted and free it when we can. */ ((CommandInfo*)selPtr->clientData)->interp = NULL; @@ -1106,15 +1177,29 @@ TkSelInit(tkwin) * Fetch commonly-used atoms. */ - dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE"); - dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR"); - dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS"); - dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP"); - dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT"); - dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); - dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION"); - dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW"); - dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD"); + dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE"); + dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR"); + dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS"); + dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP"); + dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT"); + dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT"); + dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION"); + dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW"); + dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD"); + + /* + * Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us + * to support older X servers that didn't have UTF8_STRING yet. + * This is necessary on Unix systems. + * For more information, see: + * http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11 + */ + +#if !defined(__WIN32__) && !defined(MAC_TCL) + dispPtr->utf8Atom = Tk_InternAtom(tkwin, "UTF8_STRING"); +#else + dispPtr->utf8Atom = (Atom) NULL; +#endif } /* diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c index 32ba177..7af6a0a 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.5 1999/05/25 01:31:06 stanton Exp $ + * RCS: @(#) $Id: tkStubLib.c,v 1.5.14.1 2001/07/03 20:01:09 dgp Exp $ */ /* @@ -95,13 +95,13 @@ TkIntXlibStubs *tkIntXlibStubsPtr; #undef Tk_InitStubs #endif -char * +CONST char * Tk_InitStubs(interp, version, exact) Tcl_Interp *interp; char *version; int exact; { - char *actualVersion; + CONST char *actualVersion; actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, exact, (ClientData *) &tkStubsPtr); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index e6fccf9..0117e0f 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.29 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.29.2.1 2001/07/03 20:01:09 dgp Exp $ */ #include "tkPort.h" @@ -137,7 +137,7 @@ static TkCmd commands[] = { {"canvas", NULL, Tk_CanvasObjCmd, 1, 1}, {"checkbutton", NULL, Tk_CheckbuttonObjCmd, 1, 0}, {"entry", NULL, Tk_EntryObjCmd, 1, 0}, - {"frame", NULL, Tk_FrameObjCmd, 1, 1}, + {"frame", NULL, Tk_FrameObjCmd, 1, 0}, {"label", NULL, Tk_LabelObjCmd, 1, 0}, {"listbox", NULL, Tk_ListboxObjCmd, 1, 0}, {"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0}, @@ -147,7 +147,7 @@ static TkCmd commands[] = { {"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1}, {"spinbox", NULL, Tk_SpinboxObjCmd, 1, 0}, {"text", Tk_TextCmd, NULL, 1, 1}, - {"toplevel", NULL, Tk_ToplevelObjCmd, 0, 1}, + {"toplevel", NULL, Tk_ToplevelObjCmd, 0, 0}, /* * Misc. @@ -1394,12 +1394,12 @@ Tk_DestroyWindow(tkwin) /* * We just deleted the last window in the application. Delete * the TkMainInfo structure too and replace all of Tk's commands - * with dummy commands that return errors. Also delete the + * with dummy commands that return errors. Also delete the * "send" command to unregister the interpreter. - * - * NOTE: Only replace the commands it if the interpreter is - * not being deleted. If it *is*, the interpreter cleanup will - * do all the needed work. + * + * NOTE: Only replace the commands it if the interpreter is + * not being deleted. If it *is*, the interpreter cleanup will + * do all the needed work. */ if ((winPtr->mainPtr->interp != NULL) && @@ -1494,7 +1494,7 @@ Tk_DestroyWindow(tkwin) } } } - ckfree((char *) winPtr); + Tcl_EventuallyFree((ClientData) winPtr, TCL_DYNAMIC); } /* diff --git a/library/bgerror.tcl b/library/bgerror.tcl index fbf2b7e..abf4559 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -9,8 +9,8 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: bgerror.tcl,v 1.13.4.1 2001/02/28 23:29:55 dgp Exp $ -# $Id: bgerror.tcl,v 1.13.4.1 2001/02/28 23:29:55 dgp Exp $ +# RCS: @(#) $Id: bgerror.tcl,v 1.13.4.2 2001/07/03 20:01:09 dgp Exp $ +# $Id: bgerror.tcl,v 1.13.4.2 2001/07/03 20:01:09 dgp Exp $ option add *ErrorDialog.function.text [::msgcat::mc "Save To Log"] \ widgetDefault @@ -172,6 +172,7 @@ proc ::bgerror err { pack $W.text -side left -expand yes -fill both $W.text insert 0.0 "$err\n$info" $W.text mark set insert 0.0 + bind $W.text <ButtonPress-1> { focus %W } $W.text configure -state disabled # 2. Fill the top part with bitmap and message @@ -237,10 +238,10 @@ proc ::bgerror err { set parent [winfo parent .bgerrorDialog] set width [winfo reqwidth .bgerrorDialog] set height [winfo reqheight .bgerrorDialog] - set x [expr ([winfo screenwidth .bgerrorDialog] - $width )/2 - \ - [winfo vrootx $parent]] - set y [expr ([winfo screenheight .bgerrorDialog] - $height)/2 - \ - [winfo vrooty $parent]] + set x [expr {([winfo screenwidth .bgerrorDialog] - $width )/2 - \ + [winfo vrootx $parent]}] + set y [expr {([winfo screenheight .bgerrorDialog] - $height)/2 - \ + [winfo vrooty $parent]}] .bgerrorDialog configure -width $width wm geometry .bgerrorDialog +$x+$y wm deiconify .bgerrorDialog diff --git a/library/clrpick.tcl b/library/clrpick.tcl index b75196f..56cfeb6 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.11.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.11.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -204,7 +204,7 @@ proc ::tk::dialog::color::BuildDialog {w} { set stripsFrame [frame $topFrame.colorStrip] set maxWidth [::msgcat::mcmax Red Green Blue] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set colorList [list \ red [::msgcat::mc "Red"] \ green [::msgcat::mc "Green"] \ @@ -284,7 +284,7 @@ proc ::tk::dialog::color::BuildDialog {w} { # set botFrame [frame $w.bot -relief raised -bd 1] set maxWidth [::msgcat::mcmax OK Cancel] - set maxWidth [expr $maxWidth<8?8:$maxWidth] + set maxWidth [expr {$maxWidth<8?8:$maxWidth}] button $botFrame.ok -text [::msgcat::mc "OK"] \ -width $maxWidth -under 0 \ -command [list tk::dialog::color::OkCmd $w] diff --git a/library/console.tcl b/library/console.tcl index 2283969..9f5c7d9 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.10.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: console.tcl,v 1.10.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. @@ -350,7 +350,7 @@ proc ::tk::ConsoleBind {win} { } } bind $win <Insert> { - catch {tk::ConsoleInsert %W [selection get -displayof %W]} + catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]} break } bind $win <KeyPress> { @@ -397,7 +397,7 @@ proc ::tk::ConsoleBind {win} { } bind $win <<Paste>> { catch { - set clip [selection get -displayof %W -selection CLIPBOARD] + set clip [::tk::GetSelection %W CLIPBOARD] set list [split $clip \n\r] tk::ConsoleInsert %W [lindex $list 0] foreach x [lrange $list 1 end] { diff --git a/library/demos/arrow.tcl b/library/demos/arrow.tcl index 78befc3..27a6fe5 100644 --- a/library/demos/arrow.tcl +++ b/library/demos/arrow.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget that displays a # large line with an arrowhead whose shape can be edited interactively. # -# RCS: @(#) $Id: arrow.tcl,v 1.2 1998/09/14 18:23:26 stanton Exp $ +# RCS: @(#) $Id: arrow.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -33,68 +33,69 @@ proc arrowSetup c { # Create the arrow and outline. $c delete all - eval "$c create line $v(x1) $v(y) $v(x2) $v(y) -width [expr 10*$v(width)] \ - -arrowshape {[expr 10*$v(a)] [expr 10*$v(b)] [expr 10*$v(c)]} \ - -arrow last $v(bigLineStyle)" - set xtip [expr $v(x2)-10*$v(b)] - set deltaY [expr 10*$v(c)+5*$v(width)] - $c create line $v(x2) $v(y) $xtip [expr $v(y)+$deltaY] \ - [expr $v(x2)-10*$v(a)] $v(y) $xtip [expr $v(y)-$deltaY] \ + eval {$c create line $v(x1) $v(y) $v(x2) $v(y) -arrow last \ + -width [expr {10*$v(width)}] -arrowshape [list \ + [expr {10*$v(a)}] [expr {10*$v(b)}] [expr {10*$v(c)}]]} \ + $v(bigLineStyle) + set xtip [expr {$v(x2)-10*$v(b)}] + set deltaY [expr {10*$v(c)+5*$v(width)}] + $c create line $v(x2) $v(y) $xtip [expr {$v(y)+$deltaY}] \ + [expr {$v(x2)-10*$v(a)}] $v(y) $xtip [expr {$v(y)-$deltaY}] \ $v(x2) $v(y) -width 2 -capstyle round -joinstyle round # Create the boxes for reshaping the line and arrowhead. - eval "$c create rect [expr $v(x2)-10*$v(a)-5] [expr $v(y)-5] \ - [expr $v(x2)-10*$v(a)+5] [expr $v(y)+5] $v(boxStyle) \ - -tags {box1 box}" - eval "$c create rect [expr $xtip-5] [expr $v(y)-$deltaY-5] \ - [expr $xtip+5] [expr $v(y)-$deltaY+5] $v(boxStyle) \ - -tags {box2 box}" - eval "$c create rect [expr $v(x1)-5] [expr $v(y)-5*$v(width)-5] \ - [expr $v(x1)+5] [expr $v(y)-5*$v(width)+5] $v(boxStyle) \ - -tags {box3 box}" + eval {$c create rect [expr {$v(x2)-10*$v(a)-5}] [expr {$v(y)-5}] \ + [expr {$v(x2)-10*$v(a)+5}] [expr {$v(y)+5}] \ + -tags {box1 box}} $v(boxStyle) + eval {$c create rect [expr {$xtip-5}] [expr {$v(y)-$deltaY-5}] \ + [expr {$xtip+5}] [expr {$v(y)-$deltaY+5}] \ + -tags {box2 box}} $v(boxStyle) + eval {$c create rect [expr {$v(x1)-5}] [expr {$v(y)-5*$v(width)-5}] \ + [expr {$v(x1)+5}] [expr {$v(y)-5*$v(width)+5}] \ + -tags {box3 box}} $v(boxStyle) if {$cur != ""} { eval $c itemconfigure $cur $v(activeStyle) } # Create three arrows in actual size with the same parameters - $c create line [expr $v(x2)+50] 0 [expr $v(x2)+50] 1000 \ + $c create line [expr {$v(x2)+50}] 0 [expr {$v(x2)+50}] 1000 \ -width 2 - set tmp [expr $v(x2)+100] - $c create line $tmp [expr $v(y)-125] $tmp [expr $v(y)-75] \ + set tmp [expr {$v(x2)+100}] + $c create line $tmp [expr {$v(y)-125}] $tmp [expr {$v(y)-75}] \ -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" - $c create line [expr $tmp-25] $v(y) [expr $tmp+25] $v(y) \ + $c create line [expr {$tmp-25}] $v(y) [expr {$tmp+25}] $v(y) \ -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" - $c create line [expr $tmp-25] [expr $v(y)+75] [expr $tmp+25] \ - [expr $v(y)+125] -width $v(width) \ + $c create line [expr {$tmp-25}] [expr {$v(y)+75}] [expr {$tmp+25}] \ + [expr {$v(y)+125}] -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" # Create a bunch of other arrows and text items showing the # current dimensions. - set tmp [expr $v(x2)+10] - $c create line $tmp [expr $v(y)-5*$v(width)] \ - $tmp [expr $v(y)-$deltaY] \ + set tmp [expr {$v(x2)+10}] + $c create line $tmp [expr {$v(y)-5*$v(width)}] \ + $tmp [expr {$v(y)-$deltaY}] \ -arrow both -arrowshape $v(smallTips) - $c create text [expr $v(x2)+15] [expr $v(y)-$deltaY+5*$v(c)] \ + $c create text [expr {$v(x2)+15}] [expr {$v(y)-$deltaY+5*$v(c)}] \ -text $v(c) -anchor w - set tmp [expr $v(x1)-10] - $c create line $tmp [expr $v(y)-5*$v(width)] \ - $tmp [expr $v(y)+5*$v(width)] \ + set tmp [expr {$v(x1)-10}] + $c create line $tmp [expr {$v(y)-5*$v(width)}] \ + $tmp [expr {$v(y)+5*$v(width)}] \ -arrow both -arrowshape $v(smallTips) - $c create text [expr $v(x1)-15] $v(y) -text $v(width) -anchor e - set tmp [expr $v(y)+5*$v(width)+10*$v(c)+10] - $c create line [expr $v(x2)-10*$v(a)] $tmp $v(x2) $tmp \ + $c create text [expr {$v(x1)-15}] $v(y) -text $v(width) -anchor e + set tmp [expr {$v(y)+5*$v(width)+10*$v(c)+10}] + $c create line [expr {$v(x2)-10*$v(a)}] $tmp $v(x2) $tmp \ -arrow both -arrowshape $v(smallTips) - $c create text [expr $v(x2)-5*$v(a)] [expr $tmp+5] \ + $c create text [expr {$v(x2)-5*$v(a)}] [expr {$tmp+5}] \ -text $v(a) -anchor n - set tmp [expr $tmp+25] - $c create line [expr $v(x2)-10*$v(b)] $tmp $v(x2) $tmp \ + set tmp [expr {$tmp+25}] + $c create line [expr {$v(x2)-10*$v(b)}] $tmp $v(x2) $tmp \ -arrow both -arrowshape $v(smallTips) - $c create text [expr $v(x2)-5*$v(b)] [expr $tmp+5] \ + $c create text [expr {$v(x2)-5*$v(b)}] [expr {$tmp+5}] \ -text $v(b) -anchor n $c create text $v(x1) 310 -text "-width $v(width)" \ @@ -168,7 +169,7 @@ bind $c <Any-ButtonRelease-1> "arrowSetup $c" proc arrowMove1 {c x y} { upvar #0 demo_arrowInfo v - set newA [expr ($v(x2)+5-round([$c canvasx $x]))/10] + set newA [expr {($v(x2)+5-round([$c canvasx $x]))/10}] if {$newA < 0} { set newA 0 } @@ -176,7 +177,7 @@ proc arrowMove1 {c x y} { set newA 25 } if {$newA != $v(a)} { - $c move box1 [expr 10*($v(a)-$newA)] 0 + $c move box1 [expr {10*($v(a)-$newA)}] 0 set v(a) $newA } } @@ -192,14 +193,14 @@ proc arrowMove1 {c x y} { proc arrowMove2 {c x y} { upvar #0 demo_arrowInfo v - set newB [expr ($v(x2)+5-round([$c canvasx $x]))/10] + set newB [expr {($v(x2)+5-round([$c canvasx $x]))/10}] if {$newB < 0} { set newB 0 } if {$newB > 25} { set newB 25 } - set newC [expr ($v(y)+5-round([$c canvasy $y])-5*$v(width))/10] + set newC [expr {($v(y)+5-round([$c canvasy $y])-5*$v(width))/10}] if {$newC < 0} { set newC 0 } @@ -207,7 +208,7 @@ proc arrowMove2 {c x y} { set newC 20 } if {($newB != $v(b)) || ($newC != $v(c))} { - $c move box2 [expr 10*($v(b)-$newB)] [expr 10*($v(c)-$newC)] + $c move box2 [expr {10*($v(b)-$newB)}] [expr {10*($v(c)-$newC)}] set v(b) $newB set v(c) $newC } @@ -224,7 +225,7 @@ proc arrowMove2 {c x y} { proc arrowMove3 {c x y} { upvar #0 demo_arrowInfo v - set newWidth [expr ($v(y)+2-round([$c canvasy $y]))/5] + set newWidth [expr {($v(y)+2-round([$c canvasy $y]))/5}] if {$newWidth < 0} { set newWidth 0 } @@ -232,7 +233,7 @@ proc arrowMove3 {c x y} { set newWidth 20 } if {$newWidth != $v(width)} { - $c move box3 0 [expr 5*($v(width)-$newWidth)] + $c move box3 0 [expr {5*($v(width)-$newWidth)}] set v(width) $newWidth } } diff --git a/library/demos/clrpick.tcl b/library/demos/clrpick.tcl index eee1d7e..29c190d 100644 --- a/library/demos/clrpick.tcl +++ b/library/demos/clrpick.tcl @@ -2,7 +2,7 @@ # # This demonstration script prompts the user to select a color. # -# RCS: @(#) $Id: clrpick.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -38,7 +38,7 @@ proc setColor {w button name options} { set initialColor [$button cget -$name] set color [tk_chooseColor -title "Choose a $name color" -parent $w \ -initialcolor $initialColor] - if [string compare $color ""] { + if {[string compare $color ""]} { setColor_helper $w $options $color } grab release $w diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 0289911..cc03e9f 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a simple canvas that can be # scrolled in two dimensions. # -# RCS: @(#) $Id: cscroll.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: cscroll.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -48,9 +48,9 @@ set bg [lindex [$c config -bg] 4] for {set i 0} {$i < 20} {incr i} { set x [expr {-10 + 3*$i}] for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} { - $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \ + $c create rect ${x}c ${y}c [expr {$x+2}]c [expr {$y+2}]c \ -outline black -fill $bg -tags rect - $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \ + $c create text [expr {$x+1}]c [expr {$y+1}]c -text "$i,$j" \ -anchor center -tags text } } @@ -65,14 +65,14 @@ proc scrollEnter canvas { global oldFill set id [$canvas find withtag current] if {[lsearch [$canvas gettags current] text] >= 0} { - set id [expr $id-1] + set id [expr {$id-1}] } set oldFill [lindex [$canvas itemconfig $id -fill] 4] if {[winfo depth $canvas] > 1} { $canvas itemconfigure $id -fill SeaGreen1 } else { $canvas itemconfigure $id -fill black - $canvas itemconfigure [expr $id+1] -fill white + $canvas itemconfigure [expr {$id+1}] -fill white } } @@ -80,17 +80,17 @@ proc scrollLeave canvas { global oldFill set id [$canvas find withtag current] if {[lsearch [$canvas gettags current] text] >= 0} { - set id [expr $id-1] + set id [expr {$id-1}] } $canvas itemconfigure $id -fill $oldFill - $canvas itemconfigure [expr $id+1] -fill black + $canvas itemconfigure [expr {$id+1}] -fill black } proc scrollButton canvas { global oldFill set id [$canvas find withtag current] if {[lsearch [$canvas gettags current] text] < 0} { - set id [expr $id+1] + set id [expr {$id+1}] } puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]" } diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl index 51af609..621ff78 100644 --- a/library/demos/ctext.tcl +++ b/library/demos/ctext.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget with a text # item that can be edited and reconfigured in various ways. # -# RCS: @(#) $Id: ctext.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: ctext.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -58,7 +58,7 @@ $c bind text <2> "textPaste $c @%x,%y" # to be edited. proc mkTextConfig {w x y option value color} { - set item [$w create rect [expr $x] [expr $y] [expr $x+30] [expr $y+30] \ + set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \ -outline black -fill $color -width 1] $w bind $item <1> "$w itemconf text $option $value" $w addtag config withtag $item @@ -68,19 +68,20 @@ set x 50 set y 50 set color LightSkyBlue1 mkTextConfig $c $x $y -anchor se $color -mkTextConfig $c [expr $x+30] [expr $y] -anchor s $color -mkTextConfig $c [expr $x+60] [expr $y] -anchor sw $color -mkTextConfig $c [expr $x] [expr $y+30] -anchor e $color -mkTextConfig $c [expr $x+30] [expr $y+30] -anchor center $color -mkTextConfig $c [expr $x+60] [expr $y+30] -anchor w $color -mkTextConfig $c [expr $x] [expr $y+60] -anchor ne $color -mkTextConfig $c [expr $x+30] [expr $y+60] -anchor n $color -mkTextConfig $c [expr $x+60] [expr $y+60] -anchor nw $color -set item [$c create rect [expr $x+40] [expr $y+40] [expr $x+50] [expr $y+50] \ +mkTextConfig $c [expr {$x+30}] [expr {$y }] -anchor s $color +mkTextConfig $c [expr {$x+60}] [expr {$y }] -anchor sw $color +mkTextConfig $c [expr {$x }] [expr {$y+30}] -anchor e $color +mkTextConfig $c [expr {$x+30}] [expr {$y+30}] -anchor center $color +mkTextConfig $c [expr {$x+60}] [expr {$y+30}] -anchor w $color +mkTextConfig $c [expr {$x }] [expr {$y+60}] -anchor ne $color +mkTextConfig $c [expr {$x+30}] [expr {$y+60}] -anchor n $color +mkTextConfig $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color +set item [$c create rect \ + [expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \ -outline black -fill red] $c bind $item <1> "$c itemconf text -anchor center" -$c create text [expr $x+45] [expr $y-5] -text {Text Position} -anchor s \ - -font {Times 24} -fill brown +$c create text [expr {$x+45}] [expr {$y-5}] \ + -text {Text Position} -anchor s -font {Times 24} -fill brown # Lastly, create some items that allow the text's justification to be # changed. @@ -89,10 +90,10 @@ set x 350 set y 50 set color SeaGreen2 mkTextConfig $c $x $y -justify left $color -mkTextConfig $c [expr $x+30] [expr $y] -justify center $color -mkTextConfig $c [expr $x+60] [expr $y] -justify right $color -$c create text [expr $x+45] [expr $y-5] -text {Justification} -anchor s \ - -font {Times 24} -fill brown +mkTextConfig $c [expr {$x+30}] $y -justify center $color +mkTextConfig $c [expr {$x+60}] $y -justify right $color +$c create text [expr {$x+45}] [expr {$y-5}] \ + -text {Justification} -anchor s -font {Times 24} -fill brown $c bind config <Enter> "textEnter $c" $c bind config <Leave> "$c itemconf current -fill \$textConfigFill" @@ -131,7 +132,7 @@ proc textB1Move {w x y} { } proc textBs {w} { - if ![catch {$w dchars text sel.first sel.last}] { + if {![catch {$w dchars text sel.first sel.last}]} { return } set char [expr {[$w index text insert] - 1}] @@ -139,7 +140,7 @@ proc textBs {w} { } proc textDel {w} { - if ![catch {$w dchars text sel.first sel.last}] { + if {![catch {$w dchars text sel.first sel.last}]} { return } $w dchars text insert diff --git a/library/demos/filebox.tcl b/library/demos/filebox.tcl index 9fd69fa..aef6e26 100644 --- a/library/demos/filebox.tcl +++ b/library/demos/filebox.tcl @@ -2,7 +2,7 @@ # # This demonstration script prompts the user to select a file. # -# RCS: @(#) $Id: filebox.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: filebox.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -35,7 +35,7 @@ foreach i {open save} { pack $f -fill x -padx 1c -pady 3 } -if ![string compare $tcl_platform(platform) unix] { +if {![string compare $tcl_platform(platform) unix]} { checkbutton $w.strict -text "Use Motif Style Dialog" \ -variable tk_strictMotif -onvalue 1 -offvalue 0 pack $w.strict -anchor c @@ -62,7 +62,7 @@ proc fileDialog {w ent operation} { set file [tk_getSaveFile -filetypes $types -parent $w \ -initialfile Untitled -defaultextension .txt] } - if [string compare $file ""] { + if {[string compare $file ""]} { $ent delete 0 end $ent insert 0 $file $ent xview end diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 0afb625..2564459 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widet that displays the # floorplan for DEC's Western Research Laboratory. # -# RCS: @(#) $Id: floor.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: floor.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -94,7 +94,7 @@ proc newRoom w { proc roomChanged {w args} { global currentRoom floorItems colors $w delete highlight - if [catch {set item $floorItems($currentRoom)}] { + if {[catch {set item $floorItems($currentRoom)}]} { return } set new [eval \ diff --git a/library/demos/hscale.tcl b/library/demos/hscale.tcl index fca7f20..abe29a2 100644 --- a/library/demos/hscale.tcl +++ b/library/demos/hscale.tcl @@ -2,7 +2,7 @@ # # This demonstration script shows an example with a horizontal scale. # -# RCS: @(#) $Id: hscale.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: hscale.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -38,7 +38,7 @@ $w.frame.scale set 75 proc setWidth {w width} { incr width 21 - set x2 [expr $width - 30] + set x2 [expr {$width - 30}] if {$x2 < 21} { set x2 21 } diff --git a/library/demos/items.tcl b/library/demos/items.tcl index a91ab61..c530603 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas that displays the # canvas item types. # -# RCS: @(#) $Id: items.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: items.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -271,7 +271,7 @@ proc itemDrag {c x y} { global lastX lastY set x [$c canvasx $x] set y [$c canvasy $y] - $c move current [expr $x-$lastX] [expr $y-$lastY] + $c move current [expr {$x-$lastX}] [expr {$y-$lastY}] set lastX $x set lastY $y } diff --git a/library/demos/plot.tcl b/library/demos/plot.tcl index a1109c2..a7c20dd 100644 --- a/library/demos/plot.tcl +++ b/library/demos/plot.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget showing a 2-D # plot with data points that can be dragged with the mouse. # -# RCS: @(#) $Id: plot.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: plot.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -38,20 +38,21 @@ $c create text 225 20 -text "A Simple Plot" -font $plotFont -fill brown for {set i 0} {$i <= 10} {incr i} { set x [expr {100 + ($i*30)}] $c create line $x 250 $x 245 -width 2 - $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont + $c create text $x 254 -text [expr {10*$i}] -anchor n -font $plotFont } for {set i 0} {$i <= 5} {incr i} { set y [expr {250 - ($i*40)}] $c create line 100 $y 105 $y -width 2 - $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont + $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $plotFont } -foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} - {75 160} {98 223}} { +foreach point { + {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} +} { set x [expr {100 + (3*[lindex $point 0])}] set y [expr {250 - (4*[lindex $point 1])/5}] - set item [$c create oval [expr $x-6] [expr $y-6] \ - [expr $x+6] [expr $y+6] -width 1 -outline black \ + set item [$c create oval [expr {$x-6}] [expr {$y-6}] \ + [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \ -fill SkyBlue2] $c addtag point withtag $item } @@ -92,7 +93,7 @@ proc plotDown {w x y} { proc plotMove {w x y} { global plot - $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] + $w move selected [expr {$x-$plot(lastX)}] [expr {$y-$plot(lastY)}] set plot(lastX) $x set plot(lastY) $y } diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl index e3ee8cc..acfb5c4 100644 --- a/library/demos/puzzle.tcl +++ b/library/demos/puzzle.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a 15-puzzle game using a collection # of buttons. # -# RCS: @(#) $Id: puzzle.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: puzzle.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -60,10 +60,10 @@ pack $w.frame -side top -pady 1c -padx 1c destroy $w.s set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12} -for {set i 0} {$i < 15} {set i [expr $i+1]} { +for {set i 0} {$i < 15} {set i [expr {$i+1}]} { set num [lindex $order $i] - set xpos($num) [expr ($i%4)*.25] - set ypos($num) [expr ($i/4)*.25] + set xpos($num) [expr {($i%4)*.25}] + set ypos($num) [expr {($i/4)*.25}] button $w.frame.$num -relief raised -text $num -highlightthickness 0 \ -command "puzzleSwitch $w $num" place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \ diff --git a/library/demos/ruler.tcl b/library/demos/ruler.tcl index fa20566..1b48c97 100644 --- a/library/demos/ruler.tcl +++ b/library/demos/ruler.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget that displays a ruler # with tab stops that can be set, moved, and deleted. # -# RCS: @(#) $Id: ruler.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: ruler.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,8 +19,8 @@ if {![info exists widgetDemo]} { proc rulerMkTab {c x y} { upvar #0 demo_rulerInfo v - $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \ - [expr $x-$v(size)] [expr $y+$v(size)] + $c create polygon $x $y [expr {$x+$v(size)}] [expr {$y+$v(size)}] \ + [expr {$x-$v(size)}] [expr {$y+$v(size)}] } set w .ruler @@ -63,7 +63,7 @@ if {[winfo depth $c] > 1} { $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1 for {set i 0} {$i < 12} {incr i} { - set x [expr $i+1] + set x [expr {$i+1}] $c create line ${x}c 1c ${x}c 0.6c -width 1 $c create line $x.25c 1c $x.25c 0.8c -width 1 $c create line $x.5c 1c $x.5c 0.7c -width 1 @@ -110,7 +110,7 @@ proc rulerNewTab {c x y} { proc rulerSelectTab {c x y} { upvar #0 demo_rulerInfo v set v(x) [$c canvasx $x $v(grid)] - set v(y) [expr $v(top)+2] + set v(y) [expr {$v(top)+2}] $c addtag active withtag current eval "$c itemconf active $v(activeStyle)" $c raise active @@ -139,13 +139,13 @@ proc rulerMoveTab {c x y} { set cx $v(right) } if {($cy >= $v(top)) && ($cy <= $v(bottom))} { - set cy [expr $v(top)+2] + set cy [expr {$v(top)+2}] eval "$c itemconf active $v(activeStyle)" } else { - set cy [expr $cy-$v(size)-2] + set cy [expr {$cy-$v(size)-2}] eval "$c itemconf active $v(deleteStyle)" } - $c move active [expr $cx-$v(x)] [expr $cy-$v(y)] + $c move active [expr {$cx-$v(x)}] [expr {$cy-$v(y)}] set v(x) $cx set v(y) $cy } @@ -164,7 +164,7 @@ proc rulerReleaseTab c { if {[$c find withtag active] == {}} { return } - if {$v(y) != [expr $v(top)+2]} { + if {$v(y) != $v(top)+2} { $c delete active } else { eval "$c itemconf active $v(normalStyle)" diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index bdb8337..4ad163b 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget with a bunch of # embedded windows. # -# RCS: @(#) $Id: twind.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: twind.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -115,7 +115,7 @@ proc textWindOff w { proc textWindPlot t { set c $t.c - if [winfo exists $c] { + if {[winfo exists $c]} { return } canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow @@ -129,20 +129,21 @@ proc textWindPlot t { for {set i 0} {$i <= 10} {incr i} { set x [expr {100 + ($i*30)}] $c create line $x 250 $x 245 -width 2 - $c create text $x 254 -text [expr 10*$i] -anchor n -font $font + $c create text $x 254 -text [expr {10*$i}] -anchor n -font $font } for {set i 0} {$i <= 5} {incr i} { set y [expr {250 - ($i*40)}] $c create line 100 $y 105 $y -width 2 - $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font + $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font } - foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} - {75 160} {98 223}} { + foreach point { + {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} + } { set x [expr {100 + (3*[lindex $point 0])}] set y [expr {250 - (4*[lindex $point 1])/5}] - set item [$c create oval [expr $x-6] [expr $y-6] \ - [expr $x+6] [expr $y+6] -width 1 -outline black \ + set item [$c create oval [expr {$x-6}] [expr {$y-6}] \ + [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \ -fill SkyBlue2] $c addtag point withtag $item } @@ -175,14 +176,14 @@ proc embPlotDown {w x y} { proc embPlotMove {w x y} { global embPlot - $w move selected [expr $x-$embPlot(lastX)] [expr $y-$embPlot(lastY)] + $w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}] set embPlot(lastX) $x set embPlot(lastY) $y } proc textWindDel w { set t $w.f.text - if [winfo exists $t.c] { + if {[winfo exists $t.c]} { $t delete $t.c while {[string first [$t get plot] " \t\n"] >= 0} { $t delete plot diff --git a/library/demos/vscale.tcl b/library/demos/vscale.tcl index d50089f..9903b13 100644 --- a/library/demos/vscale.tcl +++ b/library/demos/vscale.tcl @@ -2,7 +2,7 @@ # # This demonstration script shows an example with a vertical scale. # -# RCS: @(#) $Id: vscale.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: vscale.tcl,v 1.2.22.1 2001/07/03 20:01:09 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -39,7 +39,7 @@ $w.frame.scale set 75 proc setHeight {w height} { incr height 21 - set y2 [expr $height - 30] + set y2 [expr {$height - 30}] if {$y2 < 21} { set y2 21 } diff --git a/library/entry.tcl b/library/entry.tcl index 1bf772c..05588a5 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.13.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.13.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -55,7 +55,7 @@ bind Entry <<Paste>> { %W delete sel.first sel.last } } - %W insert insert [selection get -displayof %W -selection CLIPBOARD] + %W insert insert [::tk::GetSelection %W CLIPBOARD] tk::EntrySeeInsert %W } } @@ -210,7 +210,7 @@ if {[string equal $tcl_platform(platform) "macintosh"]} { # generates the <<Paste>> event, so we don't need to do anything here. if {[string compare $tcl_platform(platform) "windows"]} { bind Entry <Insert> { - catch {tk::EntryInsert %W [selection get -displayof %W]} + catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]} } } @@ -390,6 +390,9 @@ proc ::tk::EntryMouseSelect {w x} { $w selection range 0 end } } + if {$Priv(mouseMoved)} { + $w icursor $cur + } update idletasks } @@ -403,7 +406,7 @@ proc ::tk::EntryMouseSelect {w x} { proc ::tk::EntryPaste {w x} { $w icursor [EntryClosestGap $w $x] - catch {$w insert insert [selection get -displayof $w]} + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string compare "disabled" [$w cget -state]]} {focus $w} } diff --git a/library/msgbox.tcl b/library/msgbox.tcl index a31a493..86f43f9 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.12.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.12.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -171,8 +171,8 @@ proc ::tk::MessageBox {args} { switch -- $data(-type) { abortretryignore { - set maxWidth [::msgcat::mcmax Abort Retry Ignore] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Abort Retry Ignore] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list abort -width $maxWidth -text [::msgcat::mc "Abort"] \ -under 0]\ @@ -192,8 +192,8 @@ proc ::tk::MessageBox {args} { } } okcancel { - set maxWidth [::msgcat::mcmax OK Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax OK Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list ok -width $maxWidth \ -text [::msgcat::mc "OK"] -under 0] \ @@ -202,8 +202,8 @@ proc ::tk::MessageBox {args} { ] } retrycancel { - set maxWidth [::msgcat::mcmax Retry Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Retry Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list retry -width $maxWidth \ -text [::msgcat::mc "Retry"] -under 0] \ @@ -212,8 +212,8 @@ proc ::tk::MessageBox {args} { ] } yesno { - set maxWidth [::msgcat::mcmax Yes No] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Yes No] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list yes -width $maxWidth \ -text [::msgcat::mc "Yes"] -under 0]\ @@ -222,8 +222,8 @@ proc ::tk::MessageBox {args} { ] } yesnocancel { - set maxWidth [::msgcat::mcmax Yes No Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax Yes No Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set buttons [list \ [list yes -width $maxWidth \ -text [::msgcat::mc "Yes"] -under 0]\ diff --git a/library/msgs/de.msg b/library/msgs/de.msg index a4309a1..60e2ce7 100644 --- a/library/msgs/de.msg +++ b/library/msgs/de.msg @@ -21,7 +21,7 @@ ::msgcat::mcset de "File \"%1\$s\" already exists.\n\n" "Die Datei \"%1\$s\" ist bereits vorhanden.\n\n" ::msgcat::mcset de "File \"%1\$s\" does not exist." "Die Datei \"%1\$s\" existiert nicht." ::msgcat::mcset de "File name:" "Dateiname:" -::msgcat::mcset de "File names:" "Nombre de archivos:" +::msgcat::mcset de "File names:" "Dateinamen:" ::msgcat::mcset de "Files of type:" "Dateien des Typs:" ::msgcat::mcset de "Files:" "Dateien:" ::msgcat::mcset de "Filter" @@ -40,7 +40,7 @@ ::msgcat::mcset de "Paste" "Einf\u00fcgen" ::msgcat::mcset de "Quit" "Beenden" ::msgcat::mcset de "Red" "Rot" -::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen ?" +::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen?" ::msgcat::mcset de "Retry" "Wiederholen" ::msgcat::mcset de "Save" "Speichern" ::msgcat::mcset de "Save As" "Speichern unter" @@ -50,7 +50,7 @@ ::msgcat::mcset de "Selection:" "Auswahl:" ::msgcat::mcset de "Skip Messages" "Weitere Nachrichten \u00fcberspringen" ::msgcat::mcset de "Source..." "Ausf\u00fchren..." -::msgcat::mcset de "Tcl Scripts" "Tcl Skripte" +::msgcat::mcset de "Tcl Scripts" "Tcl-Skripte" ::msgcat::mcset de "Tcl for Windows" "Tcl f\u00fcr Windows" ::msgcat::mcset de "Text Files" "Textdateien" ::msgcat::mcset de "Yes" "Ja" diff --git a/library/spinbox.tcl b/library/spinbox.tcl index ba3c0bc..6abdbc8 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk spinbox widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: spinbox.tcl,v 1.1.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: spinbox.tcl,v 1.1.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -60,7 +60,7 @@ bind Spinbox <<Paste>> { %W delete sel.first sel.last } } - %W insert insert [selection get -displayof %W -selection CLIPBOARD] + %W insert insert [::tk::GetSelection %W CLIPBOARD] ::tk::spinbox::SeeInsert %W } } @@ -218,7 +218,7 @@ if {[string equal $tcl_platform(platform) "macintosh"]} { # generates the <<Paste>> event, so we don't need to do anything here. if {[string compare $tcl_platform(platform) "windows"]} { bind Spinbox <Insert> { - catch {::tk::spinbox::Insert %W [selection get -displayof %W]} + catch {::tk::spinbox::Insert %W [::tk::GetSelection %W PRIMARY]} } } @@ -503,7 +503,7 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { proc ::tk::spinbox::Paste {w x} { $w icursor [::tk::spinbox::ClosestGap $w $x] - catch {$w insert insert [selection get -displayof $w]} + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string equal "disabled" [$w cget -state]]} {focus $w} } diff --git a/library/text.tcl b/library/text.tcl index 72c0ef3..0ef5592 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.13.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: text.tcl,v 1.13.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -260,7 +260,7 @@ bind Text <<PasteSelection>> { } } bind Text <Insert> { - catch {tk::TextInsert %W [selection get -displayof %W]} + catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]} } bind Text <KeyPress> { tk::TextInsert %W %A @@ -582,15 +582,9 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { } } if {$Priv(mouseMoved) || [string compare $Priv(selectMode) "char"]} { - if {[string compare $tcl_platform(platform) "unix"] \ - && [$w compare $cur < anchor]} { - $w mark set insert $first - } else { - $w mark set insert $last - } - $w tag remove sel 0.0 $first + $w tag remove sel 0.0 end + $w mark set insert $cur $w tag add sel $first $last - $w tag remove sel $last end update idletasks } } @@ -633,7 +627,7 @@ proc ::tk::TextKeyExtend {w index} { proc ::tk::TextPaste {w x y} { $w mark set insert [TextClosestGap $w $x $y] - catch {$w insert insert [selection get -displayof $w]} + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string equal [$w cget -state] "normal"]} {focus $w} } @@ -977,7 +971,7 @@ proc ::tk_textPaste w { $w delete sel.first sel.last } } - $w insert insert [selection get -displayof $w -selection CLIPBOARD] + $w insert insert [::tk::GetSelection $w CLIPBOARD] } } diff --git a/library/tk.tcl b/library/tk.tcl index f8a1747..76fefd5 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.27.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.27.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -13,11 +13,11 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # Insist on running with compatible versions of Tcl and Tk. - package require -exact Tk 8.4 package require -exact Tcl 8.4 -package require msgcat + if { ![interp issafe] } { + package require msgcat ::msgcat::mcload [file join $::tk_library msgs] } @@ -151,6 +151,38 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { } } +# ::tk::GetSelection -- +# This tries to obtain the default selection. On Unix, we first try +# and get a UTF8_STRING, a type supported by modern Unix apps for +# passing Unicode data safely. We fall back on the default STRING +# type otherwise. On Windows, only the STRING type is necessary. +# Arguments: +# w The widget for which the selection will be retrieved. +# Important for the -displayof property. +# sel The source of the selection (PRIMARY or CLIPBOARD) +# Results: +# Returns the selection, or an error if none could be found +# +if {[string equal $tcl_platform(platform) "unix"]} { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel \ + -type UTF8_STRING} txt] \ + && [catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} else { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} + # ::tk::ScreenChanged -- # This procedure is invoked by the binding mechanism whenever the # "current" screen is changing. The procedure does two things. @@ -291,7 +323,10 @@ switch $::tcl_platform(platform) { switch $tcl_platform(os) { "IRIX" - "Linux" { event add <<PrevWindow>> <ISO_Left_Tab> } - "HP-UX" { event add <<PrevWindow>> <hpBackTab> } + "HP-UX" { + # This seems to be correct on *some* HP systems. + catch { event add <<PrevWindow>> <hpBackTab> } + } } } trace variable ::tk_strictMotif w ::tk::EventMotifBindings @@ -311,7 +346,6 @@ switch $::tcl_platform(platform) { event add <<Clear>> <Clear> } } - # ---------------------------------------------------------------------- # Read in files that define all of the class bindings. # ---------------------------------------------------------------------- @@ -327,7 +361,6 @@ if {[string compare $::tcl_platform(platform) "macintosh"] && \ source [file join $::tk_library spinbox.tcl] source [file join $::tk_library text.tcl] } - # ---------------------------------------------------------------------- # Default bindings for keyboard traversal. # ---------------------------------------------------------------------- diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 9d3ff02..d99c42b 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -11,7 +11,7 @@ # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.24.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.24.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -1001,9 +1001,9 @@ static char updir_bits[] = { # if { [string equal $class TkFDialog] } { if { $data(-multiple) } { - set fNameCaption "[::msgcat::mc {File names:}]" + set fNameCaption "[::msgcat::mc {File names:}]" } else { - set fNameCaption "[::msgcat::mc {File name:}]" + set fNameCaption "[::msgcat::mc {File name:}]" } set fTypeCaption [::msgcat::mc "Files of type:"] set fCaptionWidth [::msgcat::mcmax $fNameCaption $fTypeCaption] @@ -1144,9 +1144,9 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { set dataName __tk_filedialog upvar ::tk::dialog::file::$dataName data if { $multi } { - set fNameCaption "[::msgcat::mc {File names:}]" + set fNameCaption "[::msgcat::mc {File names:}]" } else { - set fNameCaption "[::msgcat::mc {File name:}]" + set fNameCaption "[::msgcat::mc {File name:}]" } set fNameUnder 5 set iconListCommand [list ::tk::dialog::file::OkCmd $w] @@ -1497,12 +1497,17 @@ proc ::tk::dialog::file::EntFocusOut {w} { # proc ::tk::dialog::file::ActivateEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data - + set text [$data(ent) get] if {$data(-multiple)} { + # For the multiple case we have to be careful to get the file + # names as a true list, watching out for a single file with a + # space in the name. Thus we query the IconList directly. + set data(selectFile) "" - foreach fname $text { - ::tk::dialog::file::VerifyFileName $w $fname + foreach item [tkIconList_Curselection $data(icons)] { + ::tk::dialog::file::VerifyFileName $w \ + [tkIconList_Get $data(icons) $item] } } else { ::tk::dialog::file::VerifyFileName $w $text @@ -1620,7 +1625,8 @@ proc ::tk::dialog::file::OkCmd {w} { lappend text [::tk::IconList_Get $data(icons) $item] } - if {[llength $text] && !$data(-multiple)} { + if {([llength $text] && !$data(-multiple)) || \ + ($data(-multiple) && ([llength $text] == 1))} { set text [lindex $text 0] set file [::tk::dialog::file::JoinFile $data(selectPath) $text] if {[file isdirectory $file]} { diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 7e1b709..f227684 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -4,7 +4,7 @@ # Unix platform. This implementation is used only if the # "::tk_strictMotif" flag is set. # -# RCS: @(#) $Id: xmfbox.tcl,v 1.14.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.14.4.2 2001/07/03 20:01:09 dgp Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Scriptics Corporation @@ -346,8 +346,8 @@ proc ::tk::MotifFDialog_BuildUI {w} { # The buttons # - set maxWidth [::msgcat::mcmax OK Filter Cancel] - set maxWidth [expr $maxWidth<6?6:$maxWidth] + set maxWidth [::msgcat::mcmax OK Filter Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] set data(okBtn) [button $bot.ok -text [::msgcat::mc "OK"] \ -width $maxWidth -under 0 \ -command [list tk::MotifFDialog_OkCmd $w]] @@ -824,7 +824,7 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { if {[string equal $data(type) save]} { set message [format %s%s \ [::msgcat::mc {File "%1$s" already exists.\n\n} \ - $selectFilePath ] + $selectFilePath ] \ [::msgcat::mc {Replace existing file?}]] set answer [tk_messageBox -icon warning -type yesno \ -message $message] @@ -8,7 +8,7 @@ Jim Ingham Cygnus Solutions jingham@cygnus.com -RCS: @(#) $Id: README,v 1.14 2000/05/03 00:18:36 hobbs Exp $ +RCS: @(#) $Id: README,v 1.14.4.1 2001/07/03 20:01:09 dgp Exp $ 1. Introduction --------------- @@ -83,5 +83,4 @@ Special notes: If you have comments or Bug reports, use our on-line database at - http://dev.scriptics.com/ticket/ - + http://tcl.sourceforge.net/ diff --git a/mac/tkMacMenubutton.c b/mac/tkMacMenubutton.c index 4c274e6..31fc7a6 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.7 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkMacMenubutton.c,v 1.7.2.1 2001/07/03 20:01:09 dgp Exp $ */ #include "tkMenubutton.h" @@ -92,7 +92,9 @@ TkpDisplayMenuButton( * compiler warning. */ int y; Tk_Window tkwin = mbPtr->tkwin; - int width, height; + int width, height, fullWidth, fullHeight; + int imageXOffset, imageYOffset, textXOffset, textYOffset; + int haveImage = 0, haveText = 0; MacMenuButton * macMBPtr = (MacMenuButton *) mbPtr; GWorldPtr destPort; CGrafPtr saveWorld; @@ -119,6 +121,15 @@ TkpDisplayMenuButton( } border = mbPtr->normalBorder; + if (mbPtr->image != None) { + Tk_SizeOfImage(mbPtr->image, &width, &height); + haveImage = 1; + } else if (mbPtr->bitmap != None) { + Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height); + haveImage = 1; + } + haveText = (mbPtr->textWidth != 0 && mbPtr->textHeight != 0); + /* * In order to avoid screen flashes, this procedure redraws * the menu button in a pixmap, then copies the pixmap to the @@ -129,6 +140,108 @@ TkpDisplayMenuButton( Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + imageXOffset = 0; + imageYOffset = 0; + textXOffset = 0; + textYOffset = 0; + fullWidth = 0; + fullHeight = 0; + + if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) { + switch ((enum compound) mbPtr->compound) { + case COMPOUND_TOP: + case COMPOUND_BOTTOM: { + /* Image is above or below text */ + if (mbPtr->compound == COMPOUND_TOP) { + textYOffset = height + mbPtr->padY; + } else { + imageYOffset = mbPtr->textHeight + mbPtr->padY; + } + fullHeight = height + mbPtr->textHeight + mbPtr->padY; + fullWidth = (width > mbPtr->textWidth ? width : + mbPtr->textWidth); + textXOffset = (fullWidth - mbPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + break; + } + case COMPOUND_LEFT: + case COMPOUND_RIGHT: { + /* Image is left or right of text */ + if (mbPtr->compound == COMPOUND_LEFT) { + textXOffset = width + mbPtr->padX; + } else { + imageXOffset = mbPtr->textWidth + mbPtr->padX; + } + fullWidth = mbPtr->textWidth + mbPtr->padX + width; + fullHeight = (height > mbPtr->textHeight ? height : + mbPtr->textHeight); + textYOffset = (fullHeight - mbPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; + } + case COMPOUND_CENTER: { + /* Image and text are superimposed */ + fullWidth = (width > mbPtr->textWidth ? width : + mbPtr->textWidth); + fullHeight = (height > mbPtr->textHeight ? height : + mbPtr->textHeight); + textXOffset = (fullWidth - mbPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + textYOffset = (fullHeight - mbPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; + } + case COMPOUND_NONE: {break;} + } + + + TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, + mbPtr->indicatorWidth + fullWidth, fullHeight, + &x, &y); + + if (mbPtr->image != NULL) { + Tk_RedrawImage(mbPtr->image, 0, 0, width, height, Tk_WindowId(tkwin), + x + imageXOffset, y + imageYOffset); + } + if (mbPtr->bitmap != None) { + XCopyPlane(mbPtr->display, mbPtr->bitmap, Tk_WindowId(tkwin), + gc, 0, 0, (unsigned) width, (unsigned) height, + x + imageXOffset, y + imageYOffset, 1); + } + if (haveText) { + Tk_DrawTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc, + mbPtr->textLayout, x + textXOffset, y + textYOffset , + 0, -1); + Tk_UnderlineTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc, + mbPtr->textLayout, x + textXOffset, y + textYOffset , + mbPtr->underline); + } + } else { + if (mbPtr->image != NULL) { + TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, + width + mbPtr->indicatorWidth, height, &x, &y); + Tk_RedrawImage(mbPtr->image, 0, 0, width, height, Tk_WindowId(tkwin), + x + imageXOffset, y + imageYOffset); + } else if (mbPtr->bitmap != None) { + TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, + width + mbPtr->indicatorWidth, height, &x, &y); + XCopyPlane(mbPtr->display, mbPtr->bitmap, Tk_WindowId(tkwin), + gc, 0, 0, (unsigned) width, (unsigned) height, + x + imageXOffset, y + imageYOffset, 1); + } else { + TkComputeAnchor(mbPtr->anchor, tkwin, mbPtr->padX, mbPtr->padY, + mbPtr->textWidth + mbPtr->indicatorWidth, + mbPtr->textHeight, &x, &y); + Tk_DrawTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc, + mbPtr->textLayout, x + textXOffset, y + textYOffset, + 0, -1); + Tk_UnderlineTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc, + mbPtr->textLayout, x + textXOffset, y + textYOffset , + mbPtr->underline); + } + } + +#if 0 /* this is the original code */ /* * Display image or bitmap or text for button. */ @@ -156,6 +269,7 @@ TkpDisplayMenuButton( Tk_DrawTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc, mbPtr->textLayout, x, y, 0, -1); } +#endif /* * If the menu button is disabled with a stipple rather than a special diff --git a/tests/bind.test b/tests/bind.test index 06d3078..471c5c9 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: bind.test,v 1.8 2000/08/03 20:36:17 ericm Exp $ +# RCS: @(#) $Id: bind.test,v 1.8.4.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1945,7 +1945,7 @@ test bind-22.2 {HandleEventGenerate} { } {1 {bad window name/identifier "zzz"}} test bind-22.3 {HandleEventGenerate} { list [catch {event gen 47 <Control-v>} msg] $msg -} {1 {window id "47" doesn't exist in this application}} +} {1 {bad window name/identifier "47"}} test bind-22.4 {HandleEventGenerate} { setup bind .b.f <Button> {set x "%s %b"} @@ -2046,7 +2046,11 @@ test bind-22.16 {HandleEventGenerate} { test bind-22.17 {HandleEventGenerate} { list [catch {event gen . <Button> -when xyz} msg] $msg } {1 {bad -when value "xyz": must be now, head, mark, or tail}} -set i 18 +test bind-22.18 {HandleEventGenerate} { + # Bug 411307 + list [catch {event gen . <a> -root 98765} msg] $msg +} {1 {bad window name/identifier "98765"}} +set i 19 foreach check { {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}} {<Configure> %a {-above .b} {[winfo id .b]}} @@ -2673,22 +2677,8 @@ test bind-31.2 {MouseWheel events} { set x } {240 10 30} - destroy .b # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/canvas.test b/tests/canvas.test index 51f178c..e5cdc1f 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-2000 Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: canvas.test,v 1.10 2000/06/06 04:18:13 ericm Exp $ +# RCS: @(#) $Id: canvas.test,v 1.10.4.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -367,6 +367,50 @@ test canvas-11.1 {canvas poly fill check, bug 5783} { -fill {} -stipple gray50 -outline black } 1 +test canvas-12.1 {canvas mm obj, patch SF-403327, 102471} { + destroy .c + pack [canvas .c] + set qx [expr {1.+1.}] + # qx has type double and no string representation + .c scale all $qx 0 1. 1. + # qx has now type MMRep and no string representation + list $qx [string length $qx] +} {2.0 3} +test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} { + destroy .c + pack [canvas .c] + set val 10 + incr val + # qx has type double and no string representation + .c scale all $val 0 1 1 + # qx has now type MMRep and no string representation + incr val +} {12} + +proc kill_canvas {w} { + destroy $w + pack [canvas $w -height 200 -width 200] -fill both -expand yes + update idle + $w create rectangle 80 80 120 120 -fill blue -tags blue + # bind a button press to re-build the canvas + $w bind blue <ButtonRelease-1> [subst { + [lindex [info level 0] 0] $w + append ::x ok + } + ] +} + +test canvas-13.1 {canvas delete during event, SF bug-228024} { + kill_canvas .c + set ::x {} + # do this many times to improve chances of triggering the crash + for {set i 0} {$i < 30} {incr i} { + event generate .c <1> -x 100 -y 100 + event generate .c <ButtonRelease-1> -x 100 -y 100 + } + set ::x +} okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok + # cleanup ::tcltest::cleanupTests return diff --git a/tests/cursor.test b/tests/cursor.test index bb01561..0017be2 100644 --- a/tests/cursor.test +++ b/tests/cursor.test @@ -6,7 +6,7 @@ # 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 $ +# RCS: @(#) $Id: cursor.test,v 1.2.16.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -61,37 +61,37 @@ test cursor-2.2 {Tk_GetCursor procedure} { } {1 {bad cursor spec "@xyzzy"}} test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} { - set x arrow + set x heart destroy .b1 .b2 .b3 button .b1 -cursor $x button .b3 -cursor $x button .b2 -cursor $x set result {} - lappend result [testcursor arrow] + lappend result [testcursor heart] destroy .b1 - lappend result [testcursor arrow] + lappend result [testcursor heart] destroy .b2 - lappend result [testcursor arrow] + lappend result [testcursor heart] destroy .b3 - lappend result [testcursor arrow] + lappend result [testcursor heart] } {{{3 1}} {{2 1}} {{1 1}} {}} test cursor-4.1 {FreeCursorObjProc} { destroy .b - set x [format arrow] + set x [format heart] button .b -cursor $x - set y [format arrow] + set y [format heart] .b configure -cursor $y - set z [format arrow] + set z [format heart] .b configure -cursor $z set result {} - lappend result [testcursor arrow] + lappend result [testcursor heart] set x red - lappend result [testcursor arrow] + lappend result [testcursor heart] set z 32 - lappend result [testcursor arrow] + lappend result [testcursor heart] destroy .b - lappend result [testcursor arrow] + lappend result [testcursor heart] set y bogus set result } {{{1 3}} {{1 2}} {{1 1}} {}} diff --git a/tests/entry.test b/tests/entry.test index ecaf4f3..5be02f4 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: entry.test,v 1.10 2000/05/29 01:43:15 hobbs Exp $ +# RCS: @(#) $Id: entry.test,v 1.10.4.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1506,9 +1506,9 @@ proc doval {W d i P s S v V} { set ::vVals [list $W $d $i $P $s $S $v $V] return 0 } -.e configure -validate all test entry-19.18 {entry widget validation} { + .e configure -validate all set ::e nextdata list [.e cget -validate] $::vVals } {none {.e -1 -1 nextdata newdata {} all forced}} @@ -1518,23 +1518,22 @@ proc doval {W d i P s S v V} { set ::e mydata return 1 } -.e configure -validate all ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the entry textvar is also set test entry-19.19 {entry widget validation} { + .e configure -validate all .e validate list [.e cget -validate] [.e get] $::vVals } {none mydata {.e -1 -1 nextdata nextdata {} all forced}} -.e configure -validate all - ## This leaves validate alone because we trigger validation through the ## textvar (a write trace), and the write during validation triggers ## nothing (by definition of avoiding loops on var traces). This is ## one of those "dangerous" conditions where the user will have a ## different value in the entry widget shown as is in the textvar. test entry-19.20 {entry widget validation} { + .e configure -validate all set ::e testdata list [.e cget -validate] [.e get] $::e $::vVals } {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} @@ -1546,6 +1545,53 @@ catch {unset ::e ::vVals} ## End validation tests ## +test entry-20.1 {widget deletion while active} { + destroy .e + entry .e -validate all \ + -validatecommand { destroy %W ; return 1 } \ + -invalidcommand bell + update + .e insert 0 abc + winfo exists .e +} 0 +test entry-20.2 {widget deletion while active} { + destroy .e + entry .e -validate all \ + -validatecommand { return 0 } \ + -invalidcommand { destroy %W } + .e insert 0 abc + winfo exists .e +} 0 +test entry-20.3 {widget deletion while active} { + destroy .e + entry .e -validate all \ + -validatecommand { rename .e {} ; return 1 } + .e insert 0 abc + winfo exists .e +} 0 +test entry-20.4 {widget deletion while active} { + destroy .e + entry .e -validate all \ + -validatecommand { return 0 } \ + -invalidcommand { rename .e {} } + .e insert 0 abc + winfo exists .e +} 0 +test entry-20.5 {widget deletion while active} { + destroy .e + entry .e -validatecommand { destroy .e ; return 0 } + .e validate + winfo exists .e +} 0 +test entry-20.6 {widget deletion while active} { + destroy .e + pack [entry .e] + update + .e config -xscrollcommand { destroy .e } + update idle + winfo exists .e +} 0 + # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, # and EntryTextVarProc. diff --git a/tests/event.test b/tests/event.test index f1d0450..933b826 100644 --- a/tests/event.test +++ b/tests/event.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: event.test,v 1.5 2000/04/10 22:43:13 ericm Exp $ +# RCS: @(#) $Id: event.test,v 1.5.6.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -22,6 +22,150 @@ raise . # a few of the procedures in tkEvent.c. Please add more tests whenever # possible. + + +# Setup table used to query key events. + +proc _init_keypress_lookup { } { + global keypress_lookup + + scan A %c start + scan Z %c finish + + for {set i $start} {$i <= $finish} {incr i} { + set l [format %c $i] + set keypress_lookup($l) $l + } + + scan a %c start + scan z %c finish + + for {set i $start} {$i <= $finish} {incr i} { + set l [format %c $i] + set keypress_lookup($l) $l + } + + scan 0 %c start + scan 9 %c finish + + for {set i $start} {$i <= $finish} {incr i} { + set l [format %c $i] + set keypress_lookup($l) $l + } + + array set keypress_lookup [list \ + " " space \ + ! exclam \ + \" quotedbl \ + \# numbersign \ + \$ dollar \ + % percent \ + & ampersand \ + ( parenleft \ + ) parenright \ + * asterisk \ + + plus \ + , comma \ + - minus \ + . period \ + / slash \ + : colon \ + \; semicolon \ + < less \ + = equal \ + > greater \ + ? question \ + @ at \ + \[ bracketleft \ + \\ backslash \ + \] bracketright \ + ^ asciicircum \ + _ underscore \ + \{ braceleft \ + | bar \ + \} braceright \ + ~ asciitilde \ + ' apostrophe \ + "\n" Return] +} + + +# Lookup an event in the keypress table. +# For example: +# Q -> Q +# . -> period +# / -> slash +# Delete -> Delete +# Escape -> Escape + +proc _keypress_lookup { char } { + global keypress_lookup + + if {! [info exists keypress_lookup]} { + _init_keypress_lookup + } + + if {$char == ""} { + error "empty char" + } + + if {[info exists keypress_lookup($char)]} { + return $keypress_lookup($char) + } else { + return $char + } +} + + +# Lookup and generate a pair of KeyPress and KeyRelease events + +proc _keypress { win key } { + set keysym [_keypress_lookup $key] + + event generate $win <KeyPress-$keysym> + _pause 50 + event generate $win <KeyRelease-$keysym> + _pause 50 +} + +# Call _keypress for each character in the given string + +proc _keypress_string { win string } { + foreach letter [split $string ""] { + _keypress $win $letter + } +} + +# Delay script execution for a given amount of time + +proc _pause { {msecs 1000} } { + global _pause + + if {! [info exists _pause(number)]} { + set _pause(number) 0 + } + + set num [incr _pause(number)] + set _pause($num) 0 + + after $msecs "set _pause($num) 1" + vwait _pause($num) + unset _pause($num) +} + +# Helper proc to convert index to x y position + +proc _text_ind_to_x_y { text ind } { + foreach {x1 y1 x2 y2} [$text bbox $ind] break + set middle_y [expr {$y1 + (($y2 - $y1) / 2)}] + return [list $x1 $middle_y] +} + + + + +# Begining of the actual tests + test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} { button .b -text Test pack .b @@ -51,19 +195,261 @@ test event-1.2 {event generate <Alt-z>} { destroy .e set ::event12result } 1 -# cleanup -::tcltest::cleanupTests -return +test event-keypress-1.1 { type into entry widget and hit Return } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + set return_binding 0 + bind $e <Return> {set return_binding 1} + tkwait visibility $e + focus -force $e + _keypress_string $e HELLO\n + list [$e get] $return_binding +} {HELLO 1} +test event-keypress-1.2 { type into entry widget and then delete some text } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e MELLO + _keypress $e BackSpace + _keypress $e BackSpace + $e get +} MEL +test event-keypress-1.3 { type into entry widget, triple click, + hit Delete key, and then type some more } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e JUMP + + set result [$e get] + + event generate $e <Enter> + for {set i 0} {$i < 3} {incr i} { + _pause 100 + event generate $e <ButtonPress-1> + _pause 100 + event generate $e <ButtonRelease-1> + } + _keypress $e Delete + _keypress_string $e UP + lappend result [$e get] +} {JUMP UP} +test event-keypress-1.4 { type into text widget and hit Return } { + destroy .t + set t [toplevel .t] + set e [text $t.e] + pack $e + set return_binding 0 + bind $e <Return> {set return_binding 1} + tkwait visibility $e + focus -force $e + _keypress_string $e HELLO\n + list [$e get 1.0 end] $return_binding +} [list "HELLO\n\n" 1] +test event-keypress-1.5 { type into text widget and then delete some text } { + destroy .t + set t [toplevel .t] + set e [text $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e MELLO + _keypress $e BackSpace + _keypress $e BackSpace + $e get 1.0 1.end +} MEL +test event-keypress-1.6 { type into text widget, triple click, + hit Delete key, and then type some more } { + destroy .t + set t [toplevel .t] + set e [text $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e JUMP + set result [$e get 1.0 1.end] + + event generate $e <Enter> + for {set i 0} {$i < 3} {incr i} { + _pause 100 + event generate $e <ButtonPress-1> + _pause 100 + event generate $e <ButtonRelease-1> + } + + _keypress $e Delete + _keypress_string $e UP + lappend result [$e get 1.0 1.end] +} {JUMP UP} + + + +test event-click-drag-1.1 { click and drag in a text widget, this + tests tkTextSelectTo in text.tcl } { + destroy .t + set t [toplevel .t] + set e [text $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e "A Tcl/Tk selection test!" + set anchor 1.6 + set selend 1.18 + + set result [list [$e get 1.0 1.end]] + + # Get the x,y coords of the second T in "Tcl/Tk" + foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + + # Click down to set the insert cursor position + event generate $e <Enter> + event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Now drag until selend is highlighted, then click up + + set current $anchor + while {[$e compare $current <= $selend]} { + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e <B1-Motion> -x $current_x -y $current_y + set current [$e index [list $current + 1 char]] + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [$e get sel.first sel.last] + + # Now click and click and drag to the left, over "Tcl/Tk selection" + + event generate $e <ButtonPress-1> -x $current_x -y $current_y + + while {[$e compare $current >= [list $anchor - 4 char]]} { + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e <B1-Motion> -x $current_x -y $current_y + set current [$e index [list $current - 1 char]] + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [$e get sel.first sel.last] + +} {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}} + + + + +test event-click-drag-1.2 { click and drag in an entry widget, this + tests tkEntryMouseSelect in entry.tcl } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e "A Tcl/Tk selection test!" + set anchor 6 + set selend 18 + + set result [list [$e get]] + + # Get the x,y coords of the second T in "Tcl/Tk" + foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + + # Click down to set the insert cursor position + event generate $e <Enter> + event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Now drag until selend is highlighted, then click up + + set current $anchor + while {$current <= $selend} { + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e <B1-Motion> -x $current_x -y $current_y + incr current + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [selection get] + + # Now click and click and drag to the left, over "Tcl/Tk selection" + + event generate $e <ButtonPress-1> -x $current_x -y $current_y + + while {$current >= ($anchor - 4)} { + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e <B1-Motion> -x $current_x -y $current_y + incr current -1 + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [selection get] + +} {{A Tcl/Tk selection test!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} + + + +# cleanup + +destroy .t + +unset keypress_lookup +rename _init_keypress_lookup {} +rename _keypress_lookup {} +rename _keypress {} +rename _pause {} +rename _text_ind_to_x_y {} + +::tcltest::cleanupTests +return diff --git a/tests/focus.test b/tests/focus.test index 5750ae8..c9546d4 100644 --- a/tests/focus.test +++ b/tests/focus.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: focus.test,v 1.6 2000/05/11 22:36:32 hobbs Exp $ +# RCS: @(#) $Id: focus.test,v 1.6.4.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -572,7 +572,7 @@ test focus-6.1 {miscellaneous - embedded application in same process} \ bind all <FocusOut> {lappend x "focus out %W %d"} interp create child child eval "set argv {-use [winfo id .t.f1]}" - load {} tk child + load {} Tk child child eval { entry .e1 -bg lightBlue pack .e1 diff --git a/tests/frame.test b/tests/frame.test index 1b28954..89665d4 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: frame.test,v 1.4 1999/12/14 06:53:13 hobbs Exp $ +# RCS: @(#) $Id: frame.test,v 1.4.6.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -105,7 +105,7 @@ foreach test { {-highlightcolor #123456 #123456 non-existent {unknown color name "non-existent"}} {-highlightthickness 6 6 badValue {bad screen distance "badValue"}} - {-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}} {-takefocus "any string" "any string" {} {}} {-width 32 32 badValue {bad screen distance "badValue"}} } { @@ -178,11 +178,22 @@ test frame-2.9 {toplevel configuration options} { catch {destroy .t} list [catch {toplevel .t -width 200 -height 100 -screen bogus} msg] $msg } {1 {couldn't connect to display "bogus"}} +test frame-2.10 {toplevel configuration options} { + catch {destroy .t} + catch {destroy .x} + toplevel .t -container 1 -width 300 -height 120 + wm geometry .t +0+0 + set result [list \ + [catch {toplevel .x -container 1 -use [winfo id .t]} msg] $msg] + destroy .t .x + set result +} {1 {A window cannot have both the -use and the -container option set.}} + catch {destroy .t} toplevel .t -width 300 -height 150 wm geometry .t +0+0 update -set i 8 +set i 11 foreach test { {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} @@ -195,17 +206,17 @@ foreach test { {-highlightcolor #123456 #123456 non-existent {unknown color name "non-existent"}} {-highlightthickness 3 3 badValue {bad screen distance "badValue"}} - {-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}} {-width 32 32 badValue {bad screen distance "badValue"}} } { set name [lindex $test 0] - test frame-2.$i {frame configuration options} { + test frame-2.$i {toplevel configuration options} { .t configure $name [lindex $test 1] lindex [.t configure $name] 4 } [lindex $test 2] incr i if {[lindex $test 3] != ""} { - test frame-2.$i {frame configuration options} { + test frame-2.$i {toplevel configuration options} { list [catch {.t configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } diff --git a/tests/listbox.test b/tests/listbox.test index 45443f6..943c06c 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: listbox.test,v 1.13 2000/07/28 16:34:55 ericm Exp $ +# RCS: @(#) $Id: listbox.test,v 1.13.4.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1966,7 +1966,7 @@ test listbox-23.5 {ConfigureListboxItem, multiple calls} { catch {destroy .l} listbox .l set i 0 - foreach color {red orange yellow green blue darkblue violet} { + foreach color {red orange yellow green blue white violet} { .l insert end $color .l itemconfigure $i -bg $color incr i @@ -1976,7 +1976,7 @@ test listbox-23.5 {ConfigureListboxItem, multiple calls} { list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \ [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \ [.l itemcget 6 -bg] -} {red orange yellow green blue darkblue violet} +} {red orange yellow green blue white violet} catch {destroy .l} listbox .l .l insert end a b c d @@ -2101,12 +2101,20 @@ test listbox-26.5 {listbox disabled state disallows active modification} { } 0 resetGridInfo -catch {destroy .l2} -catch {destroy .t} -catch {destroy .e} -catch {destroy .partial} +eval destroy [winfo children .] option clear +test listbox-27.1 {widget deletion while active} { + destroy .l + pack [listbox .l] + update + .l configure -cursor xterm -xscrollcommand { destroy .l } + update idle + winfo exists .l +} 0 + +eval destroy [winfo children .] + # cleanup ::tcltest::cleanupTests return diff --git a/tests/macEmbed.test b/tests/macEmbed.test index 67a77a0..c1aa084 100644 --- a/tests/macEmbed.test +++ b/tests/macEmbed.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macEmbed.test,v 1.4 1999/04/16 01:51:38 stanton Exp $ +# RCS: @(#) $Id: macEmbed.test,v 1.4.16.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -216,7 +216,7 @@ test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} { pack .f1 .f2 interp create child child eval "set argv {-use [winfo id .f1]}" - load {} tk child + load {} Tk child child eval { . configure -bd 2 -highlightthickness 2 -relief sunken } diff --git a/tests/macMenu.test b/tests/macMenu.test index 37a907b..36d9b25 100644 --- a/tests/macMenu.test +++ b/tests/macMenu.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macMenu.test,v 1.3.16.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: macMenu.test,v 1.3.16.2 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -852,7 +852,7 @@ test macMenu-21.3 {TkpSetMainMenubar - different interps} { catch {destroy .m1} catch {interp delete testinterp} interp create testinterp - load {} tk testinterp + load {} Tk testinterp menu .m1 . configure -menu .m1 raise . diff --git a/tests/menu.test b/tests/menu.test index 692eacf..814c7af 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menu.test,v 1.5.4.1 2001/02/28 23:29:56 dgp Exp $ +# RCS: @(#) $Id: menu.test,v 1.5.4.2 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -2300,7 +2300,7 @@ test menu-26.1 {DestroyMenuHashTable} { test menu-27.1 {GetMenuHashTable} { catch {interp destroy testinterp} interp create testinterp - load {} tk testinterp + load {} Tk testinterp list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp] } {0 .m1 {}} diff --git a/tests/menubut.test b/tests/menubut.test index 619f9e9..aa0c0d0 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menubut.test,v 1.5 1999/04/21 21:53:29 rjohnson Exp $ +# RCS: @(#) $Id: menubut.test,v 1.5.16.1 2001/07/03 20:01:09 dgp 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, @@ -138,7 +138,7 @@ test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} { } {3} test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} { llength [.mb configure] -} {32} +} {33} test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.mb configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} diff --git a/tests/safe.test b/tests/safe.test index b791811..3e83792 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -6,12 +6,32 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: safe.test,v 1.6 1999/12/14 06:53:13 hobbs Exp $ +# RCS: @(#) $Id: safe.test,v 1.6.6.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } +## NOTE: Any time tests fail here with an error like: + +# Can't find a usable tk.tcl in the following directories: +# {$p(:26:)} +# +# $p(:26:)/tk.tcl: script error +# script error +# invoked from within +# "source {$p(:26:)/tk.tcl}" +# ("uplevel" body line 1) +# invoked from within +# "uplevel #0 [list source $file]" +# +# +# This probably means that tk wasn't installed properly. + +## it indicates that something went wrong sourcing tk.tcl. +## Ensure that any changes that occured to tk.tcl will work or +## are properly prevented in a safe interpreter. -- hobbs + foreach i [winfo children .] { destroy $i } @@ -176,16 +196,3 @@ test safe-7.1 {canvas printing} { unset hidden_cmds ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/select.test b/tests/select.test index 4879a15..83650dd 100644 --- a/tests/select.test +++ b/tests/select.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: select.test,v 1.5 2000/08/07 21:49:17 ericm Exp $ +# RCS: @(#) $Id: select.test,v 1.5.4.1 2001/07/03 20:01:09 dgp Exp $ # # Note: Multiple display selection handling will only be tested if the @@ -129,7 +129,13 @@ test select-1.3 {Tk_CreateSelHandler procedure} { set selInfo "" list [selection get TEST] $selInfo } {{Test value} {TEST 0 4000}} -test select-1.4 {Tk_CreateSelHandler procedure} { +test select-1.4.1 {Tk_CreateSelHandler procedure} {unixOnly} { + setup + selection handle .f1 {handler TEST} TEST + selection handle .f1 {handler STRING} + lsort [selection get TARGETS] +} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} +test select-1.4.2 {Tk_CreateSelHandler procedure} {macOrPc} { setup selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} @@ -144,7 +150,20 @@ test select-1.5 {Tk_CreateSelHandler procedure} { set selInfo "" list [selection get] $selInfo } {{} {STRING 0 4000}} -test select-1.6 {Tk_CreateSelHandler procedure} { +test select-1.6.1 {Tk_CreateSelHandler procedure} {unixOnly} { + global selValue selInfo + setup + selection handle .f1 {handler TEST} TEST + selection handle .f1 {handler STRING} + set selValue "" + set selInfo "" + selection get + selection get -type TEST + selection handle .f1 {handler TEST2} TEST + selection get -type TEST + list [set selInfo] [lsort [selection get TARGETS]] +} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} +test select-1.6.2 {Tk_CreateSelHandler procedure} {macOrPc} { global selValue selInfo setup selection handle .f1 {handler TEST} TEST @@ -157,7 +176,15 @@ test select-1.6 {Tk_CreateSelHandler procedure} { selection get -type TEST list [set selInfo] [lsort [selection get TARGETS]] } {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-1.7 {Tk_CreateSelHandler procedure} { +test select-1.7.1 {Tk_CreateSelHandler procedure} {unixOnly} { + setup + selection own -selection CLIPBOARD .f1 + selection handle -selection CLIPBOARD .f1 {handler TEST} TEST + selection handle -selection PRIMARY .f1 {handler TEST2} STRING + list [lsort [selection get -selection PRIMARY TARGETS]] \ + [lsort [selection get -selection CLIPBOARD TARGETS]] +} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-1.7.2 {Tk_CreateSelHandler procedure} {macOrPc} { setup selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST @@ -173,7 +200,34 @@ test select-1.8 {Tk_CreateSelHandler procedure} { ############################################################################## -test select-2.1 {Tk_DeleteSelHandler procedure} { +test select-2.1 {Tk_DeleteSelHandler procedure} {unixOnly} { + setup + selection handle .f1 {handler STRING} + selection handle -type TEST .f1 {handler TEST} + selection handle -type USER .f1 {handler USER} + set result [list [lsort [selection get TARGETS]]] + selection handle -type TEST .f1 {} + lappend result [lsort [selection get TARGETS]] +} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}} +test select-2.2 {Tk_DeleteSelHandler procedure} {unixOnly} { + setup + selection handle .f1 {handler STRING} + selection handle -type TEST .f1 {handler TEST} + selection handle -type USER .f1 {handler USER} + set result [list [lsort [selection get TARGETS]]] + selection handle -type USER .f1 {} + lappend result [lsort [selection get TARGETS]] +} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} +test select-2.3 {Tk_DeleteSelHandler procedure} {unixOnly} { + setup + selection own -selection CLIPBOARD .f1 + selection handle -selection PRIMARY .f1 {handler STRING} + selection handle -selection CLIPBOARD .f1 {handler STRING} + selection handle -selection CLIPBOARD .f1 {} + list [lsort [selection get TARGETS]] \ + [lsort [selection get -selection CLIPBOARD TARGETS]] +} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-2.4 {Tk_DeleteSelHandler procedure} {macOrPc} { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -182,7 +236,7 @@ test select-2.1 {Tk_DeleteSelHandler procedure} { selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} -test select-2.2 {Tk_DeleteSelHandler procedure} { +test select-2.5 {Tk_DeleteSelHandler procedure} {macOrPc} { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -191,7 +245,7 @@ test select-2.2 {Tk_DeleteSelHandler procedure} { selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.3 {Tk_DeleteSelHandler procedure} { +test select-2.6 {Tk_DeleteSelHandler procedure} {macOrPc} { setup selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} @@ -200,7 +254,7 @@ test select-2.3 {Tk_DeleteSelHandler procedure} { list [lsort [selection get TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] } {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.4 {Tk_DeleteSelHandler procedure} { +test select-2.7 {Tk_DeleteSelHandler procedure} { setup selection handle .f1 {handler STRING} list [selection handle .f1 {}] [selection handle .f1 {}] diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test index 41e304b..138ade7 100644 --- a/tests/unixEmbed.test +++ b/tests/unixEmbed.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixEmbed.test,v 1.7 1999/04/21 21:53:30 rjohnson Exp $ +# RCS: @(#) $Id: unixEmbed.test,v 1.7.16.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -550,7 +550,7 @@ test unixEmbed-8.2 {TkpClaimFocus procedure} { pack .f1 .f2 interp create child child eval "set argv {-use [winfo id .f1]}" - load {} tk child + load {} Tk child child eval { . configure -bd 2 -highlightthickness 2 -relief sunken } diff --git a/tests/unixWm.test b/tests/unixWm.test index 61c8a5a..bd8c697 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixWm.test,v 1.12 2000/03/29 00:09:07 ericm Exp $ +# RCS: @(#) $Id: unixWm.test,v 1.12.6.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1832,7 +1832,7 @@ test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} { wm geometry .t +0+0 tkwait visibility .t interp create slave - load {} tk slave + load {} Tk slave slave eval {wm geometry . 200x200+0+0; tkwait visibility .} set result [list [winfo containing 100 100] \ [slave eval {winfo containing 100 100}]] diff --git a/tests/winClipboard.test b/tests/winClipboard.test index fca13eb..44f171b 100644 --- a/tests/winClipboard.test +++ b/tests/winClipboard.test @@ -10,7 +10,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winClipboard.test,v 1.7 2000/04/12 18:52:14 hobbs Exp $ +# RCS: @(#) $Id: winClipboard.test,v 1.7.6.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -33,23 +33,31 @@ test winClipboard-1.1 {TkSelGetSelection} {pcOnly} { test winClipboard-1.2 {TkSelGetSelection} {pcOnly} { clipboard clear clipboard append {} - list [selection get -selection CLIPBOARD] [testclipboard] + catch {selection get -selection CLIPBOARD} r1 + catch {testclipboard} r2 + list $r1 $r2 } {{} {}} test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { clipboard clear clipboard append abcd update - list [selection get -selection CLIPBOARD] [testclipboard] + catch {selection get -selection CLIPBOARD} r1 + catch {testclipboard} r2 + list $r1 $r2 } {abcd abcd} test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { clipboard clear clipboard append "line 1\nline 2" - list [selection get -selection CLIPBOARD] [testclipboard] + catch {selection get -selection CLIPBOARD} r1 + catch {testclipboard} r2 + list $r1 $r2 } [list "line 1\nline 2" "line 1\r\nline 2"] test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { clipboard clear clipboard append "line 1\u00c7\nline 2" - list [selection get -selection CLIPBOARD] [testclipboard] + catch {selection get -selection CLIPBOARD} r1 + catch {testclipboard} r2 + list $r1 $r2 } [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]] test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly} { @@ -57,14 +65,18 @@ test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly} { clipboard append -type OUR_ACTION "action data" clipboard append "string data" update - list [selection get -selection CLIPBOARD -type OUR_ACTION] [testclipboard] + catch {selection get -selection CLIPBOARD -type OUR_ACTION} r1 + catch {testclipboard} r2 + list $r1 $r2 } [list "action data" "string data"] test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {pcOnly} { clipboard clear clipboard append -type OUR_ACTION "new data" clipboard append "more data in string" update - list [testclipboard] [selection get -selection CLIPBOARD -type OUR_ACTION] + catch {testclipboard} r1 + catch {selection get -selection CLIPBOARD -type OUR_ACTION} r2 + list $r1 $r2 } [list "more data in string" "new data"] # cleanup diff --git a/tests/winDialog.test b/tests/winDialog.test index ec23514..d1202d8 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winDialog.test,v 1.5 2000/11/02 01:19:42 hobbs Exp $ +# RCS: @(#) $Id: winDialog.test,v 1.5.4.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -126,16 +126,16 @@ test winDialog-5.8 {GetFileName: extension begins with .} {nt} { SetText 0x480 bar Click 1 } - set x -} [file join [pwd] bar.foo] + string totitle $x +} [string totitle [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] + string totitle $x +} [string totitle [file join [pwd] bar.foo]] test winDialog-5.10 {GetFileName: file types} {nt} { # case FILE_TYPES: @@ -173,8 +173,8 @@ test winDialog-5.14 {GetFileName: initial file} {nt} { then { Click 1 } - set x -} [file join [pwd] "12x 456"] + string totitle $x +} [string totitle [file join [pwd] "12x 456"]] test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} { # if (Tcl_TranslateFileName(interp, string, &ds) == NULL) list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg @@ -189,8 +189,8 @@ test winDialog-5.16 {GetFileName: initial file: long name} {nt} { then { Click 1 } - set x -} [string range [file join [pwd] $a] 0 257] + string totitle $x +} [string totitle [string range [file join [pwd] $a] 0 257]] test winDialog-5.17 {GetFileName: parent} {nt} { # case FILE_PARENT: diff --git a/unix/Makefile.in b/unix/Makefile.in index 2fe60ef..e2ec084 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.49 2000/09/29 21:40:54 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.49.4.1 2001/07/03 20:01:09 dgp Exp $ # Current Tk version; used in various names. @@ -101,7 +101,12 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ + +# Flags to pass to the linker +LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ +LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ +LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@ # A "-I" switch that can be used when compiling to make all of the # X11 include files accessible (the configure script will try to @@ -174,7 +179,7 @@ TCL_EXE = tclsh SHLIB_CFLAGS = @SHLIB_CFLAGS@ # To enable support for stubs in Tcl. -STUB_LIB_FILE = @STUB_LIB_FILE@ +STUB_LIB_FILE = @TK_STUB_LIB_FILE@ TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@ #TK_STUB_LIB_FILE = libtkstub.a @@ -385,7 +390,7 @@ objs: ${OBJS} wish: $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) - $(CC) @LDFLAGS@ $(WISH_OBJS) \ + $(CC) $(LDFLAGS) $(WISH_OBJS) \ @TK_BUILD_LIB_SPEC@ \ $(WISH_LIBS) $(TK_CC_SEARCH_FLAGS) -o wish @@ -396,12 +401,12 @@ ${TCL_BIN_DIR}/tcltest: make tcltest tktest: ${TCL_BIN_DIR}/tcltest $(TKTEST_OBJS) $(TK_LIB_FILE) - ${CC} @LDFLAGS@ $(TKTEST_OBJS) \ + ${CC} $(LDFLAGS) $(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} @LDFLAGS@ test.o tkTest.o tkSquare.o \ + ${CC} $(LDFLAGS) test.o tkTest.o tkSquare.o \ @TK_BUILD_LIB_SPEC@ \ $(WISH_LIBS) $(TK_LD_SEARCH_FLAGS) -lXt -o xttest @@ -449,6 +454,18 @@ runtest: tktest TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \ ./tktest +# This target can be used to run wish from the build directory +# via `make shell` or `make shell SCRIPT=/tmp/foo.tcl` +shell: wish + LD_LIBRARY_PATH=`pwd`:${TCL_BIN_DIR}:${LD_LIBRARY_PATH}; \ + export LD_LIBRARY_PATH; \ + LIBPATH=`pwd`:${TCL_BIN_DIR}:${LIBPATH}; export LIBPATH; \ + SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \ + export SHLIB_PATH; \ + TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \ + TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \ + ./wish $(SCRIPT) + install: all install-binaries install-libraries install-demos install-doc # Note: before running ranlib below, must cd to target directory because diff --git a/unix/configure b/unix/configure index 01bfffd..df2b044 100755 --- a/unix/configure +++ b/unix/configure @@ -537,12 +537,12 @@ else fi -# RCS: @(#) $Id: configure.in,v 1.55 2000/09/06 19:05:16 hobbs Exp $ +# RCS: @(#) $Id: configure,v 1.10 2001/06/26 20:31:58 mdejong Exp $ TK_VERSION=8.4 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=4 -TK_PATCH_LEVEL="a2" +TK_PATCH_LEVEL="a3" VERSION=${TK_VERSION} LOCALES="de en es fr" @@ -556,10 +556,20 @@ fi srcdir=`cd $srcdir ; pwd` TK_SRC_DIR=`cd $srcdir/..; pwd` +#------------------------------------------------------------------------ +# Standard compiler checks +#------------------------------------------------------------------------ + +# If the user did not set CFLAGS, set it now to keep +# the AC_PROG_CC macro from adding "-g -O2". +if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" +fi + # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:563: checking for $ac_word" >&5 +echo "configure:573: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -589,7 +599,7 @@ if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:593: checking for $ac_word" >&5 +echo "configure:603: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -640,7 +650,7 @@ fi # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:644: checking for $ac_word" >&5 +echo "configure:654: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -672,7 +682,7 @@ fi fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:676: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:686: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. @@ -683,12 +693,12 @@ cross_compiling=$ac_cv_prog_cc_cross cat > conftest.$ac_ext << EOF -#line 687 "configure" +#line 697 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:692: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:702: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -714,12 +724,12 @@ if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:718: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:728: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:723: checking whether we are using GNU C" >&5 +echo "configure:733: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -728,7 +738,7 @@ else yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:732: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:742: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -747,7 +757,7 @@ ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:751: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:761: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -781,7 +791,7 @@ fi # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:785: checking for $ac_word" >&5 +echo "configure:795: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -814,7 +824,7 @@ fi #------------------------------------------------------------------------ echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:818: checking how to run the C preprocessor" >&5 +echo "configure:828: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -829,13 +839,13 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 833 "configure" +#line 843 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:839: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:849: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -846,13 +856,13 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 850 "configure" +#line 860 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:856: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:866: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -863,13 +873,13 @@ else rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF -#line 867 "configure" +#line 877 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:873: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:883: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -897,17 +907,17 @@ for ac_hdr in unistd.h limits.h do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:901: checking for $ac_hdr" >&5 +echo "configure:911: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 906 "configure" +#line 916 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:911: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:921: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -940,7 +950,7 @@ done echo $ac_n "checking for building with threads""... $ac_c" 1>&6 -echo "configure:944: checking for building with threads" >&5 +echo "configure:954: checking for building with threads" >&5 # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" @@ -966,7 +976,7 @@ EOF EOF echo $ac_n "checking for pthread_mutex_init in -lpthread""... $ac_c" 1>&6 -echo "configure:970: checking for pthread_mutex_init in -lpthread" >&5 +echo "configure:980: checking for pthread_mutex_init in -lpthread" >&5 ac_lib_var=`echo pthread'_'pthread_mutex_init | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -974,7 +984,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lpthread $LIBS" cat > conftest.$ac_ext <<EOF -#line 978 "configure" +#line 988 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -985,7 +995,7 @@ int main() { pthread_mutex_init() ; return 0; } EOF -if { (eval echo configure:989: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:999: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1013,7 +1023,7 @@ fi # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] echo $ac_n "checking for __pthread_mutex_init in -lpthread""... $ac_c" 1>&6 -echo "configure:1017: checking for __pthread_mutex_init in -lpthread" >&5 +echo "configure:1027: checking for __pthread_mutex_init in -lpthread" >&5 ac_lib_var=`echo pthread'_'__pthread_mutex_init | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1021,7 +1031,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lpthread $LIBS" cat > conftest.$ac_ext <<EOF -#line 1025 "configure" +#line 1035 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1032,7 +1042,7 @@ int main() { __pthread_mutex_init() ; return 0; } EOF -if { (eval echo configure:1036: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1046: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1060,7 +1070,7 @@ fi THREADS_LIBS=" -lpthread" else echo $ac_n "checking for pthread_mutex_init in -lpthreads""... $ac_c" 1>&6 -echo "configure:1064: checking for pthread_mutex_init in -lpthreads" >&5 +echo "configure:1074: checking for pthread_mutex_init in -lpthreads" >&5 ac_lib_var=`echo pthreads'_'pthread_mutex_init | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1068,7 +1078,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lpthreads $LIBS" cat > conftest.$ac_ext <<EOF -#line 1072 "configure" +#line 1082 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1079,7 +1089,7 @@ int main() { pthread_mutex_init() ; return 0; } EOF -if { (eval echo configure:1083: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1093: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1105,7 +1115,7 @@ fi THREADS_LIBS=" -lpthreads" else echo $ac_n "checking for pthread_mutex_init in -lc""... $ac_c" 1>&6 -echo "configure:1109: checking for pthread_mutex_init in -lc" >&5 +echo "configure:1119: checking for pthread_mutex_init in -lc" >&5 ac_lib_var=`echo c'_'pthread_mutex_init | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1113,7 +1123,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lc $LIBS" cat > conftest.$ac_ext <<EOF -#line 1117 "configure" +#line 1127 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1124,7 +1134,7 @@ int main() { pthread_mutex_init() ; return 0; } EOF -if { (eval echo configure:1128: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1138: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1158,12 +1168,12 @@ fi for ac_func in pthread_attr_setstacksize do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1162: checking for $ac_func" >&5 +echo "configure:1172: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1167 "configure" +#line 1177 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1186,7 +1196,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1190: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1200: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1214,6 +1224,7 @@ done TCL_THREADS=0 echo "$ac_t""no (default)" 1>&6 fi + #------------------------------------------------------------------------------ @@ -1224,18 +1235,18 @@ done if test -z "$no_pipe"; then if test -n "$GCC"; then echo $ac_n "checking if the compiler understands -pipe""... $ac_c" 1>&6 -echo "configure:1228: checking if the compiler understands -pipe" >&5 +echo "configure:1239: checking if the compiler understands -pipe" >&5 OLDCC="$CC" CC="$CC -pipe" cat > conftest.$ac_ext <<EOF -#line 1232 "configure" +#line 1243 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:1239: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1250: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 else @@ -1270,13 +1281,13 @@ if test "${with_tcl+set}" = set; then fi echo $ac_n "checking for Tcl configuration""... $ac_c" 1>&6 -echo "configure:1274: checking for Tcl configuration" >&5 +echo "configure:1285: checking for Tcl configuration" >&5 if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else - # First check to see if --with-tclconfig was specified. + # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)` @@ -1304,7 +1315,10 @@ else # check in a few common install locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ${prefix}/lib 2>/dev/null` \ - `ls -d /usr/local/lib 2>/dev/null` ; do + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i; pwd)` break @@ -1313,7 +1327,7 @@ else fi # check in a few other private locations - if test x"${ac_cv_c_tcliconfig}" = x ; then + if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ `ls -dr ${srcdir}/../tcl[8-9].[0-9]* 2>/dev/null` ; do @@ -1340,7 +1354,7 @@ fi echo $ac_n "checking for existence of $TCL_BIN_DIR/tclConfig.sh""... $ac_c" 1>&6 -echo "configure:1344: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5 +echo "configure:1358: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5 if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then echo "$ac_t""loading" 1>&6 @@ -1371,7 +1385,7 @@ echo "configure:1344: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5 # Step 0.a: Enable 64 bit support? echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6 -echo "configure:1375: checking if 64bit support is requested" >&5 +echo "configure:1389: checking if 64bit support is requested" >&5 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" @@ -1391,7 +1405,7 @@ fi # Step 0.b: Enable Solaris 64 bit VIS support? echo $ac_n "checking if 64bit Sparc VIS support is requested""... $ac_c" 1>&6 -echo "configure:1395: checking if 64bit Sparc VIS support is requested" >&5 +echo "configure:1409: checking if 64bit Sparc VIS support is requested" >&5 # Check whether --enable-64bit-vis or --disable-64bit-vis was given. if test "${enable_64bit_vis+set}" = set; then enableval="$enable_64bit_vis" @@ -1415,7 +1429,7 @@ fi # there are a few systems, like Next, where this doesn't work. echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6 -echo "configure:1419: checking system version (for dynamic loading)" >&5 +echo "configure:1433: checking system version (for dynamic loading)" >&5 if test -f /usr/lib/NextStep/software_version; then system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else @@ -1438,7 +1452,7 @@ echo "configure:1419: checking system version (for dynamic loading)" >&5 fi echo $ac_n "checking if gcc is being used""... $ac_c" 1>&6 -echo "configure:1442: checking if gcc is being used" >&5 +echo "configure:1456: checking if gcc is being used" >&5 if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then using_gcc="yes" else @@ -1451,7 +1465,7 @@ echo "configure:1442: checking if gcc is being used" >&5 # Linux can use either -ldl or -ldld for dynamic loading. echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6 -echo "configure:1455: checking for dlopen in -ldl" >&5 +echo "configure:1469: checking for dlopen in -ldl" >&5 ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1459,7 +1473,7 @@ else ac_save_LIBS="$LIBS" LIBS="-ldl $LIBS" cat > conftest.$ac_ext <<EOF -#line 1463 "configure" +#line 1477 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1470,7 +1484,7 @@ int main() { dlopen() ; return 0; } EOF -if { (eval echo configure:1474: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1488: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1514,7 +1528,7 @@ fi TCL_EXP_FILE="" STLIB_LD="ar cr" case $system in - AIX-5*) + AIX-5.*) if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then # AIX requires the _r compiler when gcc isn't being used if test "${CC}" != "cc_r" ; then @@ -1589,7 +1603,7 @@ fi # known GMT value. echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6 -echo "configure:1593: checking for gettimeofday in -lbsd" >&5 +echo "configure:1607: checking for gettimeofday in -lbsd" >&5 ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1597,7 +1611,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lbsd $LIBS" cat > conftest.$ac_ext <<EOF -#line 1601 "configure" +#line 1615 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1608,7 +1622,7 @@ int main() { gettimeofday() ; return 0; } EOF -if { (eval echo configure:1612: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1626: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1670,7 +1684,7 @@ EOF HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*) SHLIB_SUFFIX=".sl" echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6 -echo "configure:1674: checking for shl_load in -ldld" >&5 +echo "configure:1688: checking for shl_load in -ldld" >&5 ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1678,7 +1692,7 @@ else ac_save_LIBS="$LIBS" LIBS="-ldld $LIBS" cat > conftest.$ac_ext <<EOF -#line 1682 "configure" +#line 1696 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -1689,7 +1703,7 @@ int main() { shl_load() ; return 0; } EOF -if { (eval echo configure:1693: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1707: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -1731,7 +1745,18 @@ fi LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a' ;; - IRIX-5.*|IRIX-6.*|IRIX64-6.5*) + IRIX-5.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -shared -rdata_shared" + SHLIB_LD_LIBS='${LIBS}' + SHLIB_SUFFIX=".so" + DL_OBJS="tclLoadDl.o" + DL_LIBS="" + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + EXTRA_CFLAGS="" + LDFLAGS="" + ;; + IRIX-6.*|IRIX64-6.5*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_LD_LIBS='${LIBS}' @@ -1785,17 +1810,17 @@ fi else ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dld.h""... $ac_c" 1>&6 -echo "configure:1789: checking for dld.h" >&5 +echo "configure:1814: checking for dld.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1794 "configure" +#line 1819 "configure" #include "confdefs.h" #include <dld.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1799: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1824: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1850,17 +1875,17 @@ fi # Not available on all versions: check for include file. ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6 -echo "configure:1854: checking for dlfcn.h" >&5 +echo "configure:1879: checking for dlfcn.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1859 "configure" +#line 1884 "configure" #include "confdefs.h" #include <dlfcn.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1864: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1889: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1887,9 +1912,9 @@ if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then LDFLAGS="" LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' echo $ac_n "checking for ELF""... $ac_c" 1>&6 -echo "configure:1891: checking for ELF" >&5 +echo "configure:1916: checking for ELF" >&5 cat > conftest.$ac_ext <<EOF -#line 1893 "configure" +#line 1918 "configure" #include "confdefs.h" #ifdef __ELF__ @@ -2067,6 +2092,15 @@ EOF TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[0-6]*) + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + cat >> confdefs.h <<\EOF +#define _REENTRANT 1 +EOF + + SHLIB_CFLAGS="-KPIC" SHLIB_LD="/usr/ccs/bin/ld -G -z text" @@ -2081,6 +2115,15 @@ EOF LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' ;; SunOS-5*) + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + cat >> confdefs.h <<\EOF +#define _REENTRANT 1 +EOF + + SHLIB_CFLAGS="-KPIC" SHLIB_LD="/usr/ccs/bin/ld -G -z text" LDFLAGS="" @@ -2142,17 +2185,17 @@ EOF # that don't grok the -Bexport option. Test that it does. hold_ldflags=$LDFLAGS echo $ac_n "checking for ld accepts -Bexport flag""... $ac_c" 1>&6 -echo "configure:2146: checking for ld accepts -Bexport flag" >&5 +echo "configure:2189: checking for ld accepts -Bexport flag" >&5 LDFLAGS="${LDFLAGS} -Wl,-Bexport" cat > conftest.$ac_ext <<EOF -#line 2149 "configure" +#line 2192 "configure" #include "confdefs.h" int main() { int i; ; return 0; } EOF -if { (eval echo configure:2156: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2199: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* found=yes else @@ -2198,9 +2241,9 @@ rm -f conftest* if test "x$DL_OBJS" = "xtclLoadAout.o" ; then echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6 -echo "configure:2202: checking sys/exec.h" >&5 +echo "configure:2245: checking sys/exec.h" >&5 cat > conftest.$ac_ext <<EOF -#line 2204 "configure" +#line 2247 "configure" #include "confdefs.h" #include <sys/exec.h> int main() { @@ -2218,7 +2261,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:2222: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2265: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_ok=usable else @@ -2236,9 +2279,9 @@ EOF else echo $ac_n "checking a.out.h""... $ac_c" 1>&6 -echo "configure:2240: checking a.out.h" >&5 +echo "configure:2283: checking a.out.h" >&5 cat > conftest.$ac_ext <<EOF -#line 2242 "configure" +#line 2285 "configure" #include "confdefs.h" #include <a.out.h> int main() { @@ -2256,7 +2299,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:2260: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2303: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_ok=usable else @@ -2274,9 +2317,9 @@ EOF else echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6 -echo "configure:2278: checking sys/exec_aout.h" >&5 +echo "configure:2321: checking sys/exec_aout.h" >&5 cat > conftest.$ac_ext <<EOF -#line 2280 "configure" +#line 2323 "configure" #include "confdefs.h" #include <sys/exec_aout.h> int main() { @@ -2294,7 +2337,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:2298: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2341: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_ok=usable else @@ -2353,7 +2396,7 @@ fi if test "$DL_OBJS" != "tclLoadNone.o" ; then if test "$using_gcc" = "yes" ; then case $system in - AIX-[1-4]*) + AIX-*) ;; BSD/OS*) ;; @@ -2389,7 +2432,7 @@ fi echo $ac_n "checking for build with symbols""... $ac_c" 1>&6 -echo "configure:2393: checking for build with symbols" >&5 +echo "configure:2436: checking for build with symbols" >&5 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" @@ -2398,14 +2441,15 @@ else tcl_ok=no fi +# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "yes"; then - CFLAGS_DEFAULT="${CFLAGS_DEBUG}" - LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' + LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=g echo "$ac_t""yes" 1>&6 else - CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE}" - LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' + LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" echo "$ac_t""no" 1>&6 fi @@ -2413,7 +2457,6 @@ fi LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' -CFLAGS=${CFLAGS_DEFAULT} TK_DBGX=${DBGX} #------------------------------------------------------------------------ @@ -2433,12 +2476,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for sin""... $ac_c" 1>&6 -echo "configure:2437: checking for sin" >&5 +echo "configure:2480: checking for sin" >&5 if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2442 "configure" +#line 2485 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char sin(); below. */ @@ -2461,7 +2504,7 @@ sin(); ; return 0; } EOF -if { (eval echo configure:2465: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2508: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_sin=yes" else @@ -2482,7 +2525,7 @@ MATH_LIBS="-lm" fi echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6 -echo "configure:2486: checking for main in -lieee" >&5 +echo "configure:2529: checking for main in -lieee" >&5 ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -2490,14 +2533,14 @@ else ac_save_LIBS="$LIBS" LIBS="-lieee $LIBS" cat > conftest.$ac_ext <<EOF -#line 2494 "configure" +#line 2537 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:2501: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2544: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -2528,7 +2571,7 @@ fi libbsd=no if test "`uname -s`" = "AIX" ; then echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6 -echo "configure:2532: checking for gettimeofday in -lbsd" >&5 +echo "configure:2575: checking for gettimeofday in -lbsd" >&5 ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -2536,7 +2579,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lbsd $LIBS" cat > conftest.$ac_ext <<EOF -#line 2540 "configure" +#line 2583 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -2547,7 +2590,7 @@ int main() { gettimeofday() ; return 0; } EOF -if { (eval echo configure:2551: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2594: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -2578,9 +2621,9 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking stdlib.h""... $ac_c" 1>&6 -echo "configure:2582: checking stdlib.h" >&5 +echo "configure:2625: checking stdlib.h" >&5 cat > conftest.$ac_ext <<EOF -#line 2584 "configure" +#line 2627 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2595,7 +2638,7 @@ fi rm -f conftest* cat > conftest.$ac_ext <<EOF -#line 2599 "configure" +#line 2642 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2609,7 +2652,7 @@ fi rm -f conftest* cat > conftest.$ac_ext <<EOF -#line 2613 "configure" +#line 2656 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2641,16 +2684,16 @@ echo "$ac_t""$tk_ok" 1>&6 #-------------------------------------------------------------------- echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6 -echo "configure:2645: checking fd_set and sys/select" >&5 +echo "configure:2688: checking fd_set and sys/select" >&5 cat > conftest.$ac_ext <<EOF -#line 2647 "configure" +#line 2690 "configure" #include "confdefs.h" #include <sys/types.h> int main() { fd_set readMask, writeMask; ; return 0; } EOF -if { (eval echo configure:2654: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2697: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tk_ok=yes else @@ -2662,7 +2705,7 @@ fi rm -f conftest* if test $tk_ok = no; then cat > conftest.$ac_ext <<EOF -#line 2666 "configure" +#line 2709 "configure" #include "confdefs.h" #include <sys/select.h> EOF @@ -2694,12 +2737,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:2698: checking for ANSI C header files" >&5 +echo "configure:2741: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2703 "configure" +#line 2746 "configure" #include "confdefs.h" #include <stdlib.h> #include <stdarg.h> @@ -2707,7 +2750,7 @@ else #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2711: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2754: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2724,7 +2767,7 @@ rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 2728 "configure" +#line 2771 "configure" #include "confdefs.h" #include <string.h> EOF @@ -2742,7 +2785,7 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 2746 "configure" +#line 2789 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2763,7 +2806,7 @@ if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext <<EOF -#line 2767 "configure" +#line 2810 "configure" #include "confdefs.h" #include <ctype.h> #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -2774,7 +2817,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF -if { (eval echo configure:2778: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:2821: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else @@ -2798,12 +2841,12 @@ EOF fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:2802: checking for mode_t" >&5 +echo "configure:2845: checking for mode_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2807 "configure" +#line 2850 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -2831,12 +2874,12 @@ EOF fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:2835: checking for pid_t" >&5 +echo "configure:2878: checking for pid_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2840 "configure" +#line 2883 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -2864,12 +2907,12 @@ EOF fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:2868: checking for size_t" >&5 +echo "configure:2911: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2873 "configure" +#line 2916 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -2897,12 +2940,12 @@ EOF fi echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:2901: checking for uid_t in sys/types.h" >&5 +echo "configure:2944: checking for uid_t in sys/types.h" >&5 if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2906 "configure" +#line 2949 "configure" #include "confdefs.h" #include <sys/types.h> EOF @@ -2939,17 +2982,17 @@ for ac_hdr in sys/time.h do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2943: checking for $ac_hdr" >&5 +echo "configure:2986: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2948 "configure" +#line 2991 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2953: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2996: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2976,12 +3019,12 @@ fi done echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:2980: checking whether time.h and sys/time.h may both be included" >&5 +echo "configure:3023: checking whether time.h and sys/time.h may both be included" >&5 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2985 "configure" +#line 3028 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/time.h> @@ -2990,7 +3033,7 @@ int main() { struct tm *tp; ; return 0; } EOF -if { (eval echo configure:2994: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3037: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -3016,16 +3059,16 @@ fi #------------------------------------------- echo $ac_n "checking pw_gecos in struct pwd""... $ac_c" 1>&6 -echo "configure:3020: checking pw_gecos in struct pwd" >&5 +echo "configure:3063: checking pw_gecos in struct pwd" >&5 cat > conftest.$ac_ext <<EOF -#line 3022 "configure" +#line 3065 "configure" #include "confdefs.h" #include <pwd.h> int main() { struct passwd pwd; pwd.pw_gecos; ; return 0; } EOF -if { (eval echo configure:3029: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3072: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tk_ok=yes else @@ -3058,7 +3101,7 @@ fi # Uses ac_ vars as temps to allow command line to override cache and checks. # --without-x overrides everything else, but does not touch the cache. echo $ac_n "checking for X""... $ac_c" 1>&6 -echo "configure:3062: checking for X" >&5 +echo "configure:3105: checking for X" >&5 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then @@ -3120,12 +3163,12 @@ if test "$ac_x_includes" = NO; then # First, try using that file with no special directory specified. cat > conftest.$ac_ext <<EOF -#line 3124 "configure" +#line 3167 "configure" #include "confdefs.h" #include <$x_direct_test_include> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3129: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3172: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -3194,14 +3237,14 @@ if test "$ac_x_libraries" = NO; then ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <<EOF -#line 3198 "configure" +#line 3241 "configure" #include "confdefs.h" int main() { ${x_direct_test_function}() ; return 0; } EOF -if { (eval echo configure:3205: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3248: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* LIBS="$ac_save_LIBS" # We can link X programs with no special library path. @@ -3291,12 +3334,12 @@ fi if test "$no_x" = ""; then if test "$x_includes" = ""; then cat > conftest.$ac_ext <<EOF -#line 3295 "configure" +#line 3338 "configure" #include "confdefs.h" #include <X11/XIntrinsic.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3300: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3343: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -3316,15 +3359,15 @@ rm -f conftest* fi if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then echo $ac_n "checking for X11 header files""... $ac_c" 1>&6 -echo "configure:3320: checking for X11 header files" >&5 +echo "configure:3363: checking for X11 header files" >&5 XINCLUDES="# no special path needed" cat > conftest.$ac_ext <<EOF -#line 3323 "configure" +#line 3366 "configure" #include "confdefs.h" #include <X11/Intrinsic.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3328: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3371: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -3360,7 +3403,7 @@ rm -f conftest* if test "$no_x" = yes; then echo $ac_n "checking for X11 libraries""... $ac_c" 1>&6 -echo "configure:3364: checking for X11 libraries" >&5 +echo "configure:3407: checking for X11 libraries" >&5 XLIBSW=nope dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib" for i in $dirs ; do @@ -3380,7 +3423,7 @@ echo "configure:3364: checking for X11 libraries" >&5 fi if test "$XLIBSW" = nope ; then echo $ac_n "checking for XCreateWindow in -lXwindow""... $ac_c" 1>&6 -echo "configure:3384: checking for XCreateWindow in -lXwindow" >&5 +echo "configure:3427: checking for XCreateWindow in -lXwindow" >&5 ac_lib_var=`echo Xwindow'_'XCreateWindow | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3388,7 +3431,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lXwindow $LIBS" cat > conftest.$ac_ext <<EOF -#line 3392 "configure" +#line 3435 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3399,7 +3442,7 @@ int main() { XCreateWindow() ; return 0; } EOF -if { (eval echo configure:3403: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3446: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3484,7 +3527,7 @@ esac #-------------------------------------------------------------------- echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 -echo "configure:3488: checking for main in -lXbsd" >&5 +echo "configure:3531: checking for main in -lXbsd" >&5 ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3492,14 +3535,14 @@ else ac_save_LIBS="$LIBS" LIBS="-lXbsd $LIBS" cat > conftest.$ac_ext <<EOF -#line 3496 "configure" +#line 3539 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:3503: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3546: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3522,12 +3565,12 @@ fi tk_checkBoth=0 echo $ac_n "checking for connect""... $ac_c" 1>&6 -echo "configure:3526: checking for connect" >&5 +echo "configure:3569: checking for connect" >&5 if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3531 "configure" +#line 3574 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect(); below. */ @@ -3550,7 +3593,7 @@ connect(); ; return 0; } EOF -if { (eval echo configure:3554: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3597: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_connect=yes" else @@ -3572,7 +3615,7 @@ fi if test "$tk_checkSocket" = 1; then echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6 -echo "configure:3576: checking for main in -lsocket" >&5 +echo "configure:3619: checking for main in -lsocket" >&5 ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3580,14 +3623,14 @@ else ac_save_LIBS="$LIBS" LIBS="-lsocket $LIBS" cat > conftest.$ac_ext <<EOF -#line 3584 "configure" +#line 3627 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:3591: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3634: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3613,12 +3656,12 @@ if test "$tk_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" echo $ac_n "checking for accept""... $ac_c" 1>&6 -echo "configure:3617: checking for accept" >&5 +echo "configure:3660: checking for accept" >&5 if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3622 "configure" +#line 3665 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char accept(); below. */ @@ -3641,7 +3684,7 @@ accept(); ; return 0; } EOF -if { (eval echo configure:3645: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3688: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_accept=yes" else @@ -3663,12 +3706,12 @@ fi fi echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 -echo "configure:3667: checking for gethostbyname" >&5 +echo "configure:3710: checking for gethostbyname" >&5 if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3672 "configure" +#line 3715 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname(); below. */ @@ -3691,7 +3734,7 @@ gethostbyname(); ; return 0; } EOF -if { (eval echo configure:3695: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3738: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else @@ -3709,7 +3752,7 @@ if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then else echo "$ac_t""no" 1>&6 echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6 -echo "configure:3713: checking for main in -lnsl" >&5 +echo "configure:3756: checking for main in -lnsl" >&5 ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3717,14 +3760,14 @@ else ac_save_LIBS="$LIBS" LIBS="-lnsl $LIBS" cat > conftest.$ac_ext <<EOF -#line 3721 "configure" +#line 3764 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:3728: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3771: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3764,13 +3807,13 @@ LIBS="$LIBS$THREADS_LIBS" if test -d /usr/include/mit ; then echo $ac_n "checking MIT X libraries""... $ac_c" 1>&6 -echo "configure:3768: checking MIT X libraries" >&5 +echo "configure:3811: checking MIT X libraries" >&5 tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS -I/usr/include/mit" tk_oldLibs=$LIBS LIBS="$LIBS -lX11-mit" cat > conftest.$ac_ext <<EOF -#line 3774 "configure" +#line 3817 "configure" #include "confdefs.h" #include <X11/Xlib.h> @@ -3781,7 +3824,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:3785: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3828: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* echo "$ac_t""yes" 1>&6 @@ -3808,12 +3851,12 @@ fi MATH_LIBS="" echo $ac_n "checking for sin""... $ac_c" 1>&6 -echo "configure:3812: checking for sin" >&5 +echo "configure:3855: checking for sin" >&5 if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3817 "configure" +#line 3860 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char sin(); below. */ @@ -3836,7 +3879,7 @@ sin(); ; return 0; } EOF -if { (eval echo configure:3840: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3883: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_sin=yes" else @@ -3857,7 +3900,7 @@ MATH_LIBS="-lm" fi echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6 -echo "configure:3861: checking for main in -lieee" >&5 +echo "configure:3904: checking for main in -lieee" >&5 ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3865,14 +3908,14 @@ else ac_save_LIBS="$LIBS" LIBS="-lieee $LIBS" cat > conftest.$ac_ext <<EOF -#line 3869 "configure" +#line 3912 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:3876: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3919: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3899,14 +3942,14 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6 -echo "configure:3903: checking whether char is unsigned" >&5 +echo "configure:3946: checking whether char is unsigned" >&5 if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$GCC" = yes; then # GCC predefines this symbol on systems where it applies. cat > conftest.$ac_ext <<EOF -#line 3910 "configure" +#line 3953 "configure" #include "confdefs.h" #ifdef __CHAR_UNSIGNED__ yes @@ -3928,7 +3971,7 @@ if test "$cross_compiling" = yes; then { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; } else cat > conftest.$ac_ext <<EOF -#line 3932 "configure" +#line 3975 "configure" #include "confdefs.h" /* volatile prevents gcc2 from optimizing the test away on sparcs. */ #if !defined(__STDC__) || __STDC__ != 1 @@ -3938,7 +3981,7 @@ main() { volatile char c = 255; exit(c < 0); } EOF -if { (eval echo configure:3942: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3985: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then ac_cv_c_char_unsigned=yes else @@ -3971,12 +4014,12 @@ fi echo $ac_n "checking for strtod""... $ac_c" 1>&6 -echo "configure:3975: checking for strtod" >&5 +echo "configure:4018: checking for strtod" >&5 if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3980 "configure" +#line 4023 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strtod(); below. */ @@ -3999,7 +4042,7 @@ strtod(); ; return 0; } EOF -if { (eval echo configure:4003: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4046: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strtod=yes" else @@ -4021,12 +4064,12 @@ fi if test "$tcl_strtod" = 1; then echo $ac_n "checking for Solaris2.4/Tru64 strtod bugs""... $ac_c" 1>&6 -echo "configure:4025: checking for Solaris2.4/Tru64 strtod bugs" >&5 +echo "configure:4068: checking for Solaris2.4/Tru64 strtod bugs" >&5 if test "$cross_compiling" = yes; then tcl_ok=0 else cat > conftest.$ac_ext <<EOF -#line 4030 "configure" +#line 4073 "configure" #include "confdefs.h" extern double strtod(); @@ -4046,7 +4089,7 @@ else exit(0); } EOF -if { (eval echo configure:4050: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:4093: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then tcl_ok=1 else @@ -4078,7 +4121,7 @@ EOF echo $ac_n "checking how to build libraries""... $ac_c" 1>&6 -echo "configure:4082: checking how to build libraries" >&5 +echo "configure:4125: checking how to build libraries" >&5 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -4117,7 +4160,7 @@ TCL_STUB_LIB_SPEC='-L$(TCL_BIN_DIR) $(TCL_STUB_LIB_FLAG)' if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then TK_SHLIB_CFLAGS="${SHLIB_CFLAGS}" TK_LIB_FILE=libtk${TK_SHARED_LIB_SUFFIX} - MAKE_LIB="\${SHLIB_LD} -o \${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_STUB_LIB_SPEC} \${SHLIB_LD_LIBS}" + MAKE_LIB="\${SHLIB_LD} -o \$@ \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_STUB_LIB_SPEC} \${SHLIB_LD_LIBS}" RANLIB=":" # TCL_STUB_FLAGS="-DUSE_TCL_STUBS" @@ -4125,7 +4168,7 @@ if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then else TK_SHLIB_CFLAGS="" TK_LIB_FILE=libtk${TK_UNSHARED_LIB_SUFFIX} - MAKE_LIB="ar cr \${TK_LIB_FILE} \${OBJS}" + MAKE_LIB="ar cr \$@ \${OBJS}" TCL_STUB_FLAGS="" fi @@ -4166,11 +4209,10 @@ TK_SHARED_BUILD=${SHARED_BUILD} #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TK_VERSION} -eval "STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}" - -MAKE_STUB_LIB="ar cr \${STUB_LIB_FILE} \${STUB_LIB_OBJS}" +eval "TK_STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}" -TK_STUB_LIB_FILE=${STUB_LIB_FILE} +# FIXME: Should we add MAKE_STUB_LIB to tclConfig.sh ? +MAKE_STUB_LIB="ar cr \$@ \${STUB_LIB_OBJS}" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then eval TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}\${TK_DBGX}" @@ -4194,9 +4236,11 @@ TK_STUB_LIB_PATH="${exec_prefix}/lib/${TK_STUB_LIB_FILE}" +eval "TK_LIB_FILE=${TK_LIB_FILE}" + + -eval "TK_LIB_FILE=${TK_LIB_FILE}" @@ -4387,6 +4431,7 @@ s%@mandir@%$mandir%g s%@CC@%$CC%g s%@RANLIB@%$RANLIB%g s%@CPP@%$CPP%g +s%@TCL_THREADS@%$TCL_THREADS%g s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g @@ -4394,7 +4439,6 @@ s%@DL_LIBS@%$DL_LIBS%g s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g -s%@STUB_LIB_FILE@%$STUB_LIB_FILE%g s%@TK_STUB_LIB_FILE@%$TK_STUB_LIB_FILE%g s%@TK_STUB_LIB_FLAG@%$TK_STUB_LIB_FLAG%g s%@TK_BUILD_STUB_LIB_SPEC@%$TK_BUILD_STUB_LIB_SPEC%g @@ -4407,9 +4451,11 @@ s%@TK_BUILD_EXP_FILE@%$TK_BUILD_EXP_FILE%g s%@TK_EXP_FILE@%$TK_EXP_FILE%g s%@TCL_STUB_FLAGS@%$TCL_STUB_FLAGS%g s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g +s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g +s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g +s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g s%@TK_DBGX@%$TK_DBGX%g s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g -s%@LD_FLAGS@%$LD_FLAGS%g s%@MATH_LIBS@%$MATH_LIBS%g s%@MAKE_LIB@%$MAKE_LIB%g s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g diff --git a/unix/configure.in b/unix/configure.in index 11ddcad..dd23f6a 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.55 2000/09/06 19:05:16 hobbs Exp $ +# RCS: @(#) $Id: configure.in,v 1.55.4.1 2001/07/03 20:01:10 dgp Exp $ TK_VERSION=8.4 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=4 -TK_PATCH_LEVEL="a2" +TK_PATCH_LEVEL="a3" VERSION=${TK_VERSION} LOCALES="de en es fr" @@ -22,6 +22,16 @@ fi srcdir=`cd $srcdir ; pwd` TK_SRC_DIR=`cd $srcdir/..; pwd` +#------------------------------------------------------------------------ +# Standard compiler checks +#------------------------------------------------------------------------ + +# If the user did not set CFLAGS, set it now to keep +# the AC_PROG_CC macro from adding "-g -O2". +if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" +fi + AC_PROG_CC AC_PROG_RANLIB @@ -71,7 +81,6 @@ SC_ENABLE_SYMBOLS LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' -CFLAGS=${CFLAGS_DEFAULT} TK_DBGX=${DBGX} #------------------------------------------------------------------------ @@ -334,7 +343,7 @@ TCL_STUB_LIB_SPEC='-L$(TCL_BIN_DIR) $(TCL_STUB_LIB_FLAG)' if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then TK_SHLIB_CFLAGS="${SHLIB_CFLAGS}" TK_LIB_FILE=libtk${TK_SHARED_LIB_SUFFIX} - MAKE_LIB="\${SHLIB_LD} -o \${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_STUB_LIB_SPEC} \${SHLIB_LD_LIBS}" + MAKE_LIB="\${SHLIB_LD} -o \[$]@ \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_STUB_LIB_SPEC} \${SHLIB_LD_LIBS}" RANLIB=":" # TCL_STUB_FLAGS="-DUSE_TCL_STUBS" @@ -342,7 +351,7 @@ if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then else TK_SHLIB_CFLAGS="" TK_LIB_FILE=libtk${TK_UNSHARED_LIB_SUFFIX} - MAKE_LIB="ar cr \${TK_LIB_FILE} \${OBJS}" + MAKE_LIB="ar cr \[$]@ \${OBJS}" TCL_STUB_FLAGS="" fi @@ -383,11 +392,10 @@ TK_SHARED_BUILD=${SHARED_BUILD} #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TK_VERSION} -eval "STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}" - -MAKE_STUB_LIB="ar cr \${STUB_LIB_FILE} \${STUB_LIB_OBJS}" +eval "TK_STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}" -TK_STUB_LIB_FILE=${STUB_LIB_FILE} +# FIXME: Should we add MAKE_STUB_LIB to tclConfig.sh ? +MAKE_STUB_LIB="ar cr \[$]@ \${STUB_LIB_OBJS}" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then eval TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}\${TK_DBGX}" @@ -400,8 +408,6 @@ 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}" -AC_SUBST(STUB_LIB_FILE) - AC_SUBST(TK_STUB_LIB_FILE) AC_SUBST(TK_STUB_LIB_FLAG) AC_SUBST(TK_BUILD_STUB_LIB_SPEC) @@ -420,10 +426,14 @@ AC_SUBST(TK_BUILD_EXP_FILE) AC_SUBST(TK_EXP_FILE) AC_SUBST(CFLAGS_DEFAULT) +AC_SUBST(CFLAGS_DEBUG) +AC_SUBST(CFLAGS_OPTIMIZE) +AC_SUBST(LDFLAGS_DEFAULT) +AC_SUBST(LDFLAGS_DEBUG) +AC_SUBST(LDFLAGS_OPTIMIZE) AC_SUBST(TK_DBGX) AC_SUBST(DL_LIBS) AC_SUBST(EXTRA_CFLAGS) -AC_SUBST(LD_FLAGS) AC_SUBST(MATH_LIBS) AC_SUBST(MAKE_LIB) AC_SUBST(SHLIB_CFLAGS) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 16aedcc..fab607f 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -31,7 +31,7 @@ AC_DEFUN(SC_PATH_TCLCONFIG, [ AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ - # First check to see if --with-tclconfig was specified. + # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)` @@ -59,7 +59,10 @@ AC_DEFUN(SC_PATH_TCLCONFIG, [ # check in a few common install locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ${prefix}/lib 2>/dev/null` \ - `ls -d /usr/local/lib 2>/dev/null` ; do + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i; pwd)` break @@ -68,7 +71,7 @@ AC_DEFUN(SC_PATH_TCLCONFIG, [ fi # check in a few other private locations - if test x"${ac_cv_c_tcliconfig}" = x ; then + if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do @@ -151,7 +154,10 @@ AC_DEFUN(SC_PATH_TKCONFIG, [ # check in a few common install locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ${prefix}/lib 2>/dev/null` \ - `ls -d /usr/local/lib 2>/dev/null` ; do + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + ; do if test -f "$i/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd $i; pwd)` break @@ -242,10 +248,10 @@ AC_DEFUN(SC_LOAD_TCLCONFIG, [ #------------------------------------------------------------------------ AC_DEFUN(SC_LOAD_TKCONFIG, [ - AC_MSG_CHECKING([for existence of $TCLCONFIG]) + AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh]) if test -f "$TK_BIN_DIR/tkConfig.sh" ; then - AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_RESULT([loading]) . $TK_BIN_DIR/tkConfig.sh else AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh]) @@ -369,6 +375,7 @@ AC_DEFUN(SC_ENABLE_THREADS, [ TCL_THREADS=0 AC_MSG_RESULT([no (default)]) fi + AC_SUBST(TCL_THREADS) ]) #------------------------------------------------------------------------ @@ -379,7 +386,7 @@ AC_DEFUN(SC_ENABLE_THREADS, [ # Arguments: # none # -# Requires the following vars to be set: +# Requires the following vars to be set in the Makefile: # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # LDFLAGS_DEBUG @@ -391,10 +398,10 @@ AC_DEFUN(SC_ENABLE_THREADS, [ # --enable-symbols # # Defines the following vars: -# CFLAGS_DEFAULT Sets to CFLAGS_DEBUG if true -# Sets to CFLAGS_OPTIMIZE if false -# LDFLAGS_DEFAULT Sets to LDFLAGS_DEBUG if true -# Sets to LDFLAGS_OPTIMIZE if false +# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true +# Sets to $(CFLAGS_OPTIMIZE) if false +# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true +# Sets to $(LDFLAGS_OPTIMIZE) if false # DBGX Debug library extension # #------------------------------------------------------------------------ @@ -402,14 +409,15 @@ AC_DEFUN(SC_ENABLE_THREADS, [ AC_DEFUN(SC_ENABLE_SYMBOLS, [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no]) +# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "yes"; then - CFLAGS_DEFAULT="${CFLAGS_DEBUG}" - LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' + LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=g AC_MSG_RESULT([yes]) else - CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE}" - LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' + LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" AC_MSG_RESULT([no]) fi @@ -586,7 +594,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ TCL_EXP_FILE="" STLIB_LD="ar cr" case $system in - AIX-5*) + AIX-5.*) if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then # AIX requires the _r compiler when gcc isn't being used if test "${CC}" != "cc_r" ; then @@ -720,7 +728,18 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a' ;; - IRIX-5.*|IRIX-6.*|IRIX64-6.5*) + IRIX-5.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -shared -rdata_shared" + SHLIB_LD_LIBS='${LIBS}' + SHLIB_SUFFIX=".so" + DL_OBJS="tclLoadDl.o" + DL_LIBS="" + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + EXTRA_CFLAGS="" + LDFLAGS="" + ;; + IRIX-6.*|IRIX64-6.5*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_LD_LIBS='${LIBS}' @@ -975,6 +994,12 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[[0-6]]*) + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + AC_DEFINE(_REENTRANT) + SHLIB_CFLAGS="-KPIC" SHLIB_LD="/usr/ccs/bin/ld -G -z text" @@ -989,6 +1014,12 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' ;; SunOS-5*) + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + AC_DEFINE(_REENTRANT) + SHLIB_CFLAGS="-KPIC" SHLIB_LD="/usr/ccs/bin/ld -G -z text" LDFLAGS="" @@ -1174,7 +1205,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ if test "$DL_OBJS" != "tclLoadNone.o" ; then if test "$using_gcc" = "yes" ; then case $system in - AIX-[[1-4]]*) + AIX-*) ;; BSD/OS*) ;; @@ -1276,8 +1307,68 @@ main() } return 1; }], tk_ok=sgtty, tk_ok=none, tk_ok=none) + if test $tk_ok = sgtty; then AC_DEFINE(USE_SGTTY) + else + AC_TRY_RUN([ +#include <termios.h> +#include <errno.h> + +main() +{ + struct termios t; + if (tcgetattr(0, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + cfsetospeed(&t, 0); + t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; +}], tk_ok=termios, tk_ok=no, tk_ok=no) + + if test $tk_ok = termios; then + AC_DEFINE(USE_TERMIOS) + else + AC_TRY_RUN([ +#include <termio.h> +#include <errno.h> + +main() +{ + struct termio t; + if (ioctl(0, TCGETA, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; + }], tk_ok=termio, tk_ok=no, tk_ok=no) + + if test $tk_ok = termio; then + AC_DEFINE(USE_TERMIO) + else + AC_TRY_RUN([ +#include <sgtty.h> +#include <errno.h> + +main() +{ + struct sgttyb t; + if (ioctl(0, TIOCGETP, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + t.sg_ospeed = 0; + t.sg_flags |= ODDP | EVENP | RAW; + return 0; + } + return 1; +}], tk_ok=sgtty, tk_ok=none, tk_ok=none) + + if test $tk_ok = sgtty; then + AC_DEFINE(USE_SGTTY) + fi + fi + fi fi fi fi @@ -1552,6 +1643,8 @@ AC_DEFUN(SC_TIME_HANDLER, [ AC_HEADER_TIME AC_STRUCT_TIMEZONE + AC_CHECK_FUNCS(gmtime_r localtime_r) + AC_MSG_CHECKING([tm_tzadj in struct tm]) AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;], [AC_DEFINE(HAVE_TM_TZADJ) @@ -1592,6 +1685,7 @@ AC_DEFUN(SC_TIME_HANDLER, [ AC_MSG_RESULT(yes)], AC_MSG_RESULT(no)) fi + ]) #-------------------------------------------------------------------- diff --git a/unix/tk.spec b/unix/tk.spec index 4ef295d..b543331 100644 --- a/unix/tk.spec +++ b/unix/tk.spec @@ -1,7 +1,7 @@ -# $Id: tk.spec,v 1.5 2000/09/06 19:05:16 hobbs Exp $ +# $Id: tk.spec,v 1.5.4.1 2001/07/03 20:01:10 dgp Exp $ # This file is the basis for a binary Tk Linux RPM. -%define version 8.4a2 +%define version 8.4a3 %define directory /usr/local Summary: Tk graphical toolkit for the Tcl scripting language. @@ -14,7 +14,7 @@ Source: ftp://ftp.scriptics.com/pub/tcl/tcl8_4/tk%{version}.tar.gz URL: http://dev.scriptics.com/ Packager: Scriptics Corporation Buildroot: /var/tmp/%{name}%{version} -Requires: XFree86-libs >= 3.3.3, XFree86-devel >= 3.3.3, tcl = 8.4a2 +Requires: XFree86-libs >= 3.3.3, XFree86-devel >= 3.3.3, tcl = 8.4a3 %description The Tcl (Tool Command Language) provides a powerful platform for diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index 59826c2..2cd1e6b 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -9,11 +9,12 @@ * 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.8 1999/12/21 23:56:34 hobbs Exp $ + * RCS: @(#) $Id: tkUnixFont.c,v 1.8.6.1 2001/07/03 20:01:10 dgp Exp $ */ #include "tkUnixInt.h" #include "tkFont.h" +#include <netinet/in.h> /* for htons() prototype */ /* * The preferred font encodings. @@ -180,6 +181,7 @@ static EncodingAlias encodingAliases[] = { {"cns11643-1", "cns11643*.1-0"}, {"cns11643-2", "cns11643*-2"}, {"cns11643-2", "cns11643*.2-0"}, + {"jis0201", "jisx0201*"}, {"jis0201", "jisx0202*"}, {"jis0208", "jisc6226*"}, {"jis0208", "jisx0208*"}, @@ -187,6 +189,7 @@ static EncodingAlias encodingAliases[] = { {"tis620", "tis620*"}, {"ksc5601", "ksc5601*"}, {"dingbats", "*dingbats"}, + {"ucs-2be", "iso10646-1"}, {NULL, NULL} }; @@ -243,6 +246,16 @@ static void ReleaseSubFont _ANSI_ARGS_((Display *display, SubFont *subFontPtr)); static int SeenName _ANSI_ARGS_((CONST char *name, Tcl_DString *dsPtr)); +static int Ucs2beToUtfProc _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 int UtfToUcs2beProc _ANSI_ARGS_((ClientData clientData, + CONST char *src, int srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, int dstLen, + int *srcReadPtr, int *dstWrotePtr, + int *dstCharsPtr)); /* @@ -274,12 +287,12 @@ TkpFontPkgInit(mainPtr) 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; + 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); @@ -291,6 +304,19 @@ TkpFontPkgInit(mainPtr) FontMapInsert(&dummy, i); FontMapInsert(&dummy, i + 0x80); } + + /* + * UCS-2BE is unicode in big-endian format. + * It is used in iso10646 fonts. + */ + + type.encodingName = "ucs-2be"; + type.toUtfProc = Ucs2beToUtfProc; + type.fromUtfProc = UtfToUcs2beProc; + type.freeProc = NULL; + type.clientData = NULL; + type.nullSize = 2; + Tcl_CreateEncoding(&type); } } @@ -387,6 +413,176 @@ ControlUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, } /* + *------------------------------------------------------------------------- + * + * Ucs2beToUtfProc -- + * + * Convert from UCS-2BE (big-endian 16-bit Unicode) to UTF-8. + * + * Results: + * Returns TCL_OK if conversion was successful. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Ucs2beToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, + srcReadPtr, dstWrotePtr, dstCharsPtr) + ClientData clientData; /* Not used. */ + CONST char *src; /* Source string in Unicode. */ + int srcLen; /* Source string length in bytes. */ + int flags; /* Conversion control flags. */ + Tcl_EncodingState *statePtr;/* Place for conversion routine to store + * state 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 Tcl_UniChar *wSrc, *wSrcStart, *wSrcEnd; + char *dstEnd, *dstStart; + int result, numChars; + + result = TCL_OK; + if ((srcLen % sizeof(Tcl_UniChar)) != 0) { + result = TCL_CONVERT_MULTIBYTE; + srcLen /= sizeof(Tcl_UniChar); + srcLen *= sizeof(Tcl_UniChar); + } + + wSrc = (Tcl_UniChar *) src; + + wSrcStart = (Tcl_UniChar *) src; + wSrcEnd = (Tcl_UniChar *) (src + srcLen); + + dstStart = dst; + dstEnd = dst + dstLen - TCL_UTF_MAX; + + for (numChars = 0; wSrc < wSrcEnd; numChars++) { + if (dst > dstEnd) { + result = TCL_CONVERT_NOSPACE; + break; + } + /* + * On a little-endian machine (Intel) the UCS-2BE is in the + * wrong byte-order in comparison to "unicode", which is + * in native host order. + */ + dst += Tcl_UniCharToUtf(htons(*wSrc), dst); + wSrc++; + } + + *srcReadPtr = (char *) wSrc - (char *) wSrcStart; + *dstWrotePtr = dst - dstStart; + *dstCharsPtr = numChars; + return result; +} + +/* + *------------------------------------------------------------------------- + * + * UtfToUcs2beProc -- + * + * Convert from UTF-8 to UCS-2BE. + * + * Results: + * Returns TCL_OK if conversion was successful. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +UtfToUcs2beProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, + srcReadPtr, dstWrotePtr, dstCharsPtr) + ClientData clientData; /* TableEncodingData that specifies encoding. */ + 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, *srcClose; + Tcl_UniChar *wDst, *wDstStart, *wDstEnd; + int result, numChars; + + srcStart = src; + srcEnd = src + srcLen; + srcClose = srcEnd; + if ((flags & TCL_ENCODING_END) == 0) { + srcClose -= TCL_UTF_MAX; + } + + wDst = (Tcl_UniChar *) dst; + wDstStart = (Tcl_UniChar *) dst; + wDstEnd = (Tcl_UniChar *) (dst + dstLen - sizeof(Tcl_UniChar)); + + result = TCL_OK; + for (numChars = 0; src < srcEnd; numChars++) { + if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { + /* + * If there is more string to follow, this will ensure that the + * last UTF-8 character in the source buffer hasn't been cut off. + */ + + result = TCL_CONVERT_MULTIBYTE; + break; + } + if (wDst > wDstEnd) { + result = TCL_CONVERT_NOSPACE; + break; + } + src += Tcl_UtfToUniChar(src, wDst); + /* + * Byte swap for little-endian machines. + */ + *wDst = htons(*wDst); + wDst++; + } + *srcReadPtr = src - srcStart; + *dstWrotePtr = (char *) wDst - (char *) wDstStart; + *dstCharsPtr = numChars; + return result; +} + +/* *--------------------------------------------------------------------------- * * TkpGetNativeFont -- @@ -1460,7 +1656,17 @@ AllocFontFamily(display, fontStructPtr, base) */ familyPtr->refCount = 2; - familyPtr->isTwoByteFont = (fontStructPtr->min_byte1 > 0); + + /* + * One byte/character fonts have both min_byte1 and max_byte1 0, + * and max_char_or_byte2 <= 255. + * Anything else specifies a two byte/character font. + */ + + familyPtr->isTwoByteFont = !( + (fontStructPtr->min_byte1 == 0) && + (fontStructPtr->max_byte1 == 0) && + (fontStructPtr->max_char_or_byte2 < 256)); return familyPtr; } diff --git a/unix/tkUnixMenubu.c b/unix/tkUnixMenubu.c index 8e46f46..09d6367 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.5 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkUnixMenubu.c,v 1.5.2.1 2001/07/03 20:01:10 dgp Exp $ */ #include "tkMenubutton.h" @@ -74,9 +74,11 @@ TkpDisplayMenuButton(clientData) Pixmap pixmap; int x = 0; /* Initialization needed only to stop * compiler warning. */ - int y; + int y = 0; register Tk_Window tkwin = mbPtr->tkwin; - int width, height; + int width, height, fullWidth, fullHeight; + int imageXOffset, imageYOffset, textXOffset, textYOffset; + int haveImage = 0, haveText = 0; mbPtr->flags &= ~REDRAW_PENDING; if ((mbPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { @@ -95,6 +97,15 @@ TkpDisplayMenuButton(clientData) border = mbPtr->normalBorder; } + if (mbPtr->image != None) { + Tk_SizeOfImage(mbPtr->image, &width, &height); + haveImage = 1; + } else if (mbPtr->bitmap != None) { + Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height); + haveImage = 1; + } + haveText = (mbPtr->textWidth != 0 && mbPtr->textHeight != 0); + /* * In order to avoid screen flashes, this procedure redraws * the menu button in a pixmap, then copies the pixmap to the @@ -107,34 +118,105 @@ TkpDisplayMenuButton(clientData) Tk_Fill3DRectangle(tkwin, pixmap, border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); - /* - * Display image or bitmap or text for button. - */ + imageXOffset = 0; + imageYOffset = 0; + textXOffset = 0; + textYOffset = 0; + fullWidth = 0; + fullHeight = 0; - if (mbPtr->image != None) { - Tk_SizeOfImage(mbPtr->image, &width, &height); + if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) { - imageOrBitmap: - TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, - width + mbPtr->indicatorWidth, height, &x, &y); - if (mbPtr->image != NULL) { - Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap, - x, y); - } else { - XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap, - gc, 0, 0, (unsigned) width, (unsigned) height, x, y, 1); - } - } else if (mbPtr->bitmap != None) { - Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height); - goto imageOrBitmap; + switch ((enum compound) mbPtr->compound) { + case COMPOUND_TOP: + case COMPOUND_BOTTOM: { + /* Image is above or below text */ + if (mbPtr->compound == COMPOUND_TOP) { + textYOffset = height + mbPtr->padY; + } else { + imageYOffset = mbPtr->textHeight + mbPtr->padY; + } + fullHeight = height + mbPtr->textHeight + mbPtr->padY; + fullWidth = (width > mbPtr->textWidth ? width : + mbPtr->textWidth); + textXOffset = (fullWidth - mbPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + break; + } + case COMPOUND_LEFT: + case COMPOUND_RIGHT: { + /* Image is left or right of text */ + if (mbPtr->compound == COMPOUND_LEFT) { + textXOffset = width + mbPtr->padX; + } else { + imageXOffset = mbPtr->textWidth + mbPtr->padX; + } + fullWidth = mbPtr->textWidth + mbPtr->padX + width; + fullHeight = (height > mbPtr->textHeight ? height : + mbPtr->textHeight); + textYOffset = (fullHeight - mbPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; + } + case COMPOUND_CENTER: { + /* Image and text are superimposed */ + fullWidth = (width > mbPtr->textWidth ? width : + mbPtr->textWidth); + fullHeight = (height > mbPtr->textHeight ? height : + mbPtr->textHeight); + textXOffset = (fullWidth - mbPtr->textWidth)/2; + imageXOffset = (fullWidth - width)/2; + textYOffset = (fullHeight - mbPtr->textHeight)/2; + imageYOffset = (fullHeight - height)/2; + break; + } + case COMPOUND_NONE: {break;} + } + + TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, + mbPtr->indicatorWidth + fullWidth, fullHeight, + &x, &y); + + if (mbPtr->image != NULL) { + Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap, + x + imageXOffset, y + imageYOffset); + } + if (mbPtr->bitmap != None) { + XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap, + gc, 0, 0, (unsigned) width, (unsigned) height, + x + imageXOffset, y + imageYOffset, 1); + } + if (haveText) { + Tk_DrawTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout, + x + textXOffset, y + textYOffset , + 0, -1); + Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc, + mbPtr->textLayout, x + textXOffset, y + textYOffset , + mbPtr->underline); + } } else { - TkComputeAnchor(mbPtr->anchor, tkwin, mbPtr->padX, mbPtr->padY, - mbPtr->textWidth + mbPtr->indicatorWidth, - mbPtr->textHeight, &x, &y); - Tk_DrawTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout, x, y, - 0, -1); - Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout, - x, y, mbPtr->underline); + if (mbPtr->image != NULL) { + TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, + width + mbPtr->indicatorWidth, height, &x, &y); + Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap, + x + imageXOffset, y + imageYOffset); + } else if (mbPtr->bitmap != None) { + TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, + width + mbPtr->indicatorWidth, height, &x, &y); + XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap, + gc, 0, 0, (unsigned) width, (unsigned) height, + x + imageXOffset, y + imageYOffset, 1); + } else { + TkComputeAnchor(mbPtr->anchor, tkwin, mbPtr->padX, mbPtr->padY, + mbPtr->textWidth + mbPtr->indicatorWidth, + mbPtr->textHeight, &x, &y); + Tk_DrawTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout, + x + textXOffset, y + textYOffset , + 0, -1); + Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc, + mbPtr->textLayout, x + textXOffset, y + textYOffset , + mbPtr->underline); + } } /* @@ -251,54 +333,113 @@ TkpComputeMenuButtonGeometry(mbPtr) TkMenuButton *mbPtr; /* Widget record for menu button. */ { int width, height, mm, pixels; + int avgWidth, txtWidth, txtHeight; + int haveImage = 0, haveText = 0; + Tk_FontMetrics fm; mbPtr->inset = mbPtr->highlightWidth + mbPtr->borderWidth; + + width = 0; + height = 0; + txtWidth = 0; + txtHeight = 0; + avgWidth = 0; + if (mbPtr->image != None) { Tk_SizeOfImage(mbPtr->image, &width, &height); - if (mbPtr->width > 0) { - width = mbPtr->width; - } - if (mbPtr->height > 0) { - height = mbPtr->height; - } + haveImage = 1; } else if (mbPtr->bitmap != None) { Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height); - if (mbPtr->width > 0) { - width = mbPtr->width; - } - if (mbPtr->height > 0) { - height = mbPtr->height; - } - } else { + haveImage = 1; + } + + if (haveImage == 0 || mbPtr->compound != COMPOUND_NONE) { Tk_FreeTextLayout(mbPtr->textLayout); + mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->text, -1, mbPtr->wrapLength, mbPtr->justify, 0, &mbPtr->textWidth, &mbPtr->textHeight); - width = mbPtr->textWidth; - height = mbPtr->textHeight; - if (mbPtr->width > 0) { - width = mbPtr->width * Tk_TextWidth(mbPtr->tkfont, "0", 1); - } - if (mbPtr->height > 0) { - Tk_FontMetrics fm; + txtWidth = mbPtr->textWidth; + txtHeight = mbPtr->textHeight; + avgWidth = Tk_TextWidth(mbPtr->tkfont, "0", 1); + Tk_GetFontMetrics(mbPtr->tkfont, &fm); + haveText = (txtWidth != 0 && txtHeight != 0); + } + + /* + * If the menubutton is compound (ie, it shows both an image and text), + * the new geometry is a combination of the image and text geometry. + * We only honor the compound bit if the menubutton has both text and + * an image, because otherwise it is not really a compound menubutton. + */ - Tk_GetFontMetrics(mbPtr->tkfont, &fm); - height = mbPtr->height * fm.linespace; + if (mbPtr->compound != COMPOUND_NONE && haveImage && haveText) { + switch ((enum compound) mbPtr->compound) { + case COMPOUND_TOP: + case COMPOUND_BOTTOM: { + /* Image is above or below text */ + height += txtHeight + mbPtr->padY; + width = (width > txtWidth ? width : txtWidth); + break; + } + case COMPOUND_LEFT: + case COMPOUND_RIGHT: { + /* Image is left or right of text */ + width += txtWidth + mbPtr->padX; + height = (height > txtHeight ? height : txtHeight); + break; + } + case COMPOUND_CENTER: { + /* Image and text are superimposed */ + width = (width > txtWidth ? width : txtWidth); + height = (height > txtHeight ? height : txtHeight); + break; + } + case COMPOUND_NONE: {break;} + } + if (mbPtr->width > 0) { + width = mbPtr->width; + } + if (mbPtr->height > 0) { + height = mbPtr->height; + } + width += 2*mbPtr->padX; + height += 2*mbPtr->padY; + } else { + if (haveImage) { + if (mbPtr->width > 0) { + width = mbPtr->width; + } + if (mbPtr->height > 0) { + height = mbPtr->height; + } + } else { + width = txtWidth; + height = txtHeight; + if (mbPtr->width > 0) { + width = mbPtr->width * avgWidth; + } + if (mbPtr->height > 0) { + height = mbPtr->height * fm.linespace; + } } - width += 2*mbPtr->padX; - height += 2*mbPtr->padY; + } + + if (! haveImage) { + width += 2*mbPtr->padX; + height += 2*mbPtr->padY; } if (mbPtr->indicatorOn) { - mm = WidthMMOfScreen(Tk_Screen(mbPtr->tkwin)); - pixels = WidthOfScreen(Tk_Screen(mbPtr->tkwin)); - mbPtr->indicatorHeight= (INDICATOR_HEIGHT * pixels)/(10*mm); - mbPtr->indicatorWidth = (INDICATOR_WIDTH * pixels)/(10*mm) - + 2*mbPtr->indicatorHeight; - width += mbPtr->indicatorWidth; + mm = WidthMMOfScreen(Tk_Screen(mbPtr->tkwin)); + pixels = WidthOfScreen(Tk_Screen(mbPtr->tkwin)); + mbPtr->indicatorHeight= (INDICATOR_HEIGHT * pixels)/(10*mm); + mbPtr->indicatorWidth = (INDICATOR_WIDTH * pixels)/(10*mm) + + 2*mbPtr->indicatorHeight; + width += mbPtr->indicatorWidth; } else { - mbPtr->indicatorHeight = 0; - mbPtr->indicatorWidth = 0; + mbPtr->indicatorHeight = 0; + mbPtr->indicatorWidth = 0; } Tk_GeometryRequest(mbPtr->tkwin, (int) (width + 2*mbPtr->inset), diff --git a/unix/tkUnixScale.c b/unix/tkUnixScale.c index edba2cf..3c84a75 100644 --- a/unix/tkUnixScale.c +++ b/unix/tkUnixScale.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: tkUnixScale.c,v 1.6 2000/04/14 08:34:49 hobbs Exp $ + * RCS: @(#) $Id: tkUnixScale.c,v 1.6.6.1 2001/07/03 20:01:10 dgp Exp $ */ #include "tkScale.h" @@ -559,7 +559,7 @@ TkpDisplayScale(clientData) scalePtr->flags &= ~INVOKE_COMMAND; if (scalePtr->flags & SCALE_DELETED) { Tcl_Release((ClientData) scalePtr); - goto done; + return; } Tcl_Release((ClientData) scalePtr); diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index e3d6b56..56012df 100644 --- a/unix/tkUnixSelect.c +++ b/unix/tkUnixSelect.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: tkUnixSelect.c,v 1.6 1999/06/03 18:50:46 stanton Exp $ + * RCS: @(#) $Id: tkUnixSelect.c,v 1.6.14.1 2001/07/03 20:01:10 dgp Exp $ */ #include "tkInt.h" @@ -597,7 +597,7 @@ TkSelEventProc(tkwin, eventPtr) Tcl_Encoding encoding; if (format != 8) { char buf[64 + TCL_INTEGER_SPACE]; - + sprintf(buf, "bad format for string selection: wanted \"8\", got \"%d\"", format); @@ -633,6 +633,35 @@ TkSelEventProc(tkwin, eventPtr) interp, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); Tcl_Release((ClientData) interp); + } else if (type == dispPtr->utf8Atom) { + /* + * The X selection data is in UTF-8 format already. + * We can't guarantee that propInfo is NULL-terminated, + * so we might have to copy the string. + */ + char *propData = propInfo; + + if (format != 8) { + 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; + } + + if (propInfo[numItems] != '\0') { + propData = ckalloc((size_t) numItems + 1); + strcpy(propData, propInfo); + propData[numItems] = '\0'; + } + retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, + retrPtr->interp, propData); + if (propData != propInfo) { + ckfree((char *) propData); + } } else if (type == dispPtr->incrAtom) { /* @@ -657,7 +686,7 @@ TkSelEventProc(tkwin, eventPtr) if (format != 32) { char buf[64 + TCL_INTEGER_SPACE]; - + sprintf(buf, "bad format for selection: wanted \"32\", got \"%d\"", format); @@ -940,6 +969,15 @@ ConvertSelection(winPtr, eventPtr) XChangeProperty(reply.display, reply.requestor, property, type, format, PropModeReplace, (unsigned char *) propPtr, numItems); + } else if (type == winPtr->dispPtr->utf8Atom) { + /* + * This matches selection requests of type UTF8_STRING, + * which allows us to pass our utf-8 information untouched. + */ + + XChangeProperty(reply.display, reply.requestor, + property, type, 8, PropModeReplace, + (unsigned char *) buffer, numItems); } else if ((type == XA_STRING) || (type == winPtr->dispPtr->compoundTextAtom)) { Tcl_DString ds; diff --git a/win/Makefile.in b/win/Makefile.in index 2baeb81..a944339 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,7 +4,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.35 2000/11/03 17:28:00 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.35.4.1 2001/07/03 20:01:10 dgp Exp $ TCLVERSION = @TCL_VERSION@ VERSION = @TK_VERSION@ @@ -161,7 +161,7 @@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ # Special compiler flags to use when building man2tcl on Windows. MAN2TCLFLAGS = @MAN2TCLFLAGS@ @@ -174,7 +174,7 @@ RES = @RES@ TK_RES = @TK_RES@ AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@ CPPFLAGS = @CPPFLAGS@ -LDFLAGS = @LDFLAGS@ +LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@ LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@ LDFLAGS_WINDOW = @LDFLAGS_WINDOW@ EXEEXT = @EXEEXT@ @@ -398,9 +398,17 @@ runtest: tktest PATH="$(PATH):$(TCL_BIN_DIR)"; export PATH; \ ./$(TKTEST) +# This target can be used to run wish from the build directory +# via `make shell` or `make shell SCRIPT=foo.tcl` +shell: $(WISH) + @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \ + TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \ + PATH="$(PATH):$(TCL_BIN_DIR)"; export PATH; \ + ./$(WISH) $(SCRIPT) + install: all install-binaries install-libraries install-doc install-demos -install-binaries: +install-binaries: binaries @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \ do \ if [ ! -d $$i ] ; then \ @@ -429,7 +437,7 @@ install-binaries: fi; \ fi -install-libraries: +install-libraries: libraries @for i in $(INSTALL_ROOT)$(prefix)/lib \ $(INCLUDE_INSTALL_DIR) $(INCLUDE_INSTALL_DIR)/X11 \ $(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images; \ @@ -497,7 +505,7 @@ install-demos: fi; \ done; -install-doc: +install-doc: doc $(WISH): $(TK_LIB_FILE) $(WISH_OBJS) wish.$(RES) diff --git a/win/configure b/win/configure index dcfce43..1f2f634 100755 --- a/win/configure +++ b/win/configure @@ -535,17 +535,34 @@ fi TK_VERSION=8.4 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=4 -TK_PATCH_LEVEL="a2" +TK_PATCH_LEVEL="a3" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ +# Handle the --prefix=... option +#------------------------------------------------------------------------ + +if test "${prefix}" = "NONE"; then + prefix=/usr/local +fi +if test "${exec_prefix}" = "NONE"; then + exec_prefix=$prefix +fi + +#------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ +# If the user did not set CFLAGS, set it now to keep +# the AC_PROG_CC macro from adding "-g -O2". +if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" +fi + # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:549: checking for $ac_word" >&5 +echo "configure:566: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -575,7 +592,7 @@ if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:579: checking for $ac_word" >&5 +echo "configure:596: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -626,7 +643,7 @@ fi # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:630: checking for $ac_word" >&5 +echo "configure:647: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -658,7 +675,7 @@ fi fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:662: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:679: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. @@ -669,12 +686,12 @@ cross_compiling=$ac_cv_prog_cc_cross cat > conftest.$ac_ext << EOF -#line 673 "configure" +#line 690 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:678: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:695: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -700,12 +717,12 @@ if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:704: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:721: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:709: checking whether we are using GNU C" >&5 +echo "configure:726: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -714,7 +731,7 @@ else yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:718: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:735: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -733,7 +750,7 @@ ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:737: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:754: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -779,7 +796,7 @@ if test "${GCC}" = "yes" ; then # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:783: checking for $ac_word" >&5 +echo "configure:800: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -808,7 +825,7 @@ fi # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:812: checking for $ac_word" >&5 +echo "configure:829: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -837,7 +854,7 @@ fi # Extract the first word of "windres", so it can be a program name with args. set dummy windres; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:841: checking for $ac_word" >&5 +echo "configure:858: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -870,7 +887,7 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:874: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:891: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -902,12 +919,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6 -echo "configure:906: checking for Cygwin environment" >&5 +echo "configure:923: checking for Cygwin environment" >&5 if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 911 "configure" +#line 928 "configure" #include "confdefs.h" int main() { @@ -918,7 +935,7 @@ int main() { return __CYGWIN__; ; return 0; } EOF -if { (eval echo configure:922: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:939: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_cygwin=yes else @@ -940,13 +957,13 @@ test "$ac_cv_cygwin" = yes && CYGWIN=yes #-------------------------------------------------------------------- echo $ac_n "checking for object suffix""... $ac_c" 1>&6 -echo "configure:944: checking for object suffix" >&5 +echo "configure:961: checking for object suffix" >&5 if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else rm -f conftest* echo 'int i = 1;' > conftest.$ac_ext -if { (eval echo configure:950: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:967: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then for ac_file in conftest.*; do case $ac_file in *.c) ;; @@ -964,19 +981,19 @@ OBJEXT=$ac_cv_objext ac_objext=$ac_cv_objext echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6 -echo "configure:968: checking for mingw32 environment" >&5 +echo "configure:985: checking for mingw32 environment" >&5 if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 973 "configure" +#line 990 "configure" #include "confdefs.h" int main() { return __MINGW32__; ; return 0; } EOF -if { (eval echo configure:980: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:997: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_mingw32=yes else @@ -995,7 +1012,7 @@ test "$ac_cv_mingw32" = yes && MINGW32=yes echo $ac_n "checking for executable suffix""... $ac_c" 1>&6 -echo "configure:999: checking for executable suffix" >&5 +echo "configure:1016: checking for executable suffix" >&5 if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -1005,7 +1022,7 @@ else rm -f conftest* echo 'int main () { return 0; }' > conftest.$ac_ext ac_cv_exeext= - if { (eval echo configure:1009: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then + if { (eval echo configure:1026: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then for file in conftest.*; do case $file in *.c | *.o | *.obj) ;; @@ -1032,7 +1049,7 @@ ac_exeext=$EXEEXT echo $ac_n "checking for building with threads""... $ac_c" 1>&6 -echo "configure:1036: checking for building with threads" >&5 +echo "configure:1053: checking for building with threads" >&5 # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" @@ -1053,6 +1070,7 @@ EOF TCL_THREADS=0 echo "$ac_t""no (default)" 1>&6 fi + #-------------------------------------------------------------------- @@ -1062,7 +1080,7 @@ EOF echo $ac_n "checking how to build libraries""... $ac_c" 1>&6 -echo "configure:1066: checking how to build libraries" >&5 +echo "configure:1084: checking how to build libraries" >&5 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -1101,11 +1119,9 @@ EOF # Step 0: Enable 64 bit support? - # Currently Tk requires no extra flags for 64bit support. - # It just needs to find the right compiler, which is up to the user. echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6 -echo "configure:1109: checking if 64bit support is requested" >&5 +echo "configure:1125: checking if 64bit support is requested" >&5 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" @@ -1117,7 +1133,7 @@ fi echo "$ac_t""$do64bit" 1>&6 echo $ac_n "checking compiler flags""... $ac_c" 1>&6 -echo "configure:1121: checking compiler flags" >&5 +echo "configure:1137: checking compiler flags" >&5 # Set some defaults (may get changed below) EXTRA_CFLAGS="" @@ -1134,11 +1150,12 @@ echo "configure:1121: checking compiler flags" >&5 SHLIB_LD="" SHLIB_LD_LIBS="" LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32" STLIB_LD="${AR}" RC_OUT=-o RC_TYPE= RC_INCLUDE=--include + RC_DEFINE=--define RES=res.o MAKE_LIB="\${AR} crv \$@" POST_MAKE_LIB="\${RANLIB} \$@" @@ -1174,40 +1191,21 @@ echo "configure:1121: checking compiler flags" >&5 # dynamic echo "$ac_t""using shared flags" 1>&6 - # check to see if ld supports --shared. Libtool does a much - # more extensive test, but not really needed in this case. - if test -z "$LD"; then - ld_prog="`(${CC} -print-prog-name=ld) 2>/dev/null`" - if test -z "$ld_prog"; then - ld_prog=ld - else - # get rid of the potential '\r' from ld_prog. - ld_prog="`(echo $ld_prog | tr -d '\015' | sed 's,\\\\,\\/,g')`" - fi - LD="$ld_prog" - fi - - echo $ac_n "checking whether $ld_prog supports -shared option""... $ac_c" 1>&6 -echo "configure:1192: checking whether $ld_prog supports -shared option" >&5 - - # now the ad-hoc check to see if GNU ld supports --shared. - if "$LD" --shared 2>&1 | egrep ': -shared not supported' >/dev/null; then - ld_supports_shared="no" - SHLIB_LD="${DLLWRAP-dllwrap}" - else - ld_supports_shared="yes" - SHLIB_LD="${CC} -shared" + # ad-hoc check to see if CC supports -shared. + if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then + { echo "configure: error: ${CC} does not support the -shared option. + You will need to upgrade to a newer version of the toolchain." 1>&2; exit 1; } fi - echo "$ac_t""$ld_supports_shared" 1>&6 runtime= + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. Make sure CFLAGS is + # included so -mno-cygwin passed the correct libs to the linker. + SHLIB_LD='${CC} -shared ${CFLAGS}' # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags}" - if test "${ld_supports_shared}" = "yes"; then - MAKE_DLL="${MAKE_DLL} -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" - else - MAKE_DLL="${MAKE_DLL} --output-lib \$(patsubst %.dll,lib%.a,\$@)" - fi + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" + LIBSUFFIX="\${DBGX}.a" DLLSUFFIX="\${DBGX}.dll" EXESUFFIX="\${DBGX}.exe" @@ -1219,8 +1217,8 @@ echo "configure:1192: checking whether $ld_prog supports -shared option" >&5 CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="-Wall -Wconversion" - LDFLAGS_DEBUG=-g - LDFLAGS_OPTIMIZE=-O + LDFLAGS_DEBUG= + LDFLAGS_OPTIMIZE= # Specify the CC output file names based on the target name CC_OBJNAME="-o \$@" @@ -1231,16 +1229,17 @@ echo "configure:1192: checking whether $ld_prog supports -shared option" >&5 LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" else - SHLIB_LD="link -dll -nologo" + SHLIB_LD="link -dll -nologo -incremental:no" SHLIB_LD_LIBS="user32.lib advapi32.lib" LIBS="user32.lib advapi32.lib" - LIBS_GUI="gdi32.lib comdlg32.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib" AR="lib -nologo" STLIB_LD="lib -nologo" RC="rc" RC_OUT=-fo RC_TYPE=-r RC_INCLUDE=-i + RC_DEFINE=-d RES=res MAKE_LIB="\${AR} -out:\$@" POST_MAKE_LIB= @@ -1284,6 +1283,10 @@ echo "configure:1192: checking whether $ld_prog supports -shared option" >&5 # built -- Console vs. Window. LDFLAGS_CONSOLE="-link -subsystem:console" LDFLAGS_WINDOW="-link -subsystem:windows" + + if test "$do64bit" = "yes" ; then + EXTRA_CFLAGS="$EXTRA_CFLAGS -DUSE_TCLALLOC=0" + fi fi @@ -1292,7 +1295,7 @@ echo "configure:1192: checking whether $ld_prog supports -shared option" >&5 #-------------------------------------------------------------------- echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:1296: checking how to run the C preprocessor" >&5 +echo "configure:1299: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -1307,13 +1310,13 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 1311 "configure" +#line 1314 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1317: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1320: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -1324,13 +1327,13 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 1328 "configure" +#line 1331 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1334: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1337: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -1341,13 +1344,13 @@ else rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF -#line 1345 "configure" +#line 1348 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1351: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1354: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -1373,17 +1376,17 @@ echo "$ac_t""$CPP" 1>&6 ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for errno.h""... $ac_c" 1>&6 -echo "configure:1377: checking for errno.h" >&5 +echo "configure:1380: checking for errno.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1382 "configure" +#line 1385 "configure" #include "confdefs.h" #include <errno.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1387: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1390: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1415,7 +1418,7 @@ fi echo $ac_n "checking for build with symbols""... $ac_c" 1>&6 -echo "configure:1419: checking for build with symbols" >&5 +echo "configure:1422: checking for build with symbols" >&5 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" @@ -1426,20 +1429,18 @@ fi if test "$tcl_ok" = "yes"; then - CFLAGS_DEFAULT="${CFLAGS_DEBUG}" - LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' + LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=d echo "$ac_t""yes" 1>&6 else - CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE}" - LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' + LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" echo "$ac_t""no" 1>&6 fi -CFLAGS=${CFLAGS_DEFAULT} -LDFLAGS=${LDFLAGS_DEFAULT} TK_DBGX=${DBGX} #-------------------------------------------------------------------- @@ -1448,7 +1449,7 @@ TK_DBGX=${DBGX} echo $ac_n "checking the location of tclConfig.sh""... $ac_c" 1>&6 -echo "configure:1452: checking the location of tclConfig.sh" >&5 +echo "configure:1453: checking the location of tclConfig.sh" >&5 if test -d ../../tcl8.4$TK_PATCH_LEVEL/win; then TCL_BIN_DIR_DEFAULT=../../tcl8.4$TK_PATCH_LEVEL/win @@ -1474,7 +1475,7 @@ fi echo $ac_n "checking for existence of $TCL_BIN_DIR/tclConfig.sh""... $ac_c" 1>&6 -echo "configure:1478: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5 +echo "configure:1479: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5 if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then echo "$ac_t""loading" 1>&6 @@ -1496,7 +1497,7 @@ echo "configure:1478: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5 echo $ac_n "checking for tclsh""... $ac_c" 1>&6 -echo "configure:1500: checking for tclsh" >&5 +echo "configure:1501: checking for tclsh" >&5 if eval "test \"`echo '$''{'ac_cv_path_tclsh'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -1577,18 +1578,18 @@ CFG_TK_EXPORT_FILE_SUFFIX=${TK_EXPORT_FILE_SUFFIX} if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then if test "${DBGX}" = "d"; then - RC_DEFINES="-d STATIC_BUILD -d DEBUG" + RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG" else - RC_DEFINES="-d STATIC_BUILD" + RC_DEFINES="${RC_DEFINE} STATIC_BUILD" fi TK_RES="" else if test "${DBGX}" = "d"; then - RC_DEFINES="-d DEBUG" + RC_DEFINES="${RC_DEFINE} DEBUG" else RC_DEFINES="" fi - TK_RES=tk.res + TK_RES='tk.$(RES)' fi @@ -1663,6 +1664,8 @@ fi + + trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure @@ -1814,6 +1817,7 @@ s%@RC@%$RC%g s%@SET_MAKE@%$SET_MAKE%g s%@OBJEXT@%$OBJEXT%g s%@EXEEXT@%$EXEEXT%g +s%@TCL_THREADS@%$TCL_THREADS%g s%@CPP@%$CPP%g s%@MAN2TCLFLAGS@%$MAN2TCLFLAGS%g s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g @@ -1848,6 +1852,7 @@ s%@TK_SHARED_BUILD@%$TK_SHARED_BUILD%g s%@PATHTYPE@%$PATHTYPE%g s%@CYGPATH@%$CYGPATH%g s%@VPSEP@%$VPSEP%g +s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g @@ -1859,6 +1864,7 @@ s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g s%@CC_OBJNAME@%$CC_OBJNAME%g s%@CC_EXENAME@%$CC_EXENAME%g +s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g s%@LDFLAGS_CONSOLE@%$LDFLAGS_CONSOLE%g @@ -1866,6 +1872,7 @@ s%@LDFLAGS_WINDOW@%$LDFLAGS_WINDOW%g s%@RC_OUT@%$RC_OUT%g s%@RC_TYPE@%$RC_TYPE%g s%@RC_INCLUDE@%$RC_INCLUDE%g +s%@RC_DEFINE@%$RC_DEFINE%g s%@RC_DEFINES@%$RC_DEFINES%g s%@TK_RES@%$TK_RES%g s%@RES@%$RES%g diff --git a/win/configure.in b/win/configure.in index 3a4a8c8..b37f45a 100644 --- a/win/configure.in +++ b/win/configure.in @@ -2,20 +2,37 @@ # generate the file "configure", which is run during Tk installation # to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.24 2000/10/31 01:28:26 davidg Exp $ +# RCS: @(#) $Id: configure.in,v 1.24.4.1 2001/07/03 20:01:10 dgp Exp $ AC_INIT(../generic/tk.h) TK_VERSION=8.4 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=4 -TK_PATCH_LEVEL="a2" +TK_PATCH_LEVEL="a3" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ +# Handle the --prefix=... option +#------------------------------------------------------------------------ + +if test "${prefix}" = "NONE"; then + prefix=/usr/local +fi +if test "${exec_prefix}" = "NONE"; then + exec_prefix=$prefix +fi + +#------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ +# If the user did not set CFLAGS, set it now to keep +# the AC_PROG_CC macro from adding "-g -O2". +if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" +fi + AC_PROG_CC # To properly support cross-compilation, one would @@ -89,8 +106,6 @@ AC_SUBST(MAN2TCLFLAGS) SC_ENABLE_SYMBOLS -CFLAGS=${CFLAGS_DEFAULT} -LDFLAGS=${LDFLAGS_DEFAULT} TK_DBGX=${DBGX} #-------------------------------------------------------------------- @@ -152,18 +167,18 @@ CFG_TK_EXPORT_FILE_SUFFIX=${TK_EXPORT_FILE_SUFFIX} if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then if test "${DBGX}" = "d"; then - RC_DEFINES="-d STATIC_BUILD -d DEBUG" + RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG" else - RC_DEFINES="-d STATIC_BUILD" + RC_DEFINES="${RC_DEFINE} STATIC_BUILD" fi TK_RES="" else if test "${DBGX}" = "d"; then - RC_DEFINES="-d DEBUG" + RC_DEFINES="${RC_DEFINE} DEBUG" else RC_DEFINES="" fi - TK_RES=tk.res + TK_RES='tk.$(RES)' fi AC_SUBST(TK_VERSION) @@ -199,6 +214,7 @@ AC_SUBST(TK_SHARED_BUILD) AC_SUBST(PATHTYPE) AC_SUBST(CYGPATH) AC_SUBST(VPSEP) +AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) @@ -210,7 +226,7 @@ AC_SUBST(SHLIB_CFLAGS) AC_SUBST(SHLIB_SUFFIX) AC_SUBST(CC_OBJNAME) AC_SUBST(CC_EXENAME) -AC_SUBST(LDFLAGS) +AC_SUBST(LDFLAGS_DEFAULT) AC_SUBST(LDFLAGS_DEBUG) AC_SUBST(LDFLAGS_OPTIMIZE) AC_SUBST(LDFLAGS_CONSOLE) @@ -221,6 +237,7 @@ AC_SUBST(RC) AC_SUBST(RC_OUT) AC_SUBST(RC_TYPE) AC_SUBST(RC_INCLUDE) +AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(TK_RES) AC_SUBST(RES) diff --git a/win/makefile.vc b/win/makefile.vc index 3171c87..a533abb 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -6,7 +6,7 @@ # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # -# RCS: @(#) $Id: makefile.vc,v 1.39 2000/11/03 01:16:30 hobbs Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.39.4.1 2001/07/03 20:01:10 dgp Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -317,7 +317,8 @@ libcdll = msvcrt$(DBGX).lib oldnames.lib !ENDIF baselibs = kernel32.lib $(optlibs) advapi32.lib -winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib +winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib \ + imm32.lib guilibs = $(libc) $(winlibs) conlibs = $(libc) $(baselibs) guilibsdll = $(libcdll) $(winlibs) @@ -135,10 +135,10 @@ AC_DEFUN(SC_LOAD_TCLCONFIG, [ #------------------------------------------------------------------------ AC_DEFUN(SC_LOAD_TKCONFIG, [ - AC_MSG_CHECKING([for existence of $TCLCONFIG]) + AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh]) if test -f "$TK_BIN_DIR/tkConfig.sh" ; then - AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_RESULT([loading]) . $TK_BIN_DIR/tkConfig.sh else AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh]) @@ -224,6 +224,7 @@ AC_DEFUN(SC_ENABLE_THREADS, [ TCL_THREADS=0 AC_MSG_RESULT([no (default)]) fi + AC_SUBST(TCL_THREADS) ]) #------------------------------------------------------------------------ @@ -234,7 +235,7 @@ AC_DEFUN(SC_ENABLE_THREADS, [ # Arguments: # none # -# Requires the following vars to be set: +# Requires the following vars to be set in the Makefile: # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # @@ -244,10 +245,10 @@ AC_DEFUN(SC_ENABLE_THREADS, [ # --enable-symbols # # Defines the following vars: -# CFLAGS_DEFAULT Sets to CFLAGS_DEBUG if true -# Sets to CFLAGS_OPTIMIZE if false -# LDFLAGS_DEFAULT Sets to LDFLAGS_DEBUG if true -# Sets to LDFLAGS_OPTIMIZE if false +# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true +# Sets to $(CFLAGS_OPTIMIZE) if false +# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true +# Sets to $(LDFLAGS_OPTIMIZE) if false # DBGX Debug library extension # #------------------------------------------------------------------------ @@ -257,13 +258,13 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no]) if test "$tcl_ok" = "yes"; then - CFLAGS_DEFAULT="${CFLAGS_DEBUG}" - LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' + LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=d AC_MSG_RESULT([yes]) else - CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE}" - LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' + LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" AC_MSG_RESULT([no]) fi @@ -321,8 +322,6 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [ AC_DEFUN(SC_CONFIG_CFLAGS, [ # Step 0: Enable 64 bit support? - # Currently Tk requires no extra flags for 64bit support. - # It just needs to find the right compiler, which is up to the user. AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no]) @@ -345,11 +344,12 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ SHLIB_LD="" SHLIB_LD_LIBS="" LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32" STLIB_LD="${AR}" RC_OUT=-o RC_TYPE= RC_INCLUDE=--include + RC_DEFINE=--define RES=res.o MAKE_LIB="\${AR} crv \[$]@" POST_MAKE_LIB="\${RANLIB} \[$]@" @@ -385,39 +385,21 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ # dynamic AC_MSG_RESULT([using shared flags]) - # check to see if ld supports --shared. Libtool does a much - # more extensive test, but not really needed in this case. - if test -z "$LD"; then - ld_prog="`(${CC} -print-prog-name=ld) 2>/dev/null`" - if test -z "$ld_prog"; then - ld_prog=ld - else - # get rid of the potential '\r' from ld_prog. - ld_prog="`(echo $ld_prog | tr -d '\015' | sed 's,\\\\,\\/,g')`" - fi - LD="$ld_prog" - fi - - AC_MSG_CHECKING([whether $ld_prog supports -shared option]) - - # now the ad-hoc check to see if GNU ld supports --shared. - if "$LD" --shared 2>&1 | egrep ': -shared not supported' >/dev/null; then - ld_supports_shared="no" - SHLIB_LD="${DLLWRAP-dllwrap}" - else - ld_supports_shared="yes" - SHLIB_LD="${CC} -shared" + # ad-hoc check to see if CC supports -shared. + if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then + AC_MSG_ERROR([${CC} does not support the -shared option. + You will need to upgrade to a newer version of the toolchain.]) fi - AC_MSG_RESULT([$ld_supports_shared]) runtime= + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. Make sure CFLAGS is + # included so -mno-cygwin passed the correct libs to the linker. + SHLIB_LD='${CC} -shared ${CFLAGS}' # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags}" - if test "${ld_supports_shared}" = "yes"; then - MAKE_DLL="${MAKE_DLL} -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" - else - MAKE_DLL="${MAKE_DLL} --output-lib \$(patsubst %.dll,lib%.a,\[$]@)" - fi + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" + LIBSUFFIX="\${DBGX}.a" DLLSUFFIX="\${DBGX}.dll" EXESUFFIX="\${DBGX}.exe" @@ -429,8 +411,8 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="-Wall -Wconversion" - LDFLAGS_DEBUG=-g - LDFLAGS_OPTIMIZE=-O + LDFLAGS_DEBUG= + LDFLAGS_OPTIMIZE= # Specify the CC output file names based on the target name CC_OBJNAME="-o \[$]@" @@ -441,16 +423,17 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" else - SHLIB_LD="link -dll -nologo" + SHLIB_LD="link -dll -nologo -incremental:no" SHLIB_LD_LIBS="user32.lib advapi32.lib" LIBS="user32.lib advapi32.lib" - LIBS_GUI="gdi32.lib comdlg32.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib" AR="lib -nologo" STLIB_LD="lib -nologo" RC="rc" RC_OUT=-fo RC_TYPE=-r RC_INCLUDE=-i + RC_DEFINE=-d RES=res MAKE_LIB="\${AR} -out:\[$]@" POST_MAKE_LIB= @@ -494,6 +477,10 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ # built -- Console vs. Window. LDFLAGS_CONSOLE="-link -subsystem:console" LDFLAGS_WINDOW="-link -subsystem:windows" + + if test "$do64bit" = "yes" ; then + EXTRA_CFLAGS="$EXTRA_CFLAGS -DUSE_TCLALLOC=0" + fi fi ]) diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index 928b41e..e67504c 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -1,4 +1,3 @@ - /* * tkWinDialog.c -- * @@ -9,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: tkWinDialog.c,v 1.18 2000/11/03 01:22:16 hobbs Exp $ + * RCS: @(#) $Id: tkWinDialog.c,v 1.18.4.1 2001/07/03 20:01:10 dgp Exp $ * */ @@ -81,6 +80,16 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = { #define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0])) /* + * The value of TK_MULTI_MAX_PATH dictactes how many files can + * be retrieved with tk_get*File -multiple 1. It must be allocated + * on the stack, so make it large enough but not too large. -- hobbs + * The data is stored as <dir>\0<file1>\0<file2>\0...<fileN>\0\0. + * MAX_PATH == 260 on Win2K/NT. + */ + +#define TK_MULTI_MAX_PATH (MAX_PATH*20) + +/* * The following structure is used to pass information between the directory * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc. */ @@ -458,7 +467,7 @@ GetFileNameW(clientData, interp, objc, objv, open) { Tcl_Encoding unicodeEncoding = Tcl_GetEncoding(NULL, "unicode"); OPENFILENAMEW ofn; - WCHAR file[MAX_PATH]; + WCHAR file[TK_MULTI_MAX_PATH]; int result, winCode, oldMode, i, multi = 0; char *extension, *filter, *title; Tk_Window tkwin; @@ -469,17 +478,17 @@ GetFileNameW(clientData, interp, objc, objv, open) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); static char *saveOptionStrings[] = { "-defaultextension", "-filetypes", "-initialdir", "-initialfile", - "-parent", "-title", NULL + "-parent", "-title", NULL }; static char *openOptionStrings[] = { "-defaultextension", "-filetypes", "-initialdir", "-initialfile", - "-multiple", "-parent", "-title", NULL + "-multiple", "-parent", "-title", NULL }; char **optionStrings; - + enum options { - FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, - FILE_MULTIPLE, FILE_PARENT, FILE_TITLE + FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, + FILE_MULTIPLE, FILE_PARENT, FILE_TITLE }; result = TCL_ERROR; @@ -566,8 +575,8 @@ GetFileNameW(clientData, interp, objc, objv, open) if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { goto end; } - Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds), 0, NULL, (char *) file, + Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds), 0, NULL, (char *) file, sizeof(file), NULL, NULL, NULL); break; } @@ -615,7 +624,7 @@ GetFileNameW(clientData, interp, objc, objv, open) ofn.nMaxCustFilter = 0; ofn.nFilterIndex = 0; ofn.lpstrFile = (WCHAR *) file; - ofn.nMaxFile = MAX_PATH; + ofn.nMaxFile = TK_MULTI_MAX_PATH; ofn.lpstrFileTitle = NULL; ofn.nMaxFileTitle = 0; ofn.lpstrInitialDir = NULL; @@ -729,13 +738,13 @@ GetFileNameW(clientData, interp, objc, objv, open) Tcl_DString fullname, filename; Tcl_Obj *returnList; int count = 0; - + returnList = Tcl_NewObj(); Tcl_IncrRefCount(returnList); files = ofn.lpstrFile; Tcl_ExternalToUtfDString(unicodeEncoding, (char *) files, -1, &ds); - + /* Get directory */ dir = Tcl_DStringValue(&ds); for (p = dir; p && *p; p++) { @@ -747,7 +756,7 @@ GetFileNameW(clientData, interp, objc, objv, open) *p = '/'; } } - + while (*files != '\0') { while (*files != '\0') { files++; @@ -810,7 +819,11 @@ GetFileNameW(clientData, interp, objc, objv, open) * memory, bad window handles, etc.). Most of the error codes will be * ignored; as we find we want more specific error messages for * particular errors, we can extend the code as needed. + * + * We could also check for FNERR_BUFFERTOOSMALL, but we can't + * really do anything about it when it happens. */ + if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) { char *p; Tcl_DString ds; @@ -940,8 +953,8 @@ GetFileNameA(clientData, interp, objc, objv, open) * call GetSaveFileName(). */ { OPENFILENAME ofn; - TCHAR file[MAX_PATH], savePath[MAX_PATH]; - int result, winCode, oldMode, i; + TCHAR file[TK_MULTI_MAX_PATH], savePath[MAX_PATH]; + int result, winCode, oldMode, i, multi = 0; char *extension, *filter, *title; Tk_Window tkwin; HWND hWnd; @@ -949,13 +962,19 @@ GetFileNameA(clientData, interp, objc, objv, open) Tcl_DString extString, filterString, dirString, titleString; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - static char *optionStrings[] = { + static char *saveOptionStrings[] = { "-defaultextension", "-filetypes", "-initialdir", "-initialfile", - "-parent", "-title", NULL + "-parent", "-title", NULL }; + static char *openOptionStrings[] = { + "-defaultextension", "-filetypes", "-initialdir", "-initialfile", + "-multiple", "-parent", "-title", NULL + }; + char **optionStrings; + enum options { FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, - FILE_PARENT, FILE_TITLE + FILE_MULTIPLE, FILE_PARENT, FILE_TITLE }; result = TCL_ERROR; @@ -972,6 +991,12 @@ GetFileNameA(clientData, interp, objc, objv, open) tkwin = (Tk_Window) clientData; title = NULL; + if (open) { + optionStrings = openOptionStrings; + } else { + optionStrings = saveOptionStrings; + } + for (i = 1; i < objc; i += 2) { int index; char *string; @@ -980,10 +1005,24 @@ GetFileNameA(clientData, interp, objc, objv, open) optionPtr = objv[i]; valuePtr = objv[i + 1]; - if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, + "option", 0, &index) != TCL_OK) { goto end; } + /* + * We want to maximize code sharing between the open and save file + * dialog implementations; in particular, the switch statement below. + * We use different sets of option strings from the GetIndexFromObj + * call above, but a single enumeration for both. The save file + * dialog doesn't support -multiple, but it falls in the middle of + * the enumeration. Ultimately, this means that when the index found + * by GetIndexFromObj is >= FILE_MULTIPLE, when doing a save file + * dialog, we have to increment the index, so that it matches the + * open file dialog enumeration. + */ + if (!open && index >= FILE_MULTIPLE) { + index++; + } if (i + 1 == objc) { string = Tcl_GetStringFromObj(optionPtr, NULL); Tcl_AppendResult(interp, "value for \"", string, "\" missing", @@ -1010,7 +1049,7 @@ GetFileNameA(clientData, interp, objc, objv, open) } case FILE_INITDIR: { Tcl_DStringFree(&utfDirString); - if (Tcl_TranslateFileName(interp, string, + if (Tcl_TranslateFileName(interp, string, &utfDirString) == NULL) { goto end; } @@ -1027,6 +1066,13 @@ GetFileNameA(clientData, interp, objc, objv, open) sizeof(file), NULL, NULL, NULL); break; } + case FILE_MULTIPLE: { + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &multi) != TCL_OK) { + return TCL_ERROR; + } + break; + } case FILE_PARENT: { tkwin = Tk_NameToWindow(interp, string, tkwin); if (tkwin == NULL) { @@ -1064,7 +1110,7 @@ GetFileNameA(clientData, interp, objc, objv, open) ofn.nMaxCustFilter = 0; ofn.nFilterIndex = 0; ofn.lpstrFile = (LPTSTR) file; - ofn.nMaxFile = MAX_PATH; + ofn.nMaxFile = TK_MULTI_MAX_PATH; ofn.lpstrFileTitle = NULL; ofn.nMaxFileTitle = 0; ofn.lpstrInitialDir = NULL; @@ -1088,6 +1134,10 @@ GetFileNameA(clientData, interp, objc, objv, open) ofn.Flags |= OFN_ENABLEHOOK; } + if (multi != 0) { + ofn.Flags |= OFN_ALLOWMULTISELECT; + } + if (extension != NULL) { Tcl_UtfToExternalDString(NULL, extension, -1, &extString); ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString); @@ -1126,7 +1176,7 @@ GetFileNameA(clientData, interp, objc, objv, open) } /* - * Popup the dialog. + * Popup the dialog. */ GetCurrentDirectory(MAX_PATH, savePath); @@ -1158,21 +1208,92 @@ GetFileNameA(clientData, interp, objc, objv, open) */ if (winCode != 0) { - char *p; - Tcl_DString ds; - - 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 + if (ofn.Flags & OFN_ALLOWMULTISELECT) { + /* + * The result in custData->szFile contains many items, + * separated with null characters. It is terminated with + * two nulls in a row. The first element is the directory + * path. */ - if (*p == '\\') { - *p = '/'; + char *dir; + char *p; + char *file; + char *files; + Tcl_DString ds; + Tcl_DString fullname, filename; + Tcl_Obj *returnList; + int count = 0; + + returnList = Tcl_NewObj(); + Tcl_IncrRefCount(returnList); + + files = ofn.lpstrFile; + Tcl_ExternalToUtfDString(NULL, (char *) files, -1, &ds); + + /* Get directory */ + dir = Tcl_DStringValue(&ds); + for (p = dir; p && *p; p++) { + /* + * Change the pathname to the Tcl "normalized" pathname, where + * back slashes are used instead of forward slashes + */ + if (*p == '\\') { + *p = '/'; + } } + + while (*files != '\0') { + while (*files != '\0') { + files++; + } + files++; + if (*files != '\0') { + count++; + Tcl_ExternalToUtfDString(NULL, + (char *)files, -1, &filename); + file = Tcl_DStringValue(&filename); + for (p = file; *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } + Tcl_DStringInit(&fullname); + Tcl_DStringAppend(&fullname, dir, -1); + Tcl_DStringAppend(&fullname, "/", -1); + Tcl_DStringAppend(&fullname, file, -1); + Tcl_ListObjAppendElement(interp, returnList, + Tcl_NewStringObj(Tcl_DStringValue(&fullname), -1)); + Tcl_DStringFree(&fullname); + Tcl_DStringFree(&filename); + } + } + if (count == 0) { + /* + * Only one file was returned. + */ + Tcl_ListObjAppendElement(interp, returnList, + Tcl_NewStringObj(dir, -1)); + } + Tcl_SetObjResult(interp, returnList); + Tcl_DecrRefCount(returnList); + Tcl_DStringFree(&ds); + } else { + char *p; + Tcl_DString ds; + + 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 + */ + if (*p == '\\') { + *p = '/'; + } + } + Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); + Tcl_DStringFree(&ds); } - Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); - Tcl_DStringFree(&ds); result = TCL_OK; } else { /* @@ -1182,12 +1303,15 @@ GetFileNameA(clientData, interp, objc, objv, open) * memory, bad window handles, etc.). Most of the error codes will be * ignored;; as we find we want specific error messages for particular * errors, we can extend the code as needed. + * + * We could also check for FNERR_BUFFERTOOSMALL, but we can't + * really do anything about it when it happens. */ if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) { char *p; Tcl_DString ds; - - Tcl_ExternalToUtfDString(NULL,(char *) ofn.lpstrFile, -1, &ds); + + Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds); for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { /* * Change the pathname to the Tcl "normalized" pathname, diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 710779a..b6194a5 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.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: tkWinInt.h,v 1.10 2000/04/12 18:51:11 hobbs Exp $ + * RCS: @(#) $Id: tkWinInt.h,v 1.10.6.1 2001/07/03 20:01:10 dgp Exp $ */ #ifndef _TKWININT @@ -167,5 +167,7 @@ EXTERN void TkWinUpdatingClipboard(int mode); #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +extern Tcl_Encoding TkWinGetKeyInputEncoding _ANSI_ARGS_((void)); + #endif /* _TKWININT */ diff --git a/win/tkWinKey.c b/win/tkWinKey.c index bb61d23..efa332a 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.12 2000/04/15 17:41:20 hobbs Exp $ + * RCS: @(#) $Id: tkWinKey.c,v 1.12.6.1 2001/07/03 20:01:10 dgp Exp $ */ #include "tkWinInt.h" @@ -90,7 +90,29 @@ TkpGetString(winPtr, eventPtr, dsPtr) XKeyEvent* keyEv = &eventPtr->xkey; Tcl_DStringInit(dsPtr); - if (eventPtr->xkey.send_event != -1) { + if (eventPtr->xkey.send_event == -1) { + if (eventPtr->xkey.nbytes > 0) { + Tcl_ExternalToUtfDString(TkWinGetKeyInputEncoding(), + eventPtr->xkey.trans_chars, eventPtr->xkey.nbytes, dsPtr); + } + } else if (eventPtr->xkey.send_event == -2) { + /* + * Special case for win2000 multi-lingal IME input. + * xkey.trans_chars[] already contains a UNICODE char. + */ + + int unichar; + char buf[TCL_UTF_MAX]; + int len; + + unichar = (eventPtr->xkey.trans_chars[1] & 0xff); + unichar <<= 8; + unichar |= (eventPtr->xkey.trans_chars[0] & 0xff); + + len = Tcl_UniCharToUtf((Tcl_UniChar) unichar, buf); + + Tcl_DStringAppend(dsPtr, buf, len); + } else { /* * This is an event generated from generic code. It has no * nchars or trans_chars members. @@ -105,9 +127,6 @@ TkpGetString(winPtr, eventPtr, dsPtr) int len = Tcl_UniCharToUtf((Tcl_UniChar) (keysym & 255), buf); Tcl_DStringAppend(dsPtr, buf, len); } - } else if (eventPtr->xkey.nbytes > 0) { - Tcl_ExternalToUtfDString(NULL, eventPtr->xkey.trans_chars, - eventPtr->xkey.nbytes, dsPtr); } return Tcl_DStringValue(dsPtr); } @@ -565,14 +584,6 @@ TkpSetKeycodeAndState(tkwin, keySym, eventPtr) eventPtr->xkey.keycode = (KeyCode) (result & 0xff); } } - { - /* Debug log */ - FILE *fp = fopen("c:\\temp\\tklog.txt", "a"); - if (fp != NULL) { - fprintf(fp, "TkpSetKeycode. Keycode %d State %d Keysym %d\n", eventPtr->xkey.keycode, eventPtr->xkey.state, keySym); - fclose(fp); - } - } } /* diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 3fb0102..c89089e 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.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: tkWinMenu.c,v 1.13 2000/08/29 21:00:13 ericm Exp $ + * RCS: @(#) $Id: tkWinMenu.c,v 1.13.4.1 2001/07/03 20:01:10 dgp Exp $ */ #define OEMRESOURCE @@ -1101,8 +1101,8 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult) TkMenuInit(); if ((flags == 0xFFFF) && (*plParam == 0)) { - Tcl_SetServiceMode(tsdPtr->oldServiceMode); if (tsdPtr->modalMenuPtr != NULL) { + Tcl_SetServiceMode(tsdPtr->oldServiceMode); RecursivelyClearActiveMenu(tsdPtr->modalMenuPtr); } } else { diff --git a/win/tkWinWm.c b/win/tkWinWm.c index a587f35..fba48a0 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.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: tkWinWm.c,v 1.28 2001/01/02 19:13:02 andreas_kupries Exp $ + * RCS: @(#) $Id: tkWinWm.c,v 1.28.2.1 2001/07/03 20:01:10 dgp Exp $ */ #include "tkWinInt.h" @@ -1462,8 +1462,8 @@ UpdateWrapper(winPtr) TkWindow *winPtr; /* Top-level window to redecorate. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - HWND parentHWND = NULL, oldWrapper; - HWND child = TkWinGetHWND(winPtr->window); + HWND parentHWND, oldWrapper; + HWND child; int x, y, width, height, state; WINDOWPLACEMENT place; HICON hSmallIcon = NULL; @@ -1473,8 +1473,15 @@ UpdateWrapper(winPtr) ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - parentHWND = NULL; + if (winPtr->window == None) { + /* + * Ensure existence of the window to update the wrapper for. + */ + Tk_MakeWindowExist((Tk_Window) winPtr); + } + child = TkWinGetHWND(winPtr->window); + parentHWND = NULL; if (winPtr->flags & TK_EMBEDDED) { wmPtr->wrapper = (HWND) winPtr->privatePtr; diff --git a/win/tkWinX.c b/win/tkWinX.c index 0325df7..a4bff30 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.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: tkWinX.c,v 1.11 2000/07/06 03:17:45 mo Exp $ + * RCS: @(#) $Id: tkWinX.c,v 1.11.4.1 2001/07/03 20:01:10 dgp Exp $ */ #include "tkWinInt.h" @@ -22,6 +22,12 @@ #include <zmouse.h> /* + * imm.h is needed by HandleIMEComposition + */ + +#include <imm.h> + +/* * Declarations of static variables used in this file. */ @@ -29,7 +35,11 @@ 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. */ -static int tkPlatformId; /* version of Windows platform */ +static int tkPlatformId = 0; /* version of Windows platform */ +static Tcl_Encoding keyInputEncoding = NULL;/* The current character + * encoding for keyboard input */ +static int keyInputCharset = -1; /* The Win32 CHARSET for the keyboard + * encoding */ /* * Thread local storage. Notice that now each thread must have its @@ -52,6 +62,9 @@ static void GenerateXEvent _ANSI_ARGS_((HWND hwnd, UINT message, static unsigned int GetState _ANSI_ARGS_((UINT message, WPARAM wParam, LPARAM lParam)); static void GetTranslatedKey _ANSI_ARGS_((XKeyEvent *xkey)); +static void UpdateInputLanguage _ANSI_ARGS_((int charset)); +static int HandleIMEComposition _ANSI_ARGS_((HWND hwnd, + LPARAM lParam)); /* *---------------------------------------------------------------------- @@ -130,8 +143,6 @@ void TkWinXInit(hInstance) HINSTANCE hInstance; { - OSVERSIONINFO os; - if (childClassInitialized != 0) { return; } @@ -139,10 +150,6 @@ TkWinXInit(hInstance) tkInstance = hInstance; - os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&os); - tkPlatformId = os.dwPlatformId; - /* * When threads are enabled, we cannot use CLASSDC because * threads will then write into the same device context. @@ -220,7 +227,7 @@ TkWinXCleanup(hInstance) * TkWinGetPlatformId -- * * Determines whether running under NT, 95, or Win32s, to allow - * runtime conditional code. + * runtime conditional code. Win32s is no longer supported. * * Results: * The return value is one of: @@ -237,6 +244,13 @@ TkWinXCleanup(hInstance) int TkWinGetPlatformId() { + if (tkPlatformId == 0) { + OSVERSIONINFO os; + + os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + GetVersionEx(&os); + tkPlatformId = os.dwPlatformId; + } return tkPlatformId; } @@ -524,6 +538,18 @@ TkWinChildProc(hwnd, message, wParam, lParam) LRESULT result; switch (message) { + case WM_INPUTLANGCHANGE: + UpdateInputLanguage(wParam); + result = 1; + break; + + case WM_IME_COMPOSITION: + result = 0; + if (HandleIMEComposition(hwnd, lParam) == 0) { + result = DefWindowProc(hwnd, message, wParam, lParam); + } + break; + case WM_SETCURSOR: /* * Short circuit the WM_SETCURSOR message since we set @@ -826,13 +852,11 @@ GenerateXEvent(hwnd, message, wParam, lParam) /* * Check for translated characters in the event queue. * Setting xany.send_event to -1 indicates to the - * Windows implementation of XLookupString that this + * Windows implementation of TkpGetString() that this * event was generated by windows and that the Windows * extension xkey.trans_chars is filled with the - * characters that came from the TranslateMessage - * call. If it is not -1, xkey.keycode is the - * virtual key being sent programmatically by generic - * code. + * MBCS characters that came from the TranslateMessage + * call. */ event.type = KeyPress; @@ -1017,7 +1041,6 @@ GetTranslatedKey(xkey) XKeyEvent *xkey; { MSG msg; - char buf[XMaxTransChars]; xkey->nbytes = 0; @@ -1037,9 +1060,21 @@ 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++; + + if (((unsigned short) msg.wParam) > ((unsigned short) 0xff)) { + /* + * Some "addon" input devices, such as the popular + * PenPower Chinese writing pad, generate 16 bit + * values in WM_CHAR messages (instead of passing them + * in two separate WM_CHAR messages containing two + * 8-bit values. + */ + + xkey->trans_chars[xkey->nbytes] = (char) (msg.wParam >> 8); + xkey->nbytes ++; + } } else { break; } @@ -1049,6 +1084,202 @@ GetTranslatedKey(xkey) /* *---------------------------------------------------------------------- * + * UpdateInputLanguage -- + * + * Gets called when a WM_INPUTLANGCHANGE message is received + * by the TK child window procedure. This message is sent + * by the Input Method Editor system when the user chooses + * a different input method. All subsequent WM_CHAR + * messages will contain characters in the new encoding. We record + * the new encoding so that TkpGetString() knows how to + * correctly translate the WM_CHAR into unicode. + * + * Results: + * Records the new encoding in keyInputEncoding. + * + * Side effects: + * Old value of keyInputEncoding is freed. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateInputLanguage(charset) + int charset; +{ + CHARSETINFO charsetInfo; + Tcl_Encoding encoding; + char codepage[4 + TCL_INTEGER_SPACE]; + + if (keyInputCharset == charset) { + return; + } + if (TranslateCharsetInfo((DWORD*)charset, &charsetInfo, TCI_SRCCHARSET) + == 0) { + /* + * Some mysterious failure. + */ + + return; + } + + wsprintfA(codepage, "cp%d", charsetInfo.ciACP); + + if ((encoding = Tcl_GetEncoding(NULL, codepage)) == NULL) { + /* + * The encoding is not supported by Tcl. + */ + + return; + } + + if (keyInputEncoding != NULL) { + Tcl_FreeEncoding(keyInputEncoding); + } + + keyInputEncoding = encoding; + keyInputCharset = charset; +} + +/* + *---------------------------------------------------------------------- + * + * TkWinGetKeyInputEncoding -- + * + * Returns the current keyboard input encoding selected by the + * user (with WM_INPUTLANGCHANGE events). + * + * Results: + * The current keyboard input encoding. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Encoding +TkWinGetKeyInputEncoding() +{ + return keyInputEncoding; +} + +/* + *---------------------------------------------------------------------- + * + * HandleIMEComposition -- + * + * This function works around a definciency in some versions + * of Windows 2000 to make it possible to entry multi-lingual + * characters under all versions of Windows 2000. + * + * When an Input Method Editor (IME) is ready to send input + * characters to an application, it sends a WM_IME_COMPOSITION + * message with the GCS_RESULTSTR. However, The DefWindowProc() + * on English Windows 2000 arbitrarily converts all non-Latin-1 + * characters in the composition to "?". + * + * This function correctly processes the composition data and + * sends the UNICODE values of the composed characters to + * TK's event queue. + * + * Results: + * If this function has processed the composition data, returns 1. + * Otherwise returns 0. + * + * Side effects: + * Key events are put into the TK event queue. + * + *---------------------------------------------------------------------- + */ + +static int +HandleIMEComposition(hwnd, lParam) + HWND hwnd; /* Window receiving the message. */ + LPARAM lParam; /* Flags for the WM_IME_COMPOSITION + * message */ +{ + HIMC hIMC; + int i, n; + XEvent event; + char * buff; + TkWindow *winPtr; + + if (TkWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { + /* + * The ImmGetCompositionStringW function works only on WinNT. + */ + + return 0; + } + + if ((lParam & GCS_RESULTSTR) == 0) { + /* + * Composition is not finished yet. + */ + + return 0; + } + + hIMC = ImmGetContext(hwnd); + if (hIMC) { + n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, NULL, 0); + + if (n > 0) { + buff = (char*)ckalloc(n); + n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, buff, n); + + /* + * Set up the fields pertinent to key event. + * + * We set send_event to the special value of -2, so that + * TkpGetString() in tkWinKey.c knows that trans_chars[] + * already contains a UNICODE char and there's no need to + * do encoding conversion. + */ + + winPtr = (TkWindow *)Tk_HWNDToWindow(hwnd); + + event.xkey.serial = winPtr->display->request++; + event.xkey.send_event = -2; + event.xkey.display = winPtr->display; + event.xkey.window = winPtr->window; + event.xkey.root = RootWindow(winPtr->display, winPtr->screenNum); + event.xkey.subwindow = None; + event.xkey.state = TkWinGetModifierState(); + event.xkey.time = TkpGetMS(); + event.xkey.same_screen = True; + event.xkey.keycode = 0; + event.xkey.nbytes = 2; + + for (i=0; i<n;) { + /* + * Simulate a pair of KeyPress and KeyRelease events + * for each UNICODE character in the composition. + */ + + event.xkey.trans_chars[0] = (char) buff[i++]; + event.xkey.trans_chars[1] = (char) buff[i++]; + + event.type = KeyPress; + Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); + + event.type = KeyRelease; + Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); + } + + ckfree(buff); + } + ImmReleaseContext(hwnd, hIMC); + return 1; + } + + return 0; +} + +/* + *---------------------------------------------------------------------- + * * Tk_FreeXId -- * * This inteface is not needed under Windows. |