tk8.5.19/0000755003604700454610000000000012656405252010561 5ustar dgp771divtk8.5.19/README0000644003604700454610000000252512612450432011435 0ustar dgp771divREADME: Tk This is the Tk 8.5.19 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tk from the URL above. 1. Introduction --------------- This directory contains the sources and documentation for Tk, a cross-platform GUI toolkit implemented with the Tcl scripting language. For details on features, incompatibilities, and potential problems with this release, see the Tcl/Tk 8.5 Web page at http://www.tcl.tk/software/tcltk/8.5.html 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 by the Tcl community. Source code development and tracking of bug reports and feature requests takes place at: http://core.tcl.tk/tk/ with the Tcl Developer Xchange at: http://www.tcl.tk/ Tk is a freely available open source package. You can do virtually anything you like with it, such as modifying it, redistributing it, and selling it either in whole or in part. See the file "license.terms" for complete information. 2. See Tcl README ----------------- Please see the README file that comes with the associated Tcl release for more information. There are pointers there to extensive documentation. In addition, there are additional README files in the subdirectories of this distribution. tk8.5.19/unix/0000755003604700454610000000000012656405252011544 5ustar dgp771divtk8.5.19/unix/aclocal.m40000644003604700454610000000004012656405252013376 0ustar dgp771divbuiltin(include,../unix/tcl.m4) tk8.5.19/unix/tkUnixScrlbr.c0000644003604700454610000003304212612445655014347 0ustar dgp771div/* * tkUnixScrollbar.c -- * * This file implements the Unix specific portion of the scrollbar * widget. * * Copyright (c) 1996 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" #include "tkScrollbar.h" /* * Minimum slider length, in pixels (designed to make sure that the slider is * always easy to grab with the mouse). */ #define MIN_SLIDER_LENGTH 5 /* * Declaration of Unix specific scrollbar structure. */ typedef struct UnixScrollbar { TkScrollbar info; /* Generic scrollbar info. */ GC troughGC; /* For drawing trough. */ GC copyGC; /* Used for copying from pixmap onto screen. */ } UnixScrollbar; /* * The class procedure table for the scrollbar widget. All fields except size * are left initialized to NULL, which should happen automatically since the * variable is declared at this scope. */ Tk_ClassProcs tkpScrollbarProcs = { sizeof(Tk_ClassProcs) /* size */ }; /* *---------------------------------------------------------------------- * * TkpCreateScrollbar -- * * Allocate a new TkScrollbar structure. * * Results: * Returns a newly allocated TkScrollbar structure. * * Side effects: * Registers an event handler for the widget. * *---------------------------------------------------------------------- */ TkScrollbar * TkpCreateScrollbar( Tk_Window tkwin) { UnixScrollbar *scrollPtr = (UnixScrollbar *)ckalloc(sizeof(UnixScrollbar)); scrollPtr->troughGC = None; scrollPtr->copyGC = None; Tk_CreateEventHandler(tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, TkScrollbarEventProc, (ClientData) scrollPtr); return (TkScrollbar *) scrollPtr; } /* *-------------------------------------------------------------- * * TkpDisplayScrollbar -- * * This procedure redraws the contents of a scrollbar window. It is * invoked as a do-when-idle handler, so it only runs when there's * nothing else for the application to do. * * Results: * None. * * Side effects: * Information appears on the screen. * *-------------------------------------------------------------- */ void TkpDisplayScrollbar( ClientData clientData) /* Information about window. */ { register TkScrollbar *scrollPtr = (TkScrollbar *) clientData; register Tk_Window tkwin = scrollPtr->tkwin; XPoint points[7]; Tk_3DBorder border; int relief, width, elementBorderWidth; Pixmap pixmap; if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { goto done; } if (scrollPtr->vertical) { width = Tk_Width(tkwin) - 2*scrollPtr->inset; } else { width = Tk_Height(tkwin) - 2*scrollPtr->inset; } elementBorderWidth = scrollPtr->elementBorderWidth; if (elementBorderWidth < 0) { elementBorderWidth = scrollPtr->borderWidth; } /* * In order to avoid screen flashes, this procedure redraws the scrollbar * in a pixmap, then copies the pixmap to the screen in a single * operation. This means that there's no point in time where the on-sreen * image has been cleared. */ pixmap = Tk_GetPixmap(scrollPtr->display, Tk_WindowId(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); if (scrollPtr->highlightWidth != 0) { GC gc; if (scrollPtr->flags & GOT_FOCUS) { gc = Tk_GCForColor(scrollPtr->highlightColorPtr, pixmap); } else { gc = Tk_GCForColor(scrollPtr->highlightBgColorPtr, pixmap); } Tk_DrawFocusHighlight(tkwin, gc, scrollPtr->highlightWidth, pixmap); } Tk_Draw3DRectangle(tkwin, pixmap, scrollPtr->bgBorder, scrollPtr->highlightWidth, scrollPtr->highlightWidth, Tk_Width(tkwin) - 2*scrollPtr->highlightWidth, Tk_Height(tkwin) - 2*scrollPtr->highlightWidth, scrollPtr->borderWidth, scrollPtr->relief); XFillRectangle(scrollPtr->display, pixmap, ((UnixScrollbar*)scrollPtr)->troughGC, scrollPtr->inset, scrollPtr->inset, (unsigned) (Tk_Width(tkwin) - 2*scrollPtr->inset), (unsigned) (Tk_Height(tkwin) - 2*scrollPtr->inset)); /* * Draw the top or left arrow. The coordinates of the polygon points * probably seem odd, but they were carefully chosen with respect to X's * rules for filling polygons. These point choices cause the arrows to * just fill the narrow dimension of the scrollbar and be properly * centered. */ if (scrollPtr->activeField == TOP_ARROW) { border = scrollPtr->activeBorder; relief = scrollPtr->activeField == TOP_ARROW ? scrollPtr->activeRelief : TK_RELIEF_RAISED; } else { border = scrollPtr->bgBorder; relief = TK_RELIEF_RAISED; } if (scrollPtr->vertical) { points[0].x = scrollPtr->inset - 1; points[0].y = scrollPtr->arrowLength + scrollPtr->inset - 1; points[1].x = width + scrollPtr->inset; points[1].y = points[0].y; points[2].x = width/2 + scrollPtr->inset; points[2].y = scrollPtr->inset - 1; Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3, elementBorderWidth, relief); } else { points[0].x = scrollPtr->arrowLength + scrollPtr->inset - 1; points[0].y = scrollPtr->inset - 1; points[1].x = scrollPtr->inset; points[1].y = width/2 + scrollPtr->inset; points[2].x = points[0].x; points[2].y = width + scrollPtr->inset; Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3, elementBorderWidth, relief); } /* * Display the bottom or right arrow. */ if (scrollPtr->activeField == BOTTOM_ARROW) { border = scrollPtr->activeBorder; relief = scrollPtr->activeField == BOTTOM_ARROW ? scrollPtr->activeRelief : TK_RELIEF_RAISED; } else { border = scrollPtr->bgBorder; relief = TK_RELIEF_RAISED; } if (scrollPtr->vertical) { points[0].x = scrollPtr->inset; points[0].y = Tk_Height(tkwin) - scrollPtr->arrowLength - scrollPtr->inset + 1; points[1].x = width/2 + scrollPtr->inset; points[1].y = Tk_Height(tkwin) - scrollPtr->inset; points[2].x = width + scrollPtr->inset; points[2].y = points[0].y; Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3, elementBorderWidth, relief); } else { points[0].x = Tk_Width(tkwin) - scrollPtr->arrowLength - scrollPtr->inset + 1; points[0].y = scrollPtr->inset - 1; points[1].x = points[0].x; points[1].y = width + scrollPtr->inset; points[2].x = Tk_Width(tkwin) - scrollPtr->inset; points[2].y = width/2 + scrollPtr->inset; Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3, elementBorderWidth, relief); } /* * Display the slider. */ if (scrollPtr->activeField == SLIDER) { border = scrollPtr->activeBorder; relief = scrollPtr->activeField == SLIDER ? scrollPtr->activeRelief : TK_RELIEF_RAISED; } else { border = scrollPtr->bgBorder; relief = TK_RELIEF_RAISED; } if (scrollPtr->vertical) { Tk_Fill3DRectangle(tkwin, pixmap, border, scrollPtr->inset, scrollPtr->sliderFirst, width, scrollPtr->sliderLast - scrollPtr->sliderFirst, elementBorderWidth, relief); } else { Tk_Fill3DRectangle(tkwin, pixmap, border, scrollPtr->sliderFirst, scrollPtr->inset, scrollPtr->sliderLast - scrollPtr->sliderFirst, width, elementBorderWidth, relief); } /* * Copy the information from the off-screen pixmap onto the screen, then * delete the pixmap. */ XCopyArea(scrollPtr->display, pixmap, Tk_WindowId(tkwin), ((UnixScrollbar*)scrollPtr)->copyGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); Tk_FreePixmap(scrollPtr->display, pixmap); done: scrollPtr->flags &= ~REDRAW_PENDING; } /* *---------------------------------------------------------------------- * * TkpComputeScrollbarGeometry -- * * After changes in a scrollbar's size or configuration, this procedure * recomputes various geometry information used in displaying the * scrollbar. * * Results: * None. * * Side effects: * The scrollbar will be displayed differently. * *---------------------------------------------------------------------- */ extern void TkpComputeScrollbarGeometry( register TkScrollbar *scrollPtr) /* Scrollbar whose geometry may have * changed. */ { int width, fieldLength; if (scrollPtr->highlightWidth < 0) { scrollPtr->highlightWidth = 0; } scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth; width = (scrollPtr->vertical) ? Tk_Width(scrollPtr->tkwin) : Tk_Height(scrollPtr->tkwin); scrollPtr->arrowLength = width - 2*scrollPtr->inset + 1; fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin) : Tk_Width(scrollPtr->tkwin)) - 2*(scrollPtr->arrowLength + scrollPtr->inset); if (fieldLength < 0) { fieldLength = 0; } scrollPtr->sliderFirst = fieldLength*scrollPtr->firstFraction; scrollPtr->sliderLast = fieldLength*scrollPtr->lastFraction; /* * Adjust the slider so that some piece of it is always displayed in the * scrollbar and so that it has at least a minimal width (so it can be * grabbed with the mouse). */ if (scrollPtr->sliderFirst > (fieldLength - MIN_SLIDER_LENGTH)) { scrollPtr->sliderFirst = fieldLength - MIN_SLIDER_LENGTH; } if (scrollPtr->sliderFirst < 0) { scrollPtr->sliderFirst = 0; } if (scrollPtr->sliderLast < (scrollPtr->sliderFirst + MIN_SLIDER_LENGTH)) { scrollPtr->sliderLast = scrollPtr->sliderFirst + MIN_SLIDER_LENGTH; } if (scrollPtr->sliderLast > fieldLength) { scrollPtr->sliderLast = fieldLength; } scrollPtr->sliderFirst += scrollPtr->arrowLength + scrollPtr->inset; scrollPtr->sliderLast += scrollPtr->arrowLength + scrollPtr->inset; /* * Register the desired geometry for the window (leave enough space for * the two arrows plus a minimum-size slider, plus border around the whole * window, if any). Then arrange for the window to be redisplayed. */ if (scrollPtr->vertical) { Tk_GeometryRequest(scrollPtr->tkwin, scrollPtr->width + 2*scrollPtr->inset, 2*(scrollPtr->arrowLength + scrollPtr->borderWidth + scrollPtr->inset)); } else { Tk_GeometryRequest(scrollPtr->tkwin, 2*(scrollPtr->arrowLength + scrollPtr->borderWidth + scrollPtr->inset), scrollPtr->width + 2*scrollPtr->inset); } Tk_SetInternalBorder(scrollPtr->tkwin, scrollPtr->inset); } /* *---------------------------------------------------------------------- * * TkpDestroyScrollbar -- * * Free data structures associated with the scrollbar control. * * Results: * None. * * Side effects: * Frees the GCs associated with the scrollbar. * *---------------------------------------------------------------------- */ void TkpDestroyScrollbar( TkScrollbar *scrollPtr) { UnixScrollbar *unixScrollPtr = (UnixScrollbar *)scrollPtr; if (unixScrollPtr->troughGC != None) { Tk_FreeGC(scrollPtr->display, unixScrollPtr->troughGC); } if (unixScrollPtr->copyGC != None) { Tk_FreeGC(scrollPtr->display, unixScrollPtr->copyGC); } } /* *---------------------------------------------------------------------- * * TkpConfigureScrollbar -- * * This procedure is called after the generic code has finished * processing configuration options, in order to configure platform * specific options. * * Results: * None. * * Side effects: * Configuration info may get changed. * *---------------------------------------------------------------------- */ void TkpConfigureScrollbar( register TkScrollbar *scrollPtr) /* Information about widget; may or may not * already have values for some fields. */ { XGCValues gcValues; GC new; UnixScrollbar *unixScrollPtr = (UnixScrollbar *) scrollPtr; Tk_SetBackgroundFromBorder(scrollPtr->tkwin, scrollPtr->bgBorder); gcValues.foreground = scrollPtr->troughColorPtr->pixel; new = Tk_GetGC(scrollPtr->tkwin, GCForeground, &gcValues); if (unixScrollPtr->troughGC != None) { Tk_FreeGC(scrollPtr->display, unixScrollPtr->troughGC); } unixScrollPtr->troughGC = new; if (unixScrollPtr->copyGC == None) { gcValues.graphics_exposures = False; unixScrollPtr->copyGC = Tk_GetGC(scrollPtr->tkwin, GCGraphicsExposures, &gcValues); } } /* *-------------------------------------------------------------- * * TkpScrollbarPosition -- * * Determine the scrollbar element corresponding to a given position. * * Results: * One of TOP_ARROW, TOP_GAP, etc., indicating which element of the * scrollbar covers the position given by (x, y). If (x,y) is outside the * scrollbar entirely, then OUTSIDE is returned. * * Side effects: * None. * *-------------------------------------------------------------- */ int TkpScrollbarPosition( register TkScrollbar *scrollPtr, /* Scrollbar widget record. */ int x, int y) /* Coordinates within scrollPtr's window. */ { int length, width, tmp; if (scrollPtr->vertical) { length = Tk_Height(scrollPtr->tkwin); width = Tk_Width(scrollPtr->tkwin); } else { tmp = x; x = y; y = tmp; length = Tk_Width(scrollPtr->tkwin); width = Tk_Height(scrollPtr->tkwin); } if ((x < scrollPtr->inset) || (x >= (width - scrollPtr->inset)) || (y < scrollPtr->inset) || (y >= (length - scrollPtr->inset))) { return OUTSIDE; } /* * All of the calculations in this procedure mirror those in * TkpDisplayScrollbar. Be sure to keep the two consistent. */ if (y < (scrollPtr->inset + scrollPtr->arrowLength)) { return TOP_ARROW; } if (y < scrollPtr->sliderFirst) { return TOP_GAP; } if (y < scrollPtr->sliderLast) { return SLIDER; } if (y >= (length - (scrollPtr->arrowLength + scrollPtr->inset))) { return BOTTOM_ARROW; } return BOTTOM_GAP; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/installManPage0000755003604700454610000000565012656405252014377 0ustar dgp771div#!/bin/sh ######################################################################## ### Parse Options ### Gzip=: SymOrLoc="" Gz="" Suffix="" while true; do case $1 in -s | --symlinks ) SymOrLoc="-s " ;; -z | --compress ) Gzip=$2; shift ;; -e | --extension ) Gz=$2; shift ;; -x | --suffix ) Suffix=$2; shift ;; -*) cat < file dir" exit 1 fi ######################################################################## ### Parse Required Arguments ### ManPage=$1 Dir=$2 if test -f $ManPage ; then : ; else echo "source manual page file must exist" exit 1 fi if test -d $Dir ; then : ; else echo "target directory must exist" exit 1 fi test -z "$SymOrLoc" && SymOrLoc="$Dir/" ######################################################################## ### Extract Target Names from Manual Page ### # A sed script to parse the alternative names out of a man page. # # Backslashes are trippled in the sed script, because it is in # backticks which doesn't pass backslashes literally. # Names=`sed -n ' # Look for a line, that starts with .SH NAME # optionally allow NAME to be surrounded # by quotes. /^\.SH NAME/{ # Read next line n # Remove all commas ... s/,//g # ... and backslash-escaped spaces. s/\\\ //g # Delete from \- to the end of line s/ \\\-.*// # print the result and exit p;q }' $ManPage` if test -z "$Names" ; then echo "warning: no target names found in $ManPage" fi ######################################################################## ### Remaining Set Up ### case $ManPage in *.1) Section=1 ;; *.3) Section=3 ;; *.n) Section=n ;; *) echo "unknown section for $ManPage" exit 2 ;; esac SrcDir=`dirname $ManPage` ######################################################################## ### Process Page to Create Target Pages ### First="" for Target in $Names; do Target=$Target.$Section$Suffix rm -f $Dir/$Target $Dir/$Target.* if test -z "$First" ; then First=$Target sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \ $ManPage > $Dir/$First chmod 444 $Dir/$First $Gzip $Dir/$First else ln $SymOrLoc$First$Gz $Dir/$Target$Gz fi done ######################################################################## exit 0 tk8.5.19/unix/README0000644003604700454610000002072212656405252012427 0ustar dgp771divTk UNIX README -------------- This is the directory where you configure, compile, test, and install UNIX versions of Tk. This directory also contains source files for Tk that are specific to UNIX. The information in this file is maintained at: http://www.tcl.tk/doc/howto/compile.html For information on platforms where Tcl/Tk is known to compile, along with any porting notes for getting it to work on those platforms, see: http://www.tcl.tk/software/tcltk/platforms.html The rest of this file contains instructions on how to do this. The release should compile and run either "out of the box" or with trivial changes on any UNIX-like system that approximates POSIX, BSD, or System V. We know that it runs on workstations from Sun, H-P, DEC, IBM, and SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for a PC running Windows, see the README file in the directory ../win. To compile for MacOSX, see the README file in the directory ../macosx. How To Compile And Install Tk: ------------------------------ (a) Make sure that the Tcl release is present in the directory ../../tcl (or else use the "--with-tcl" switch described below). This release of Tk will only work with the equivalently versioned Tcl release. Also, be sure that you have configured Tcl before you configure Tk. (b) Check for patches as described in ../README. (c) If you have already compiled Tk once in this directory and are now preparing to compile again in the same directory but for a different platform, or if you have applied patches, type "make distclean" to discard all the configuration information computed previously. (d) Type "./configure". This runs a configuration script created by GNU autoconf, which configures Tk for your system and creates a Makefile. The configure script allows you to customize the Tk configuration for your site; for details on how you can do this, type "./configure -help" or refer to the autoconf documentation (not included here). Tk's "configure" script supports the following special switches in addition to the standard ones: --with-tcl=DIR Specifies the directory containing the Tcl binaries and Tcl's platform-dependent configuration information. By default the Tcl directory is assumed to be in the location given by (a) above. --with-x=DIR Tells configure where to find an installation of the X Window System. Not normally needed. --enable-threads If this switch is set, Tk will compile itself with multithreading support. --enable-shared If this switch is specified, Tk will compile itself as a shared library if it can figure out how to do that on this platform. This is the default on platforms where we know how to build shared libraries. --disable-shared If this switch is specified, Tk will compile itself as a static library. --disable-rpath Turns off use of the rpath link option on platforms that would otherwise use it. --enable-symbols Build with debugging symbols. By default standard debugging symbols are used. You can specify the value "mem" to include TCL_MEM_DEBUG memory debugging. --disable-symbols Build without debugging symbols --enable-64bit Enable 64bit support (where applicable) --disable-64bit Disable 64bit support (where applicable) --enable-64bit-vis Enable 64bit Sparc VIS support --disable-64bit-vis Disable 64bit Sparc VIS support --disable-xft Disable support for antialiased fonts via the Freetype/xft library. By default, this is switched on whenever the configure script can detect the required libraries. --enable-man-symlinks Use symlinks for linking the manpages that should be reachable under several names. --enable-man-compression=PROG Compress the manpages using PROG. --enable-man-suffix=STRING Add STRING to the name of each of the manual pages. If specified without giving STRING, the suffix will be "tk". Mac OS X only: --enable-framework Package Tk as a framework. --disable-corefoundation Disable use of CoreFoundation API. --enable-aqua Use Aqua windowingsystem rather than X11, requires --enable-corefoundation with Tcl and Tk. Note: by default gcc will be used if it can be located on the PATH. If you want to use cc instead of gcc, set the CC environment variable to "cc" before running configure. It is not safe to change the Makefile to use gcc after configure is run. Note: be sure to use only absolute path names (those starting with "/") in the --prefix and --exec-prefix options. (e) Type "make". This will create a library archive called "libtk.a" or "libtk.so" and an interpreter application called "wish" that allows you to type Tcl/Tk commands interactively or execute script files. It will also create a stub library archive "libtkstub.a" that developers may link against other C code to produce loadable extensions that call into Tk's public interface routines. (f) If the make fails then you'll have to personalize the Makefile for your site or possibly modify the distribution in other ways. First check the porting Web page above to see if there are hints for compiling on your system. If you need to modify Makefile, there are comments at the beginning of it that describe the things you might want to change and how to change them. (g) Type "make install" to install Tk's binaries and script files in standard places. You'll need write permission on the installation directories to do this. The installation directories are determined by the "configure" script and may be specified with the --prefix and --exec-prefix options to "configure". See the Makefile for information on what directories were chosen. You should not override these choices by modifying the Makefile, or by copying files post-install. The installed binaries have embedded within them path values relative to the install directory. If you change your mind about where Tk should be installed, start this procedure over again from step (a) so that the path embedded in the binaries agrees with the install location. (h) At this point you can play with Tk by running the installed "wish" executable, or via the "make shell" target, and typing Tcl/Tk commands at the interactive prompt. If you have trouble compiling Tk, see the URL noted above about working platforms. It contains information that people have provided about changes they had to make to compile Tk in various environments. We're also interested in hearing how to change the configuration setup so that Tk compiles on additional platforms "out of the box". Note: Do not specify either of the TCL_LIBRARY and TK_LIBRARY environment variables in a production installation, as this can cause conflicts between different versions of the libraries. Instead, the libraries should have the correct locations of their associated script directories built into them. Test suite ---------- Tk has a substantial self-test suite, consisting of a set of scripts in the subdirectory "tests". To run the test suite just type "make test" in this directory. You should then see a printout of the test files processed. If any errors occur, you'll see a much more substantial printout for each error. In order to avoid false error reports, be sure to run the tests with an empty resource database (e.g., remove your .Xdefaults file or delete any entries starting with *). Also, don't try to do anything else with your display or keyboard while the tests are running, or you may get false violations. See the README file in the "tests" directory for more information on the test suite. If the test suite generates errors, most likely they are due to non-portable tests that are interacting badly with your system configuration. We are gradually eliminating the non-portable tests, but this release includes many new tests so there will probably be some portability problems. As long as the test suite doesn't core dump, it's probably safe to conclude that any errors represent portability problems in the test suite and not fundamental flaws with Tk. There are also a number of visual tests for things such as screen layout, Postscript generation, etc. These tests all have to be run by manually enabling the "userInteraction" constraint when testing, and the results have to be verified visually. This can be done with: make test TESTFLAGS="-constraints userInteraction" Some tests will present a main window with a bunch of menus, which you can use to select various tests. tk8.5.19/unix/tkUnixFocus.c0000644003604700454610000001066512612445655014205 0ustar dgp771div/* * tkUnixFocus.c -- * * This file contains platform specific functions that manage focus for * Tk. * * Copyright (c) 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" /* *---------------------------------------------------------------------- * * TkpChangeFocus -- * * This function is invoked to move the official X focus from one window * to another. * * Results: * The return value is the serial number of the command that changed the * focus. It may be needed by the caller to filter out focus change * events that were queued before the command. If the function doesn't * actually change the focus then it returns 0. * * Side effects: * The official X focus window changes; the application's focus window * isn't changed by this function. * *---------------------------------------------------------------------- */ int TkpChangeFocus( TkWindow *winPtr, /* Window that is to receive the X focus. */ int force) /* Non-zero means claim the focus even if it * didn't originally belong to topLevelPtr's * application. */ { TkDisplay *dispPtr = winPtr->dispPtr; Tk_ErrorHandler errHandler; Window window, root, parent, *children; unsigned int numChildren, serial; TkWindow *winPtr2; int dummy; /* * Don't set the X focus to a window that's marked override-redirect. * This is a hack to avoid problems with menus under olvwm: if we move * the focus then the focus can get lost during keyboard traversal. * Fortunately, we don't really need to move the focus for menus: events * will still find their way to the focus window, and menus aren't * decorated anyway so the window manager doesn't need to hear about the * focus change in order to redecorate the menu. */ serial = 0; if (winPtr->atts.override_redirect) { return serial; } /* * Check to make sure that the focus is still in one of the windows of * this application or one of their descendants. Furthermore, grab the * server to make sure that the focus doesn't change in the middle of this * operation. */ XGrabServer(dispPtr->display); if (!force) { /* * Find the focus window, then see if it or one of its ancestors is a * window in our application (it's possible that the focus window is * in an embedded application, which may or may not be in the same * process. */ XGetInputFocus(dispPtr->display, &window, &dummy); while (1) { winPtr2 = (TkWindow *) Tk_IdToWindow(dispPtr->display, window); if ((winPtr2 != NULL) && (winPtr2->mainPtr == winPtr->mainPtr)) { break; } if ((window == PointerRoot) || (window == None)) { goto done; } XQueryTree(dispPtr->display, window, &root, &parent, &children, &numChildren); if (children != NULL) { XFree((void *) children); } if (parent == root) { goto done; } window = parent; } } /* * Tell X to change the focus. Ignore errors that occur when changing the * focus: it is still possible that the window we're focussing to could * have gotten unmapped, which will generate an error. */ errHandler = Tk_CreateErrorHandler(dispPtr->display, -1,-1,-1, NULL,NULL); if (winPtr->window == None) { Tcl_Panic("ChangeXFocus got null X window"); } XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent, CurrentTime); Tk_DeleteErrorHandler(errHandler); /* * Remember the current serial number for the X server and issue a dummy * server request. This marks the position at which we changed the focus, * so we can distinguish FocusIn and FocusOut events on either side of the * mark. */ serial = NextRequest(winPtr->display); XNoOp(winPtr->display); done: XUngrabServer(dispPtr->display); /* * After ungrabbing the server, it's important to flush the output * immediately so that the server sees the ungrab command. Otherwise we * might do something else that needs to communicate with the server (such * as invoking a subprocess that needs to do I/O to the screen); if the * ungrab command is still sitting in our output buffer, we could * deadlock. */ XFlush(dispPtr->display); return serial; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/Makefile.in0000664003604700454610000017002712656405252013622 0ustar dgp771div# # This file is a Makefile for Tk. If it has the name "Makefile.in" # then it is a template for a Makefile; to generate the actual Makefile, # run "./configure", which is a configuration script generated by the # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # Current Tk version; used in various names. TCLVERSION = @TCL_VERSION@ VERSION = @TK_VERSION@ MAJOR_VERSION = @TK_MAJOR_VERSION@ MINOR_VERSION = @TK_MINOR_VERSION@ PATCH_LEVEL = @TK_PATCH_LEVEL@ LOCALES = @LOCALES@ #---------------------------------------------------------------- # Things you can change to personalize the Makefile for your own # site (you can make these changes in either Makefile.in or # Makefile, but changes to Makefile will get lost if you re-run # the configuration script). #---------------------------------------------------------------- # Default top-level directories in which to install architecture- # specific files (exec_prefix) and machine-independent files such # as scripts (prefix). The values specified here may be overridden # at configure-time with the --exec-prefix and --prefix options # to the "configure" script. The *dir vars are standard configure # substitutions that are based off prefix and exec_prefix. prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ mandir = @mandir@ # The following definition can be set to non-null for special systems # like AFS with replication. It allows the pathnames used for installation # to be different than those used for actually reference files at # run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix # when installing files. INSTALL_ROOT = $(DESTDIR) # Directory from which applications will reference the library of Tcl # scripts (note: you can set the TK_LIBRARY environment variable at # run-time to override the compiled-in location): TK_LIBRARY = @TK_LIBRARY@ # Path to use at runtime to refer to LIB_INSTALL_DIR: LIB_RUNTIME_DIR = $(libdir) # Directory in which to install the program wish: BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir) # Directory in which to install the .a or .so binary for the Tk library: LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) DLL_INSTALL_DIR = @DLL_INSTALL_DIR@ # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY) # Directory in which to install the include file tk.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Path to the private tk header dir: PRIVATE_INCLUDE_DIR = @PRIVATE_INCLUDE_DIR@ # Directory in which to (optionally) install the private tk headers: PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(PRIVATE_INCLUDE_DIR) # Top-level directory in which to install manual entries: MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) # Directory in which to install manual entry for wish: MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 # Directory in which to install manual entries for Tk's C library # procedures: MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 # Directory in which to install manual entries for the built-in # Tcl commands implemented by Tk: MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # Path to the html documentation dir: HTML_DIR = @HTML_DIR@ # Directory in which to install html documentation: HTML_INSTALL_DIR = $(INSTALL_ROOT)$(HTML_DIR) # Directory in which to install the configuration file tkConfig.sh: CONFIG_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) # Directory in which to install the demo files: DEMO_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)/demos # The directory containing the Tcl sources and headers appropriate # for this version of Tk ("srcdir" will be replaced or has already # been replaced by the configure script): TCL_GENERIC_DIR = @TCL_SRC_DIR@/generic # The directory containing the platform specific Tcl sources and headers # appropriate for this version of Tk: TCL_PLATFORM_DIR = @TCL_SRC_DIR@/unix # The directory containing the Tcl library archive file appropriate # for this version of Tk: TCL_BIN_DIR = @TCL_BIN_DIR@ # The linker flags needed to link in the Tcl library (ex: -ltcl8.2) TCL_LIB_FLAG = @TCL_LIB_FLAG@ # Flag, 1: we're building a shared lib, 0 we're not TK_SHARED_BUILD = @TK_SHARED_BUILD@ # Subdirectory of $(libdir) containing the pkgIndex.tcl file for loadable Tk TK_PKG_DIR = @TK_PKG_DIR@ # Directory in which to install the pkgIndex.tcl file for loadable Tk PKG_INSTALL_DIR = $(LIB_INSTALL_DIR)/$(TK_PKG_DIR) # Package index file for loadable Tk PKG_INDEX = $(PKG_INSTALL_DIR)/pkgIndex.tcl # warning flags CFLAGS_WARNING = @CFLAGS_WARNING@ # The default switches for optimization or debugging CFLAGS_DEBUG = @CFLAGS_DEBUG@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ # Flags to pass to the linker LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ # A "-I" switch that can be used when compiling to make all of the # X11 include files accessible (the configure script will try to # set this value, and will cause it to be an empty string if the # include files are accessible via /usr/include). X11_INCLUDES = @XINCLUDES@ AQUA_INCLUDES = -I$(MAC_OSX_DIR) -I$(XLIB_DIR) # Linker switch(es) to use to link with the X11 library archive (the # configure script will try to set this value automatically, but you # can override it). X11_LIB_SWITCHES = $(XFT_LIBS) @XLIBSW@ # To turn off the security checks that disallow incoming sends when # the X server appears to be insecure, reverse the comments on the # following lines: SECURITY_FLAGS = #SECURITY_FLAGS = -DTK_NO_SECURITY # To disable ANSI-C procedure prototypes reverse the comment characters # on the following lines: PROTO_FLAGS = #PROTO_FLAGS = -DNO_PROTOTYPE # To enable memory debugging reverse the comment characters on the following # lines or call configure with --enable-symbols=mem # Warning: if you enable memory debugging, you must do it *everywhere*, # including all the code that calls Tcl, and you must use ckalloc and # ckfree everywhere instead of malloc and free. MEM_DEBUG_FLAGS = #MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG # If your X server is X11R4 or earlier, then you may wish to reverse # the comment characters on the following two lines. This will enable # extra code to speed up XStringToKeysym. In X11R5 and later releases # XStringToKeysym is plenty fast, so you needn't define REDO_KEYSYM_LOOKUP. KEYSYM_FLAGS = #KEYSYM_FLAGS = -DREDO_KEYSYM_LOOKUP # Tk does not used deprecated Tcl constructs so it should # compile fine with -DTCL_NO_DEPRECATED. To remove its own # set of deprecated code uncomment the second line. NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED #NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED # Some versions of make, like SGI's, use the following variable to # determine which shell to use for executing commands: SHELL = @SHELL@ # BUILD_TCLSH is the fully qualified path name of the tclsh shell # in the Tcl build directory. Test that need to be run in the # version of tclsh that we are building against should use this # path. Targets that need an installed tclsh should not depend # on this variable. BUILD_TCLSH = @BUILD_TCLSH@ # TCL_EXE is the name of a tclsh executable that is available *BEFORE* # running make for the first time. Certain build targets (make genstubs) # need it to be available on the PATH. This executable should *NOT* be # required just to do a normal build although it can be required to run # make dist. This variable is set to "" if no tclsh is available. EXE_SUFFIX = @EXEEXT@ TCL_EXE = @TCLSH_PROG@ WISH_EXE = wish${EXE_SUFFIX} TKTEST_EXE = tktest${EXE_SUFFIX} # Tk used to let the configure script choose which program to use # for installing, but there are just too many different versions of # "install" around; better to use the install-sh script that comes # with the distribution, which is slower but guaranteed to work. INSTALL_STRIP_PROGRAM = -s INSTALL_STRIP_LIBRARY = -S -x INSTALL = $(SHELL) $(UNIX_DIR)/install-sh -c INSTALL_PROGRAM = ${INSTALL} INSTALL_LIBRARY = ${INSTALL} INSTALL_DATA = ${INSTALL} -m 644 INSTALL_DATA_DIR = ${INSTALL} -d -m 755 # The symbol below provides support for dynamic loading and shared # libraries. See configure.in for a description of what it means. # The value of the symbol is normally set by the configure script. SHLIB_CFLAGS = @SHLIB_CFLAGS@ # To enable support for stubs in Tcl. STUB_LIB_FILE = @TK_STUB_LIB_FILE@ TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@ #TK_STUB_LIB_FILE = libtkstub.a # Generic stub lib name used in rules that apply to tcl and tk STUB_LIB_FILE = ${TK_STUB_LIB_FILE} TK_STUB_LIB_FLAG = @TK_STUB_LIB_FLAG@ #TK_STUB_LIB_FLAG = -ltkstub TK_LIB_FILE = @TK_LIB_FILE@ #TK_LIB_FILE = libtk.a # Generic lib name used in rules that apply to tcl and tk LIB_FILE = ${TK_LIB_FILE} TK_LIB_FLAG = @TK_LIB_FLAG@ #TK_LIB_FLAG = -ltk TCL_LIB_SPEC = @TCL_LIB_SPEC@ TCL_STUB_LIB_SPEC = @TCL_STUB_LIB_SPEC@ TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_STUB_FLAGS = @TCL_STUB_FLAGS@ # Libraries to use when linking. This definition is determined by the # configure script. LIBS = @LIBS@ $(X11_LIB_SWITCHES) @TCL_LIBS@ WISH_LIBS = $(TCL_LIB_SPEC) @LIBS@ $(X11_LIB_SWITCHES) @TCL_LIBS@ @EXTRA_WISH_LIBS@ # The symbols below provide support for dynamic loading and shared # libraries. See configure.in for a description of what the # symbols mean. The values of the symbols are normally set by the # configure script. You shouldn't normally need to modify any of # these definitions by hand. STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ TK_SHLIB_LD_EXTRAS = @TK_SHLIB_LD_EXTRAS@ # Additional search flags needed to find the various shared libraries # at run-time. The first symbol is for use when creating a binary # with cc, and the second is for use when running ld directly. CC_SEARCH_FLAGS = @CC_SEARCH_FLAGS@ LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@ # support for embedded libraries on Darwin / Mac OS X DYLIB_INSTALL_DIR = ${LIB_RUNTIME_DIR} # support for Xft: XFT_CFLAGS = @XFT_CFLAGS@ XFT_LIBS = @XFT_LIBS@ #---------------------------------------------------------------- # The information below is modified by the configure script when # Makefile is generated from Makefile.in. You shouldn't normally # modify any of this stuff by hand. #---------------------------------------------------------------- AC_FLAGS = @DEFS@ AR = @AR@ RANLIB = @RANLIB@ SRC_DIR = @srcdir@ TOP_DIR = $(SRC_DIR)/.. GENERIC_DIR = $(TOP_DIR)/generic TTK_DIR = $(GENERIC_DIR)/ttk UNIX_DIR = $(TOP_DIR)/unix BMAP_DIR = $(TOP_DIR)/bitmaps TOOL_DIR = @TCL_SRC_DIR@/tools TEST_DIR = $(TOP_DIR)/tests MAC_OSX_DIR = $(TOP_DIR)/macosx XLIB_DIR = $(TOP_DIR)/xlib #---------------------------------------------------------------- # The information below should be usable as is. The configure # script won't modify it and you shouldn't need to modify it # either. #---------------------------------------------------------------- # Flags to be passed to installManPage to control how the manpages # should be installed (symlinks, compression, package name suffix). MAN_FLAGS = @MAN_FLAGS@ CC = @CC@ CC_SWITCHES_NO_STUBS = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ -I${UNIX_DIR} -I${GENERIC_DIR} -I${BMAP_DIR} -I${TCL_GENERIC_DIR} \ -I${TCL_PLATFORM_DIR} ${@TK_WINDOWINGSYSTEM@_INCLUDES} ${AC_FLAGS} \ ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} \ ${NO_DEPRECATED_FLAGS} @EXTRA_CC_SWITCHES@ CC_SWITCHES = $(CC_SWITCHES_NO_STUBS) ${TCL_STUB_FLAGS} APP_CC_SWITCHES = $(CC_SWITCHES_NO_STUBS) @EXTRA_APP_CC_SWITCHES@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} -I${BMAP_DIR} \ -I${TCL_GENERIC_DIR} -I${TCL_PLATFORM_DIR} ${@TK_WINDOWINGSYSTEM@_INCLUDES} \ ${AC_FLAGS} ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} \ ${KEYSYM_FLAGS} @EXTRA_CC_SWITCHES@ WISH_OBJS = tkAppInit.o TKTEST_OBJS = tkTestInit.o tkTest.o tkSquare.o tkOldTest.o \ $(@TK_WINDOWINGSYSTEM@_TKTEST_OBJS) WIDG_OBJS = tkButton.o tkEntry.o tkFrame.o tkListbox.o \ tkMenu.o tkMenubutton.o tkMenuDraw.o tkMessage.o \ tkPanedWindow.o tkScale.o tkScrollbar.o CANV_OBJS = tkCanvas.o tkCanvArc.o tkCanvBmap.o tkCanvImg.o \ tkCanvLine.o tkCanvPoly.o tkCanvPs.o tkCanvText.o \ tkCanvUtil.o tkCanvWind.o tkRectOval.o tkTrig.o IMAGE_OBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPPM.o tkImgPhoto.o TEXT_OBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \ tkTextMark.o tkTextTag.o tkTextWind.o # either tkUnixFont.o (default) or tkUnixRFont.o (if --enable-xft) # FONT_OBJS = @UNIX_FONT_OBJS@ GENERIC_OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o \ tkCmds.o tkColor.o tkConfig.o tkConsole.o tkCursor.o tkError.o \ tkEvent.o tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o \ tkGrid.o tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \ tkSelect.o tkStyle.o tkUndo.o tkUtil.o tkVisual.o tkWindow.o TTK_OBJS = \ ttkBlink.o ttkButton.o ttkCache.o ttkClamTheme.o ttkClassicTheme.o \ ttkDefaultTheme.o ttkElements.o ttkEntry.o ttkFrame.o ttkImage.o \ ttkInit.o ttkLabel.o ttkLayout.o ttkManager.o ttkNotebook.o \ ttkPanedwindow.o ttkProgress.o ttkScale.o ttkScrollbar.o ttkScroll.o \ ttkSeparator.o ttkSquare.o ttkState.o \ ttkTagSet.o ttkTheme.o ttkTrace.o ttkTrack.o ttkTreeview.o \ ttkWidget.o ttkStubInit.o STUB_OBJS = tkStubInit.o tkStubLib.o STUB_LIB_OBJS = tkStubLib.o ttkStubLib.o X11_OBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixConfig.o \ tkUnixCursor.o tkUnixDraw.o tkUnixEmbed.o tkUnixEvent.o \ tkUnixFocus.o $(FONT_OBJS) tkUnixInit.o tkUnixKey.o tkUnixMenu.o \ tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o tkUnixSelect.o \ tkUnixSend.o tkUnixWm.o tkUnixXId.o AQUA_OBJS = tkMacOSXBitmap.o tkMacOSXButton.o tkMacOSXClipboard.o \ tkMacOSXColor.o tkMacOSXConfig.o tkMacOSXCursor.o tkMacOSXDebug.o \ tkMacOSXDialog.o tkMacOSXDraw.o tkMacOSXEmbed.o tkMacOSXEntry.o \ tkMacOSXEvent.o tkMacOSXFont.o tkMacOSXHLEvents.o tkMacOSXInit.o \ tkMacOSXKeyboard.o tkMacOSXKeyEvent.o tkMacOSXMenu.o \ tkMacOSXMenubutton.o tkMacOSXMenus.o tkMacOSXMouseEvent.o \ tkMacOSXNotify.o tkMacOSXRegion.o tkMacOSXScrlbr.o tkMacOSXSend.o \ tkMacOSXSubwindows.o tkMacOSXWindowEvent.o \ tkMacOSXWm.o tkMacOSXXStubs.o \ tkFileFilter.o tkMacWinMenu.o tkPointer.o tkUnix3d.o tkUnixScale.o \ xcolors.o xdraw.o xgc.o ximage.o xutil.o \ ttkMacOSXTheme.o AQUA_TKTEST_OBJS = tkMacOSXTest.o OBJS = $(GENERIC_OBJS) $(WIDG_OBJS) $(CANV_OBJS) $(IMAGE_OBJS) $(TEXT_OBJS) \ $(STUB_OBJS) $(TTK_OBJS) \ $(@TK_WINDOWINGSYSTEM@_OBJS) @PLAT_OBJS@ TK_DECLS = \ $(GENERIC_DIR)/tk.decls \ $(GENERIC_DIR)/tkInt.decls TTK_DECLS = \ $(TTK_DIR)/ttk.decls GENERIC_SRCS = \ $(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \ $(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c \ $(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkClipboard.c \ $(GENERIC_DIR)/tkCmds.c $(GENERIC_DIR)/tkColor.c \ $(GENERIC_DIR)/tkConfig.c $(GENERIC_DIR)/tkCursor.c \ $(GENERIC_DIR)/tkError.c $(GENERIC_DIR)/tkEvent.c \ $(GENERIC_DIR)/tkFocus.c $(GENERIC_DIR)/tkFont.c \ $(GENERIC_DIR)/tkGet.c $(GENERIC_DIR)/tkGC.c \ $(GENERIC_DIR)/tkGeometry.c $(GENERIC_DIR)/tkGrab.c \ $(GENERIC_DIR)/tkGrid.c $(GENERIC_DIR)/tkConsole.c \ $(GENERIC_DIR)/tkMain.c $(GENERIC_DIR)/tkOption.c \ $(GENERIC_DIR)/tkPack.c $(GENERIC_DIR)/tkPlace.c \ $(GENERIC_DIR)/tkSelect.c $(GENERIC_DIR)/tkStyle.c \ $(GENERIC_DIR)/tkUndo.c $(GENERIC_DIR)/tkUtil.c \ $(GENERIC_DIR)/tkVisual.c $(GENERIC_DIR)/tkWindow.c \ $(GENERIC_DIR)/tkButton.c $(GENERIC_DIR)/tkObj.c \ $(GENERIC_DIR)/tkEntry.c $(GENERIC_DIR)/tkFrame.c \ $(GENERIC_DIR)/tkListbox.c $(GENERIC_DIR)/tkMenu.c \ $(GENERIC_DIR)/tkMenubutton.c $(GENERIC_DIR)/tkMenuDraw.c \ $(GENERIC_DIR)/tkMessage.c $(GENERIC_DIR)/tkPanedWindow.c \ $(GENERIC_DIR)/tkScale.c $(GENERIC_DIR)/tkScrollbar.c \ $(GENERIC_DIR)/tkCanvas.c $(GENERIC_DIR)/tkCanvArc.c \ $(GENERIC_DIR)/tkCanvBmap.c $(GENERIC_DIR)/tkCanvImg.c \ $(GENERIC_DIR)/tkCanvLine.c $(GENERIC_DIR)/tkCanvPoly.c \ $(GENERIC_DIR)/tkCanvPs.c $(GENERIC_DIR)/tkCanvText.c \ $(GENERIC_DIR)/tkCanvUtil.c \ $(GENERIC_DIR)/tkCanvWind.c $(GENERIC_DIR)/tkRectOval.c \ $(GENERIC_DIR)/tkTrig.c $(GENERIC_DIR)/tkImage.c \ $(GENERIC_DIR)/tkImgBmap.c $(GENERIC_DIR)/tkImgGIF.c \ $(GENERIC_DIR)/tkImgPPM.c \ $(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkText.c \ $(GENERIC_DIR)/tkTextBTree.c $(GENERIC_DIR)/tkTextDisp.c \ $(GENERIC_DIR)/tkTextImage.c \ $(GENERIC_DIR)/tkTextIndex.c $(GENERIC_DIR)/tkTextMark.c \ $(GENERIC_DIR)/tkTextTag.c $(GENERIC_DIR)/tkTextWind.c \ $(GENERIC_DIR)/tkOldConfig.c $(GENERIC_DIR)/tkOldTest.c \ $(GENERIC_DIR)/tkSquare.c $(GENERIC_DIR)/tkTest.c \ $(GENERIC_DIR)/tkStubInit.c $(GENERIC_DIR)/tkStubLib.c TTK_SRCS = \ $(TTK_DIR)/ttkBlink.c \ $(TTK_DIR)/ttkButton.c \ $(TTK_DIR)/ttkCache.c \ $(TTK_DIR)/ttkClamTheme.c \ $(TTK_DIR)/ttkClassicTheme.c \ $(TTK_DIR)/ttkDefaultTheme.c \ $(TTK_DIR)/ttkElements.c \ $(TTK_DIR)/ttkEntry.c \ $(TTK_DIR)/ttkFrame.c \ $(TTK_DIR)/ttkImage.c \ $(TTK_DIR)/ttkInit.c \ $(TTK_DIR)/ttkLabel.c \ $(TTK_DIR)/ttkLayout.c \ $(TTK_DIR)/ttkManager.c \ $(TTK_DIR)/ttkNotebook.c \ $(TTK_DIR)/ttkPanedwindow.c \ $(TTK_DIR)/ttkProgress.c \ $(TTK_DIR)/ttkScale.c \ $(TTK_DIR)/ttkScrollbar.c \ $(TTK_DIR)/ttkScroll.c \ $(TTK_DIR)/ttkSeparator.c \ $(TTK_DIR)/ttkSquare.c \ $(TTK_DIR)/ttkState.c \ $(TTK_DIR)/ttkTagSet.c \ $(TTK_DIR)/ttkTheme.c \ $(TTK_DIR)/ttkTrace.c \ $(TTK_DIR)/ttkTrack.c \ $(TTK_DIR)/ttkTreeview.c \ $(TTK_DIR)/ttkWidget.c TTK_STUB_SRCS = \ $(TTK_DIR)/ttkStubInit.c $(TTK_DIR)/ttkStubLib.c X11_SRCS = \ $(UNIX_DIR)/tkAppInit.c $(UNIX_DIR)/tkUnix.c \ $(UNIX_DIR)/tkUnix3d.c \ $(UNIX_DIR)/tkUnixButton.c $(UNIX_DIR)/tkUnixColor.c \ $(UNIX_DIR)/tkUnixConfig.c \ $(UNIX_DIR)/tkUnixCursor.c \ $(UNIX_DIR)/tkUnixDraw.c \ $(UNIX_DIR)/tkUnixEmbed.c $(UNIX_DIR)/tkUnixEvent.c \ $(UNIX_DIR)/tkUnixFocus.c \ $(UNIX_DIR)/tkUnixRFont.c \ $(UNIX_DIR)/tkUnixFont.c $(UNIX_DIR)/tkUnixInit.c \ $(UNIX_DIR)/tkUnixKey.c \ $(UNIX_DIR)/tkUnixMenu.c $(UNIX_DIR)/tkUnixMenubu.c \ $(UNIX_DIR)/tkUnixScale.c $(UNIX_DIR)/tkUnixScrlbr.c \ $(UNIX_DIR)/tkUnixSelect.c \ $(UNIX_DIR)/tkUnixSend.c $(UNIX_DIR)/tkUnixWm.c \ $(UNIX_DIR)/tkUnixXId.c AQUA_SRCS = \ $(MAC_OSX_DIR)/tkMacOSXBitmap.c $(MAC_OSX_DIR)/tkMacOSXButton.c \ $(MAC_OSX_DIR)/tkMacOSXClipboard.c $(MAC_OSX_DIR)/tkMacOSXColor.c \ $(MAC_OSX_DIR)/tkMacOSXConfig.c $(MAC_OSX_DIR)/tkMacOSXCursor.c \ $(MAC_OSX_DIR)/tkMacOSXDebug.c $(MAC_OSX_DIR)/tkMacOSXDialog.c \ $(MAC_OSX_DIR)/tkMacOSXDraw.c $(MAC_OSX_DIR)/tkMacOSXEmbed.c \ $(MAC_OSX_DIR)/tkMacOSXEntry.c $(MAC_OSX_DIR)/tkMacOSXEvent.c \ $(MAC_OSX_DIR)/tkMacOSXFont.c $(MAC_OSX_DIR)/tkMacOSXHLEvents.c \ $(MAC_OSX_DIR)/tkMacOSXInit.c $(MAC_OSX_DIR)/tkMacOSXKeyboard.c \ $(MAC_OSX_DIR)/tkMacOSXKeyEvent.c $(MAC_OSX_DIR)/tkMacOSXMenu.c \ $(MAC_OSX_DIR)/tkMacOSXMenubutton.c $(MAC_OSX_DIR)/tkMacOSXMenus.c \ $(MAC_OSX_DIR)/tkMacOSXMouseEvent.c $(MAC_OSX_DIR)/tkMacOSXNotify.c \ $(MAC_OSX_DIR)/tkMacOSXRegion.c $(MAC_OSX_DIR)/tkMacOSXScrlbr.c \ $(MAC_OSX_DIR)/tkMacOSXSend.c $(MAC_OSX_DIR)/tkMacOSXSubwindows.c \ $(MAC_OSX_DIR)/tkMacOSXTest.c $(MAC_OSX_DIR)/tkMacOSXWindowEvent.c \ $(MAC_OSX_DIR)/tkMacOSXWm.c $(MAC_OSX_DIR)/tkMacOSXXStubs.c \ $(GENERIC_DIR)/tkFileFilter.c $(GENERIC_DIR)/tkMacWinMenu.c \ $(GENERIC_DIR)/tkPointer.c $(UNIX_DIR)/tkUnix3d.c \ $(UNIX_DIR)/tkUnixScale.c $(XLIB_DIR)/xcolors.c $(XLIB_DIR)/xdraw.c \ $(XLIB_DIR)/xgc.c $(XLIB_DIR)/ximage.c $(XLIB_DIR)/xutil.c \ $(TTK_DIR)/ttkMacOSXTheme.c SRCS = $(GENERIC_SRCS) $(@TK_WINDOWINGSYSTEM@_SRCS) @PLAT_SRCS@ AQUA_HDRS = $(MAC_OSX_DIR)/tkMacOSX.h $(GENERIC_DIR)/tkIntXlibDecls.h AQUA_XLIB_HDRS = $(XLIB_DIR)/X11/*.h $(XLIB_DIR)/xbytes.h AQUA_PRIVATE_HDRS = $(MAC_OSX_DIR)/tkMacOSXPort.h $(MAC_OSX_DIR)/tkMacOSXInt.h X11_PRIVATE_HDRS = $(UNIX_DIR)/tkUnixPort.h $(UNIX_DIR)/tkUnixInt.h $(GENERIC_DIR)/tkIntXlibDecls.h # Currently private, eventually public TTK_HDRS = $(TTK_DIR)/ttkTheme.h $(TTK_DIR)/ttkDecls.h PUBLIC_HDRS = $(GENERIC_DIR)/tk.h $(GENERIC_DIR)/tkDecls.h \ $(GENERIC_DIR)/tkPlatDecls.h $(@TK_WINDOWINGSYSTEM@_HDRS) # The private headers we want installed for install-private-headers PRIVATE_HDRS = $(GENERIC_DIR)/tkInt.h $(GENERIC_DIR)/tkIntDecls.h \ $(GENERIC_DIR)/tkIntPlatDecls.h $(GENERIC_DIR)/tkPort.h \ $(TTK_HDRS) $(@TK_WINDOWINGSYSTEM@_PRIVATE_HDRS) DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget SHELL_ENV = \ @LD_LIBRARY_PATH_VAR@="`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}"; \ export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; all: binaries libraries doc binaries: ${LIB_FILE} ${WISH_EXE} libraries: $(TOP_DIR)/doc/man.macros: $(INSTALL_DATA) @TCL_SRC_DIR@/doc/man.macros $(TOP_DIR)/doc/man.macros doc: $(TOP_DIR)/doc/man.macros # The following target is configured by autoconf to generate either # a shared library or non-shared library for Tk. ${LIB_FILE}: ${STUB_LIB_FILE} @LIB_RSRC_FILE@ ${OBJS} rm -f $@ @MAKE_LIB@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} @if test "x${LIB_FILE}" = "xlibtk${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \ (cd ${TOP_DIR}/win; ${MAKE} tk${MAJOR_VERSION}${MINOR_VERSION}.dll); \ cp "${TOP_DIR}/win/tk${MAJOR_VERSION}${MINOR_VERSION}.dll" .; \ fi rm -f $@ @MAKE_STUB_LIB@ # Make target which outputs the list of the .o contained in the Tk lib # usefull to build a single big shared library containing Tcl/Tk and other # extensions. used for the Tcl Plugin. -- dl tkLibObjs: @echo ${OBJS} # This targets actually build the objects needed for the lib in the above # case objs: ${OBJS} ${WISH_EXE}: $(TK_STUB_LIB_FILE) $(WISH_OBJS) $(TK_LIB_FILE) @APP_RSRC_FILE@ ${CC} ${CFLAGS} ${LDFLAGS} $(WISH_OBJS) @TK_BUILD_LIB_SPEC@ \ $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o ${WISH_EXE} # Resetting the LIB_RUNTIME_DIR below is required so that # the generated tktest executable gets the build directory # burned into its ld search path. This keeps tktest from # picking up an already installed version of the Tcl or # Tk shared libraries. $(TKTEST_EXE): $(TKTEST_OBJS) $(TK_LIB_FILE) $(MAKE) tktest-real LIB_RUNTIME_DIR="`pwd`:$(TCL_BIN_DIR)" tktest-real: ${CC} ${CFLAGS} ${LDFLAGS} $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ \ $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o $(TKTEST_EXE) # FIXME: This xttest rule seems to be broken in a number of ways. # It should use CC_SEARCH_FLAGS, it does not include the shared # lib location logic from tktest, and it is not clear where this # test.o object file comes from. xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE) ${CC} ${CFLAGS} ${LDFLAGS} test.o tkTest.o tkSquare.o \ @TK_BUILD_LIB_SPEC@ \ $(WISH_LIBS) $(LD_SEARCH_FLAGS) -lXt -o xttest # Note, in the target below TCL_LIBRARY needs to be set or else # "make test" won't work in the case where the compilation directory # isn't the same as the source directory. # Specifying TESTFLAGS on the command line is the standard way to pass # args to tcltest, ie: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: test-classic test-ttk test-classic: $(TKTEST_EXE) $(SHELL_ENV) ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 $(TESTFLAGS) test-ttk: $(TKTEST_EXE) $(SHELL_ENV) ./$(TKTEST_EXE) $(TEST_DIR)/ttk/all.tcl -geometry +0+0 \ $(TESTFLAGS) # Tests with different languages testlang: $(TKTEST_EXE) $(SHELL_ENV) \ for lang in $(LOCALES) ; \ do \ LANG=$(lang); export LANG; \ ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 \ $(TESTFLAGS); \ done # Useful target to launch a built tktest with the proper path,... runtest: $(TKTEST_EXE) $(SHELL_ENV) ./$(TKTEST_EXE) # This target can be used to run wish from the build directory # via `make shell` or `make shell SCRIPT=/tmp/foo.tcl` shell: ${WISH_EXE} $(SHELL_ENV) ./${WISH_EXE} $(SCRIPT) demo: $(SHELL_ENV) ./${WISH_EXE} $(TOP_DIR)/library/demos/widget # This target can be used to run wish inside either gdb or insight gdb: ${WISH_EXE} @echo "set env @LD_LIBRARY_PATH_VAR@=\"`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}\"" > gdb.run @echo "set env TCL_LIBRARY=@TCL_SRC_DIR@/library" >> gdb.run @echo "set env TK_LIBRARY=@TK_SRC_DIR@/library" >> gdb.run gdb ./${WISH_EXE} --command=gdb.run rm gdb.run VALGRINDARGS=--tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v valgrind: $(TKTEST_EXE) $(SHELL_ENV) valgrind $(VALGRINDARGS) ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 -singleproc 1 $(TESTFLAGS) valgrindshell: $(TKTEST_EXE) $(SHELL_ENV) valgrind $(VALGRINDARGS) ./$(TKTEST_EXE) $(SCRIPT) INSTALL_BASE_TARGETS = install-binaries install-libraries INSTALL_DOC_TARGETS = install-doc INSTALL_DEV_TARGETS = install-headers INSTALL_DEMO_TARGETS = install-demos INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@ INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \ $(INSTALL_DEMO_TARGETS) $(INSTALL_EXTRA_TARGETS) install: $(INSTALL_TARGETS) install-strip: $(MAKE) $(INSTALL_TARGETS) \ INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \ INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}" # Note: before running ranlib below, must cd to target directory because # some ranlibs write to current directory, and this might not always be # possible (e.g. if installing as root). install-binaries: $(TK_STUB_LIB_FILE) $(TK_LIB_FILE) ${WISH_EXE} @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \ "$(PKG_INSTALL_DIR)" "$(CONFIG_INSTALL_DIR)" ; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; @if test "x$(TK_SHARED_BUILD)" = "x1"; then \ echo "Creating package index $(PKG_INDEX)"; \ rm -f "$(PKG_INDEX)"; \ (\ echo "if {[catch {package present Tcl 8.5.0}]} return";\ relative=`echo | awk '{ORS=" "; split("$(TK_PKG_DIR)",a,"/"); for (f in a) {print ".."}}'`;\ if test "x$(DLL_INSTALL_DIR)" != "x$(BIN_INSTALL_DIR)"; then \ echo "package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}$(TK_LIB_FILE)]] Tk]";\ else \ echo "if {(\$$::tcl_platform(platform) eq \"unix\") && ([info exists ::env(DISPLAY)]";\ echo " || ([info exists ::argv] && (\"-display\" in \$$::argv)))} {";\ echo " package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}.. bin $(TK_LIB_FILE)]] Tk]";\ echo "} else {";\ echo " package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}.. bin tk${MAJOR_VERSION}${MINOR_VERSION}.dll]] Tk]";\ echo "}";\ fi \ ) > "$(PKG_INDEX)"; \ fi @echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/" @@INSTALL_LIB@ @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @if test -f "tk${MAJOR_VERSION}${MINOR_VERSION}.dll"; then \ $(INSTALL_LIBRARY) "tk${MAJOR_VERSION}${MINOR_VERSION}.dll" "$(DLL_INSTALL_DIR)";\ chmod 555 "$(DLL_INSTALL_DIR)/tk${MAJOR_VERSION}${MINOR_VERSION}.dll";\ $(INSTALL_LIBRARY) "../win/libtk${MAJOR_VERSION}${MINOR_VERSION}.a" "$(LIB_INSTALL_DIR)";\ chmod 555 "$(LIB_INSTALL_DIR)/libtk${MAJOR_VERSION}${MINOR_VERSION}.a";\ fi @echo "Installing ${WISH_EXE} as $(BIN_INSTALL_DIR)/wish$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${WISH_EXE} "$(BIN_INSTALL_DIR)/wish$(VERSION)${EXE_SUFFIX}" @echo "Installing tkConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tkConfig.sh "$(CONFIG_INSTALL_DIR)/tkConfig.sh" @if test "$(STUB_LIB_FILE)" != "" ; then \ echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ @INSTALL_STUB_LIB@ ; \ fi @EXTRA_INSTALL_BINARIES@ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" @$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig @$(INSTALL_DATA) tk.pc $(LIB_INSTALL_DIR)/pkgconfig/tk.pc install-libraries: libraries @for i in "$(SCRIPT_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)/images" \ "$(SCRIPT_INSTALL_DIR)/msgs" "$(SCRIPT_INSTALL_DIR)/ttk"; \ do \ if [ -n "$$i" -a ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; @echo "Installing Tk library files to $(SCRIPT_INSTALL_DIR)/"; @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \ $(UNIX_DIR)/tkAppInit.c; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done; @echo "Installing Ttk library files to $(SCRIPT_INSTALL_DIR)/ttk/"; @for i in $(TOP_DIR)/library/ttk/*.tcl; \ do \ if [ -f $$i ] ; then \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/ttk"; \ fi; \ done; @echo "Installing library image files to $(SCRIPT_INSTALL_DIR)/images/"; @for i in $(TOP_DIR)/library/images/*; \ do \ if [ -f $$i ] ; then \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/images"; \ fi; \ done; @echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/"; @for i in $(TOP_DIR)/library/msgs/*.msg; \ do \ if [ -f $$i ] ; then \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/msgs"; \ fi; \ done; install-demos: @for i in "$(DEMO_INSTALL_DIR)" "$(DEMO_INSTALL_DIR)/images" ; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; @echo "Installing demo files to $(DEMO_INSTALL_DIR)/"; @for i in $(TOP_DIR)/library/demos/*; \ do \ if [ -f $$i ] ; then \ sed -e '3 s|exec wish|exec wish$(VERSION)|' \ $$i > "$(DEMO_INSTALL_DIR)"/`basename $$i`; \ fi; \ done; @for i in $(DEMOPROGS); \ do \ if test $$i = "square"; then \ rm -f "$(DEMO_INSTALL_DIR)/$$i"; \ else \ chmod 755 "$(DEMO_INSTALL_DIR)/$$i"; \ fi; \ done; @echo "Installing demo image files to $(DEMO_INSTALL_DIR)/images/"; @for i in $(TOP_DIR)/library/demos/images/*; \ do \ if [ -f $$i ] ; then \ $(INSTALL_DATA) $$i "$(DEMO_INSTALL_DIR)/images"; \ fi; \ done; install-doc: @for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; @echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/"; @for i in $(TOP_DIR)/doc/*.1; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \ done @echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/"; @for i in $(TOP_DIR)/doc/*.3; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \ done @echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/"; @for i in $(TOP_DIR)/doc/*.n; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \ done install-headers: @if test "$(@TK_WINDOWINGSYSTEM@_XLIB_HDRS)" != ""; then \ XLIB_INCLUDE_INSTALL_DIR="$(INCLUDE_INSTALL_DIR)"/X11; fi; \ for i in "$(INCLUDE_INSTALL_DIR)" "$${XLIB_INCLUDE_INSTALL_DIR}"; \ do \ if [ -n "$$i" -a ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; @for i in $(PUBLIC_HDRS); \ do \ $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \ done; @list='$(@TK_WINDOWINGSYSTEM@_XLIB_HDRS)'; for i in $$list ; \ do \ $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)/X11"; \ done; # Optional target to install private headers install-private-headers: @for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/"; @for i in $(PRIVATE_HDRS); \ do \ $(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done; @if test -f tkConfig.h; then\ $(INSTALL_DATA) tkConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ fi; Makefile: $(UNIX_DIR)/Makefile.in $(SHELL) config.status #tkConfig.h: $(UNIX_DIR)/tkConfig.h.in # $(SHELL) config.status clean: rm -f *.a *.o libtk* core errs *~ \#* TAGS *.E a.out \ errors ${WISH_EXE} $(TKTEST_EXE) lib.exp Tk *.rsrc distclean: clean rm -rf Makefile config.status config.cache config.log tkConfig.sh \ $(PACKAGE).* prototype tkConfig.h *.plist Tk.framework tk.pc depend: makedepend -- $(DEPEND_SWITCHES) -- $(SRCS) # Test binaries. The rule for tkTestInit.o is complicated because # it is is compiled from tkAppInit.c. Can't use the "-o" option # because this doesn't work on some strange compilers (e.g. UnixWare). # To enable concurrent parallel make of wish and tktest, this target has to # depend on wish, this ensures that linking of wish with tkTestInit.o does not # execute concurrently with the renaming and recompiling of that same object # file in the target below. tkTestInit.o: $(UNIX_DIR)/tkAppInit.c ${WISH_EXE} @if test -f tkAppInit.o ; then \ rm -f tkAppInit.sav; \ mv tkAppInit.o tkAppInit.sav; \ fi; $(CC) -c $(APP_CC_SWITCHES) -DTK_TEST $(UNIX_DIR)/tkAppInit.c rm -f tkTestInit.o mv tkAppInit.o tkTestInit.o @if test -f tkAppInit.sav ; then \ mv tkAppInit.sav tkAppInit.o; \ fi; tkAppInit.o: $(UNIX_DIR)/tkAppInit.c $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tkAppInit.c tk3d.o: $(GENERIC_DIR)/tk3d.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tk3d.c tkArgv.o: $(GENERIC_DIR)/tkArgv.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkArgv.c tkAtom.o: $(GENERIC_DIR)/tkAtom.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkAtom.c tkBind.o: $(GENERIC_DIR)/tkBind.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBind.c tkBitmap.o: $(GENERIC_DIR)/tkBitmap.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBitmap.c tkClipboard.o: $(GENERIC_DIR)/tkClipboard.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkClipboard.c tkCmds.o: $(GENERIC_DIR)/tkCmds.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCmds.c tkColor.o: $(GENERIC_DIR)/tkColor.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkColor.c tkConfig.o: $(GENERIC_DIR)/tkConfig.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkConfig.c tkConsole.o: $(GENERIC_DIR)/tkConsole.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkConsole.c tkCursor.o: $(GENERIC_DIR)/tkCursor.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCursor.c tkError.o: $(GENERIC_DIR)/tkError.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkError.c tkEvent.o: $(GENERIC_DIR)/tkEvent.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkEvent.c tkFocus.o: $(GENERIC_DIR)/tkFocus.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFocus.c tkFont.o: $(GENERIC_DIR)/tkFont.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFont.c tkGet.o: $(GENERIC_DIR)/tkGet.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGet.c tkGC.o: $(GENERIC_DIR)/tkGC.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGC.c tkGeometry.o: $(GENERIC_DIR)/tkGeometry.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGeometry.c tkGrab.o: $(GENERIC_DIR)/tkGrab.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGrab.c tkGrid.o: $(GENERIC_DIR)/tkGrid.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGrid.c tkMain.o: $(GENERIC_DIR)/tkMain.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMain.c tkObj.o: $(GENERIC_DIR)/tkObj.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkObj.c tkOldConfig.o: $(GENERIC_DIR)/tkOldConfig.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOldConfig.c tkOption.o: $(GENERIC_DIR)/tkOption.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOption.c tkPack.o: $(GENERIC_DIR)/tkPack.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPack.c tkPlace.o: $(GENERIC_DIR)/tkPlace.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPlace.c tkSelect.o: $(GENERIC_DIR)/tkSelect.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkSelect.c tkStyle.o: $(GENERIC_DIR)/tkStyle.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStyle.c tkUtil.o: $(GENERIC_DIR)/tkUtil.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkUtil.c tkVisual.o: $(GENERIC_DIR)/tkVisual.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkVisual.c tkWindow.o: $(GENERIC_DIR)/tkWindow.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkWindow.c tkButton.o: $(GENERIC_DIR)/tkButton.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkButton.c tkEntry.o: $(GENERIC_DIR)/tkEntry.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkEntry.c tkFrame.o: $(GENERIC_DIR)/tkFrame.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFrame.c tkListbox.o: $(GENERIC_DIR)/tkListbox.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkListbox.c tkMenu.o: $(GENERIC_DIR)/tkMenu.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenu.c tkMenubutton.o: $(GENERIC_DIR)/tkMenubutton.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenubutton.c tkMenuDraw.o: $(GENERIC_DIR)/tkMenuDraw.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenuDraw.c tkMessage.o: $(GENERIC_DIR)/tkMessage.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMessage.c tkPanedWindow.o: $(GENERIC_DIR)/tkPanedWindow.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPanedWindow.c tkScale.o: $(GENERIC_DIR)/tkScale.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScale.c tkScrollbar.o: $(GENERIC_DIR)/tkScrollbar.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScrollbar.c tkSquare.o: $(GENERIC_DIR)/tkSquare.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tkSquare.c tkCanvas.o: $(GENERIC_DIR)/tkCanvas.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvas.c tkCanvArc.o: $(GENERIC_DIR)/tkCanvArc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvArc.c tkCanvBmap.o: $(GENERIC_DIR)/tkCanvBmap.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvBmap.c tkCanvImg.o: $(GENERIC_DIR)/tkCanvImg.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvImg.c tkCanvLine.o: $(GENERIC_DIR)/tkCanvLine.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvLine.c tkCanvPoly.o: $(GENERIC_DIR)/tkCanvPoly.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvPoly.c tkCanvPs.o: $(GENERIC_DIR)/tkCanvPs.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvPs.c tkCanvText.o: $(GENERIC_DIR)/tkCanvText.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvText.c tkCanvUtil.o: $(GENERIC_DIR)/tkCanvUtil.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvUtil.c tkCanvWind.o: $(GENERIC_DIR)/tkCanvWind.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvWind.c tkRectOval.o: $(GENERIC_DIR)/tkRectOval.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkRectOval.c tkTrig.o: $(GENERIC_DIR)/tkTrig.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTrig.c tkImage.o: $(GENERIC_DIR)/tkImage.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImage.c tkImgBmap.o: $(GENERIC_DIR)/tkImgBmap.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgBmap.c tkImgGIF.o: $(GENERIC_DIR)/tkImgGIF.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgGIF.c tkImgPPM.o: $(GENERIC_DIR)/tkImgPPM.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPPM.c tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhoto.c tkOldTest.o: $(GENERIC_DIR)/tkOldTest.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tkOldTest.c tkTest.o: $(GENERIC_DIR)/tkTest.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tkTest.c tkText.o: $(GENERIC_DIR)/tkText.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkText.c tkTextBTree.o: $(GENERIC_DIR)/tkTextBTree.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextBTree.c tkTextDisp.o: $(GENERIC_DIR)/tkTextDisp.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextDisp.c tkTextImage.o: $(GENERIC_DIR)/tkTextImage.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextImage.c tkTextIndex.o: $(GENERIC_DIR)/tkTextIndex.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextIndex.c tkTextMark.o: $(GENERIC_DIR)/tkTextMark.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextMark.c tkTextTag.o: $(GENERIC_DIR)/tkTextTag.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextTag.c tkTextWind.o: $(GENERIC_DIR)/tkTextWind.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextWind.c tkStubInit.o: $(GENERIC_DIR)/tkStubInit.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubInit.c # Stub library binaries, these must be compiled for use in a shared library # even though they will be placed in a static archive tkStubLib.o: $(GENERIC_DIR)/tkStubLib.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubLib.c tkUndo.o: $(GENERIC_DIR)/tkUndo.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkUndo.c tkUnix.o: $(UNIX_DIR)/tkUnix.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix.c tkUnix3d.o: $(UNIX_DIR)/tkUnix3d.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix3d.c tkUnixButton.o: $(UNIX_DIR)/tkUnixButton.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixButton.c tkUnixColor.o: $(UNIX_DIR)/tkUnixColor.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixColor.c tkUnixConfig.o: $(UNIX_DIR)/tkUnixConfig.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixConfig.c tkUnixCursor.o: $(UNIX_DIR)/tkUnixCursor.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixCursor.c tkUnixDraw.o: $(UNIX_DIR)/tkUnixDraw.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDraw.c tkUnixEmbed.o: $(UNIX_DIR)/tkUnixEmbed.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEmbed.c tkUnixEvent.o: $(UNIX_DIR)/tkUnixEvent.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEvent.c tkUnixFocus.o: $(UNIX_DIR)/tkUnixFocus.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFocus.c tkUnixFont.o: $(UNIX_DIR)/tkUnixFont.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFont.c # NB: tkUnixRFont.o uses nondefault CFLAGS tkUnixRFont.o: $(UNIX_DIR)/tkUnixRFont.c $(CC) -c $(CC_SWITCHES) $(XFT_CFLAGS) $(UNIX_DIR)/tkUnixRFont.c tkUnixInit.o: $(UNIX_DIR)/tkUnixInit.c tkConfig.sh $(CC) -c $(CC_SWITCHES) -DTK_LIBRARY=\"${TK_LIBRARY}\" \ $(UNIX_DIR)/tkUnixInit.c tkUnixKey.o: $(UNIX_DIR)/tkUnixKey.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixKey.c tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenu.c tkUnixMenubu.o: $(UNIX_DIR)/tkUnixMenubu.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenubu.c tkUnixScale.o: $(UNIX_DIR)/tkUnixScale.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScale.c tkUnixScrlbr.o: $(UNIX_DIR)/tkUnixScrlbr.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScrlbr.c tkUnixSelect.o: $(UNIX_DIR)/tkUnixSelect.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixSelect.c tkUnixSend.o: $(UNIX_DIR)/tkUnixSend.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixSend.c tkUnixWm.o: $(UNIX_DIR)/tkUnixWm.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixWm.c tkUnixXId.o: $(UNIX_DIR)/tkUnixXId.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixXId.c tkMacOSXBitmap.o: $(MAC_OSX_DIR)/tkMacOSXBitmap.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXBitmap.c tkMacOSXButton.o: $(MAC_OSX_DIR)/tkMacOSXButton.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXButton.c tkMacOSXClipboard.o: $(MAC_OSX_DIR)/tkMacOSXClipboard.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXClipboard.c tkMacOSXColor.o: $(MAC_OSX_DIR)/tkMacOSXColor.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXColor.c tkMacOSXConfig.o: $(MAC_OSX_DIR)/tkMacOSXConfig.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXConfig.c tkMacOSXCursor.o: $(MAC_OSX_DIR)/tkMacOSXCursor.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXCursor.c tkMacOSXDebug.o: $(MAC_OSX_DIR)/tkMacOSXDebug.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXDebug.c tkMacOSXDialog.o: $(MAC_OSX_DIR)/tkMacOSXDialog.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXDialog.c tkMacOSXDraw.o: $(MAC_OSX_DIR)/tkMacOSXDraw.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXDraw.c tkMacOSXEmbed.o: $(MAC_OSX_DIR)/tkMacOSXEmbed.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXEmbed.c tkMacOSXEntry.o: $(MAC_OSX_DIR)/tkMacOSXEntry.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXEntry.c tkMacOSXEvent.o: $(MAC_OSX_DIR)/tkMacOSXEvent.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXEvent.c tkMacOSXFont.o: $(MAC_OSX_DIR)/tkMacOSXFont.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXFont.c tkMacOSXHLEvents.o: $(MAC_OSX_DIR)/tkMacOSXHLEvents.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXHLEvents.c tkMacOSXInit.o: $(MAC_OSX_DIR)/tkMacOSXInit.c tkConfig.sh $(CC) -c $(CC_SWITCHES) -DTK_LIBRARY=\"${TK_LIBRARY}\" \ $(MAC_OSX_DIR)/tkMacOSXInit.c tkMacOSXKeyboard.o: $(MAC_OSX_DIR)/tkMacOSXKeyboard.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXKeyboard.c tkMacOSXKeyEvent.o: $(MAC_OSX_DIR)/tkMacOSXKeyEvent.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXKeyEvent.c tkMacOSXMenu.o: $(MAC_OSX_DIR)/tkMacOSXMenu.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXMenu.c tkMacOSXMenubutton.o: $(MAC_OSX_DIR)/tkMacOSXMenubutton.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXMenubutton.c tkMacOSXMenus.o: $(MAC_OSX_DIR)/tkMacOSXMenus.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXMenus.c tkMacOSXMouseEvent.o: $(MAC_OSX_DIR)/tkMacOSXMouseEvent.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXMouseEvent.c tkMacOSXNotify.o: $(MAC_OSX_DIR)/tkMacOSXNotify.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXNotify.c tkMacOSXRegion.o: $(MAC_OSX_DIR)/tkMacOSXRegion.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXRegion.c tkMacOSXScale.o: $(MAC_OSX_DIR)/tkMacOSXScale.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXScale.c tkMacOSXScrlbr.o: $(MAC_OSX_DIR)/tkMacOSXScrlbr.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXScrlbr.c tkMacOSXSend.o: $(MAC_OSX_DIR)/tkMacOSXSend.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXSend.c tkMacOSXSubwindows.o: $(MAC_OSX_DIR)/tkMacOSXSubwindows.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXSubwindows.c tkMacOSXTest.o: $(MAC_OSX_DIR)/tkMacOSXTest.c $(CC) -c $(APP_CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXTest.c tkMacOSXWindowEvent.o: $(MAC_OSX_DIR)/tkMacOSXWindowEvent.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXWindowEvent.c tkMacOSXWm.o: $(MAC_OSX_DIR)/tkMacOSXWm.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXWm.c tkMacOSXXStubs.o: $(MAC_OSX_DIR)/tkMacOSXXStubs.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tkMacOSXXStubs.c tkFileFilter.o: $(GENERIC_DIR)/tkFileFilter.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFileFilter.c tkMacWinMenu.o: $(GENERIC_DIR)/tkMacWinMenu.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMacWinMenu.c tkPointer.o: $(GENERIC_DIR)/tkPointer.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPointer.c xcolors.o: $(XLIB_DIR)/xcolors.c $(CC) -c $(CC_SWITCHES) $(XLIB_DIR)/xcolors.c xdraw.o: $(XLIB_DIR)/xdraw.c $(CC) -c $(CC_SWITCHES) $(XLIB_DIR)/xdraw.c xgc.o: $(XLIB_DIR)/xgc.c $(CC) -c $(CC_SWITCHES) $(XLIB_DIR)/xgc.c ximage.o: $(XLIB_DIR)/ximage.c $(CC) -c $(CC_SWITCHES) $(XLIB_DIR)/ximage.c xutil.o: $(XLIB_DIR)/xutil.c $(CC) -c $(CC_SWITCHES) $(XLIB_DIR)/xutil.c ttkBlink.o: $(TTK_DIR)/ttkBlink.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkBlink.c ttkButton.o: $(TTK_DIR)/ttkButton.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkButton.c ttkCache.o: $(TTK_DIR)/ttkCache.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkCache.c ttkClamTheme.o: $(TTK_DIR)/ttkClamTheme.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkClamTheme.c ttkClassicTheme.o: $(TTK_DIR)/ttkClassicTheme.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkClassicTheme.c ttkDefaultTheme.o: $(TTK_DIR)/ttkDefaultTheme.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkDefaultTheme.c ttkElements.o: $(TTK_DIR)/ttkElements.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkElements.c ttkEntry.o: $(TTK_DIR)/ttkEntry.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkEntry.c ttkFrame.o: $(TTK_DIR)/ttkFrame.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkFrame.c ttkImage.o: $(TTK_DIR)/ttkImage.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkImage.c ttkInit.o: $(TTK_DIR)/ttkInit.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkInit.c ttkLabel.o: $(TTK_DIR)/ttkLabel.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkLabel.c ttkLayout.o: $(TTK_DIR)/ttkLayout.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkLayout.c ttkManager.o: $(TTK_DIR)/ttkManager.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkManager.c ttkNotebook.o: $(TTK_DIR)/ttkNotebook.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkNotebook.c ttkPanedwindow.o: $(TTK_DIR)/ttkPanedwindow.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkPanedwindow.c ttkProgress.o: $(TTK_DIR)/ttkProgress.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkProgress.c ttkScale.o: $(TTK_DIR)/ttkScale.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkScale.c ttkScroll.o: $(TTK_DIR)/ttkScroll.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkScroll.c ttkScrollbar.o: $(TTK_DIR)/ttkScrollbar.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkScrollbar.c ttkSeparator.o: $(TTK_DIR)/ttkSeparator.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkSeparator.c ttkSquare.o: $(TTK_DIR)/ttkSquare.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkSquare.c ttkState.o: $(TTK_DIR)/ttkState.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkState.c ttkStubInit.o: $(TTK_DIR)/ttkStubInit.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkStubInit.c ttkStubLib.o: $(TTK_DIR)/ttkStubLib.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkStubLib.c ttkTagSet.o: $(TTK_DIR)/ttkTagSet.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTagSet.c ttkTheme.o: $(TTK_DIR)/ttkTheme.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTheme.c ttkTrace.o: $(TTK_DIR)/ttkTrace.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTrace.c ttkTrack.o: $(TTK_DIR)/ttkTrack.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTrack.c ttkTreeview.o: $(TTK_DIR)/ttkTreeview.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTreeview.c ttkWidget.o: $(TTK_DIR)/ttkWidget.c $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkWidget.c ttkMacOSXTheme.o: $(MAC_OSX_DIR)/ttkMacOSXTheme.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/ttkMacOSXTheme.c .c.o: $(CC) -c $(CC_SWITCHES) $< # # Target to regenerate header files and stub files from the *.decls tables. # $(GENERIC_DIR)/tkStubInit.c: $(GENERIC_DIR)/tk.decls \ $(GENERIC_DIR)/tkInt.decls @echo "Warning: tkStubInit.c may be out of date." @echo "Developers may want to run \"make genstubs\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" $(TTK_DIR)/ttkStubInit.c: $(TTK_DIR)/ttk.decls @echo "Warning: ttkStubInit.c may be out of date." @echo "Developers may want to run \"make genstubs\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" genstubs: $(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \ $(GENERIC_DIR)/tk.decls $(GENERIC_DIR)/tkInt.decls $(TCL_EXE) $(TTK_DIR)/ttkGenStubs.tcl $(TTK_DIR) $(TTK_DIR)/ttk.decls # # Target to check that all exported functions have an entry in the stubs # tables. # checkstubs: $(TK_LIB_FILE) -@for i in `nm -p $(TK_LIB_FILE) \ | awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \ | sort -n`; do \ match=0; \ for j in $(TK_DECLS) $(TTK_DECLS); do \ if [ `grep -c "$$i *(" $$j` -gt 0 ]; then \ match=1; \ fi; \ done; \ if [ $$match -eq 0 ]; then echo $$i; fi \ done # # Target to check for proper usage of UCHAR macro. # checkuchar: -egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR # # Target to make sure that only symbols with "Tk", "tk", "Ttk", "ttk" or "X" # prefixes are exported. # checkexports: $(TK_LIB_FILE) -@nm -p $(TK_LIB_FILE) \ | awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \ | sort -n | grep -E -v '^([Tt]t?k|_?X)' || true # # Target to create a Tk RPM for Linux. Requires that you be on a Linux # system. # rpm: all rm -f THIS.TCL.SPEC echo "%define _builddir `pwd`" > THIS.TK.SPEC echo "%define _rpmdir `pwd`/RPMS" >> THIS.TK.SPEC cat tk.spec >> THIS.TK.SPEC mkdir -p RPMS/i386 rpmbuild -bb THIS.TK.SPEC mv RPMS/i386/*.rpm . rm -rf RPMS THIS.TK.SPEC # # Target to create a proper Tk distribution from information in the # master source directory. DISTDIR must be defined to indicate where # to put the distribution. DISTDIR must be an absolute path name. # DISTROOT = /tmp/dist DISTNAME = tk${VERSION}${PATCH_LEVEL} ZIPNAME = tk${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) TCLDIR = @TCL_SRC_DIR@ $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in $(UNIX_DIR)/tcl.m4 \ $(UNIX_DIR)/aclocal.m4 cd $(UNIX_DIR); autoconf $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure cd $(MAC_OSX_DIR); autoconf $(UNIX_DIR)/tkConfig.h.in: $(MAC_OSX_DIR)/configure cd $(MAC_OSX_DIR); autoheader; touch $@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tkConfig.h.in $(UNIX_DIR)/tk.pc.in $(MAC_OSX_DIR)/configure genstubs rm -rf $(DISTDIR) mkdir -p $(DISTDIR)/unix cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix cp $(TOP_DIR)/license.terms $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix chmod 664 $(DISTDIR)/unix/Makefile.in cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in $(UNIX_DIR)/tk.spec \ $(UNIX_DIR)/aclocal.m4 $(UNIX_DIR)/tcl.m4 \ $(UNIX_DIR)/tkConfig.sh.in $(TCLDIR)/unix/install-sh \ $(UNIX_DIR)/README $(UNIX_DIR)/installManPage \ $(UNIX_DIR)/tkConfig.h.in $(UNIX_DIR)/tk.pc.in $(DISTDIR)/unix chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in mkdir $(DISTDIR)/bitmaps @(cd $(TOP_DIR); for i in bitmaps/* ; do \ if [ -f $$i ] ; then \ sed -e 's/static char/static unsigned char/' \ $$i > $(DISTDIR)/$$i; \ fi; \ done;) mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[ch] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog \ $(TOP_DIR)/ChangeLog.2??? $(TOP_DIR)/README \ $(TOP_DIR)/license.terms $(DISTDIR) rm -f $(DISTDIR)/generic/blt*.[ch] mkdir $(DISTDIR)/generic/ttk cp -p $(TTK_DIR)/*.[ch] $(TTK_DIR)/ttk.decls \ $(TTK_DIR)/ttkGenStubs.tcl $(DISTDIR)/generic/ttk mkdir $(DISTDIR)/win cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win cp $(TOP_DIR)/win/configure.in \ $(TOP_DIR)/win/configure \ $(TOP_DIR)/win/tkConfig.sh.in \ $(TOP_DIR)/win/aclocal.m4 $(TOP_DIR)/win/tcl.m4 \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.bat $(DISTDIR)/win cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win cp -p $(TOP_DIR)/win/README $(DISTDIR)/win cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win mkdir $(DISTDIR)/win/rc cp -p $(TOP_DIR)/win/wish.exe.manifest.in $(DISTDIR)/win/ cp -p $(TOP_DIR)/win/rc/*.{rc,cur,ico,bmp} $(DISTDIR)/win/rc mkdir $(DISTDIR)/macosx cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.icns $(MAC_OSX_DIR)/*.tiff \ $(MAC_OSX_DIR)/*.[ch] $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ $(MAC_OSX_DIR)/*.sdef $(MAC_OSX_DIR)/configure \ $(DISTDIR)/macosx cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx mkdir $(DISTDIR)/macosx/Wish.xcode cp -p $(MAC_OSX_DIR)/Wish.xcode/project.pbxproj \ $(MAC_OSX_DIR)/Wish.xcode/default.pbxuser \ $(DISTDIR)/macosx/Wish.xcode mkdir $(DISTDIR)/macosx/Wish.xcodeproj cp -p $(MAC_OSX_DIR)/Wish.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Wish.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Wish.xcodeproj mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(TCLDIR)/compat/unistd.h \ $(TCLDIR)/compat/stdlib.h $(TCLDIR)/compat/limits.h \ $(DISTDIR)/compat mkdir $(DISTDIR)/xlib cp -p $(XLIB_DIR)/*.[ch] $(DISTDIR)/xlib cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib mkdir $(DISTDIR)/xlib/X11 cp -p $(XLIB_DIR)/X11/*.h $(DISTDIR)/xlib/X11 cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib/X11 mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex \ $(DISTDIR)/library mkdir $(DISTDIR)/library/ttk cp -p $(TOP_DIR)/library/ttk/*.tcl $(DISTDIR)/library/ttk mkdir $(DISTDIR)/library/images @(cd $(TOP_DIR); for i in library/images/* ; do \ if [ -f $$i ] ; then \ cp $$i $(DISTDIR)/$$i; \ fi; \ done;) mkdir $(DISTDIR)/library/msgs @(cd $(TOP_DIR); for i in library/msgs/*.msg ; do \ if [ -f $$i ] ; then \ cp $$i $(DISTDIR)/$$i; \ fi; \ done;) mkdir $(DISTDIR)/library/demos cp -pr $(TOP_DIR)/library/demos/*.tcl \ $(TOP_DIR)/library/demos/*.msg \ $(TOP_DIR)/library/demos/tclIndex \ $(TOP_DIR)/library/demos/browse \ $(TOP_DIR)/library/demos/hello $(TOP_DIR)/library/demos/ixset \ $(TOP_DIR)/library/demos/rmt $(TOP_DIR)/library/demos/rolodex \ $(TOP_DIR)/library/demos/square \ $(TOP_DIR)/library/demos/tcolor \ $(TOP_DIR)/library/demos/timer \ $(TOP_DIR)/library/demos/widget \ $(TOP_DIR)/library/demos/README \ $(TOP_DIR)/license.terms $(DISTDIR)/library/demos mkdir $(DISTDIR)/library/demos/images @(cd $(TOP_DIR); for i in library/demos/images/* ; do \ if [ -f $$i ] ; then \ cp $$i $(DISTDIR)/$$i; \ fi; \ done;) mkdir $(DISTDIR)/doc cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TCLDIR)/doc/man.macros $(DISTDIR)/doc mkdir $(DISTDIR)/tests cp -p $(TOP_DIR)/license.terms $(TEST_DIR)/*.{test,tcl} \ $(TEST_DIR)/README $(TEST_DIR)/*.{gif,ppm,xbm} \ $(TEST_DIR)/option.file* $(DISTDIR)/tests mkdir $(DISTDIR)/tests/ttk cp -p $(TEST_DIR)/ttk/*.{test,tcl} $(DISTDIR)/tests/ttk alldist: dist rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \ gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME) # # This target creates the HTML folder for Tcl & Tk and places it # in DISTDIR/html. It uses the tcltk-man2html.tcl tool from # the Tcl group's tool workspace. It depends on the Tcl & Tk being # in directories called tcl8.3 & tk8.3 up two directories from the # TOOL_DIR. # html: $(BUILD_HTML) @EXTRA_BUILD_HTML@ html-tcl: $(BUILD_HTML) --tcl @EXTRA_BUILD_HTML@ html-tk: $(BUILD_HTML) --tk @EXTRA_BUILD_HTML@ BUILD_HTML = \ @if test -f "$(BUILD_TCLSH)"; then \ $(SHELL_ENV) TCLSH="$(BUILD_TCLSH)"; else \ TCLSH="$(TCL_EXE)"; fi ;\ "$${TCLSH}" $(TOOL_DIR)/tcltk-man2html.tcl --htmldir="$(HTML_INSTALL_DIR)" \ --srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS) # # Targets to build Solaris package of the distribution for the current # architecture. To build stream packages for both sun4 and i86pc # architectures: # # On the sun4 machine, execute the following: # make distclean; ./configure # make DISTDIR= package # # Once the build is complete, execute the following on the i86pc # machine: # make DISTDIR= package-quick # # is the absolute path to a directory where the build should # take place. These steps will generate the $(PACKAGE).sun4 and # $(PACKAGE).i86pc stream packages. It is important that the packages be # built in this fashion in order to ensure that the architecture # independent files are exactly the same, including timestamps, in # both packages. # PACKAGE=SCRPtk package: dist package-config package-common package-binaries package-generate package-quick: package-config package-binaries package-generate # # Configure for the current architecture in the dist directory. # package-config: mkdir -p $(DISTDIR)/unix/`arch` cd $(DISTDIR)/unix/`arch`; \ ../configure --prefix=/opt/SUNWtcl/$(TCLVERSION) \ --exec_prefix=/opt/SUNWtcl/$(TCLVERSION)/`arch` \ --with-tcl=$(DISTDIR)/../tcl$(TCLVERSION)/unix/`arch` \ --enable-shared mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION) mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch` # # Build and install the architecture independent files in the dist directory. # package-common: cd $(DISTDIR)/unix/`arch`;\ $(MAKE); \ $(MAKE) install-libraries install-doc \ prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION) \ exec_prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch` mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin sed -e "s/TCLVERSION/$(TCLVERSION)/g" \ -e "s/TKVERSION/$(VERSION)/g" < $(UNIX_DIR)/wish.sh \ > $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin/wish$(VERSION) chmod 755 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin/wish$(VERSION) # # Build and install the architecture specific files in the dist directory. # package-binaries: cd $(DISTDIR)/unix/`arch`; \ $(MAKE); \ $(MAKE) install-binaries prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION) \ exec_prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch` # # Generate a package from the installed files in the dist directory for the # current architecture. # package-generate: pkgproto $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin=bin \ $(DISTDIR)/SUNWtcl/$(TCLVERSION)/include=include \ $(DISTDIR)/SUNWtcl/$(TCLVERSION)/lib=lib \ $(DISTDIR)/SUNWtcl/$(TCLVERSION)/man=man \ $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`=`arch` \ | $(TCL_EXE) $(TCLDIR)/unix/mkProto.tcl $(TCLVERSION) \ $(UNIX_DIR) > prototype pkgmk -o -d . -f prototype -a `arch` pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE) rm -rf $(PACKAGE) # # The list of all the targets that do not correspond to real files. This stops # 'make' from getting confused when someone makes an error in a rule. # .PHONY: all binaries libraries objs doc html html-tcl html-tk test runtest .PHONY: install install-strip install-binaries install-libraries .PHONY: install-headers install-private-headers install-doc .PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar .PHONY: shell gdb valgrind valgrindshell dist alldist rpm .PHONY: tkLibObjs tktest-real test-classic test-ttk testlang .PHONY: demo install-demos # DO NOT DELETE THIS LINE -- make depend depends on it. tk8.5.19/unix/tkUnixPort.h0000644003604700454610000001116212612445655014050 0ustar dgp771div/* * tkUnixPort.h -- * * This file is included by all of the Tk C files. It contains * information that may be configuration-dependent, such as * #includes for system include files and a few other things. * * Copyright (c) 1991-1993 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _UNIXPORT #define _UNIXPORT #define __UNIX__ 1 /* * Macro to use instead of "void" for arguments that must have * type "void *" in ANSI C; maps them to type "char *" in * non-ANSI systems. This macro may be used in some of the include * files below, which is why it is defined here. */ #ifndef VOID # ifdef __STDC__ # define VOID void # else # define VOID char # endif #endif #include #include #include #ifndef NO_LIMITS_H # include #else # include "../compat/limits.h" #endif #include #include #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else # include #endif #include #include #include #ifdef HAVE_SYS_SELECT_H # include #endif #include #ifndef _TCL # include #endif #if TIME_WITH_SYS_TIME # include # include #else # if HAVE_SYS_TIME_H # include # else # include # endif #endif #if HAVE_INTTYPES_H # include #endif #ifndef NO_UNISTD_H # include #else # include "../compat/unistd.h" #endif #include #include #include #include #include #include #include /* * The following macro defines the type of the mask arguments to * select: */ #ifndef NO_FD_SET # define SELECT_MASK fd_set #else # ifndef _AIX typedef long fd_mask; # endif # if defined(_IBMR2) # define SELECT_MASK void # else # define SELECT_MASK int # endif #endif /* * The following macro defines the number of fd_masks in an fd_set: */ #ifndef FD_SETSIZE # ifdef OPEN_MAX # define FD_SETSIZE OPEN_MAX # else # define FD_SETSIZE 256 # endif #endif #if !defined(howmany) # define howmany(x, y) (((x)+((y)-1))/(y)) #endif #ifndef NFDBITS # define NFDBITS NBBY*sizeof(fd_mask) #endif #define MASK_SIZE howmany(FD_SETSIZE, NFDBITS) /* * Define "NBBY" (number of bits per byte) if it's not already defined. */ #ifndef NBBY # define NBBY 8 #endif #ifdef __CYGWIN__ # include "tkIntXlibDecls.h" # define UINT unsigned int # define HWND void * # define HDC void * # define HINSTANCE void * # define COLORREF void * # define HMENU void * # define TkWinDCState void # define HPALETTE void * # define WNDPROC void * # define WPARAM void * # define LPARAM void * # define LRESULT void * #else /* !__CYGWIN__ */ /* * The TkPutImage macro strips off the color table information, which isn't * needed for X. */ # define TkPutImage(colors, ncolors, display, pixels, gc, image, srcx, srcy, destx, desty, width, height) \ XPutImage(display, pixels, gc, image, srcx, srcy, destx, \ desty, width, height); #endif /* !__CYGWIN__ */ /* * Supply macros for seek offsets, if they're not already provided by * an include file. */ #ifndef SEEK_SET # define SEEK_SET 0 #endif #ifndef SEEK_CUR # define SEEK_CUR 1 #endif #ifndef SEEK_END # define SEEK_END 2 #endif /* * Declarations for various library procedures that may not be declared * in any other header file. */ /* * These functions do nothing under Unix, so we just eliminate calls to them. */ #define TkpButtonSetDefaults() {} #define TkpDestroyButton(butPtr) {} #define TkSelUpdateClipboard(a,b) {} #ifndef __CYGWIN__ #define TkSetPixmapColormap(p,c) {} #endif /* * These calls implement native bitmaps which are not supported under * UNIX. The macros eliminate the calls. */ #define TkpDefineNativeBitmaps() #define TkpCreateNativeBitmap(display, source) None #define TkpGetNativeAppBitmap(display, name, w, h) None /* * This macro stores a representation of the window handle in a string. * This should perhaps use the real size of an XID. */ #ifndef __CYGWIN__ #define TkpPrintWindowId(buf,w) \ sprintf((buf), "%#08lx", (unsigned long) (w)) #endif /* * The following declaration is used to get access to a private Tcl interface * that is needed for portability reasons. * * Disabled for now to determined whether we really still need this. #ifndef _TCLINT #include #endif */ #endif /* _UNIXPORT */ tk8.5.19/unix/tkUnixInt.h0000644003604700454610000000124212612445655013654 0ustar dgp771div/* * tkUnixInt.h -- * * This file contains declarations that are shared among the * UNIX-specific parts of Tk but aren't used by the rest of Tk. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TKUNIXINT #define _TKUNIXINT #ifndef _TKINT #include "tkInt.h" #endif /* * Prototypes for procedures that are referenced in files other than the ones * they're defined in. */ #include "tkIntPlatDecls.h" #endif /* _TKUNIXINT */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixMenu.c0000644003604700454610000014257312612445655014036 0ustar dgp771div/* * tkUnixMenu.c -- * * This module implements the UNIX platform-specific features of menus. * * Copyright (c) 1996-1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "default.h" #include "tkUnixInt.h" #include "tkMenu.h" /* * Constants used for menu drawing. */ #define MENU_MARGIN_WIDTH 2 #define MENU_DIVIDER_HEIGHT 2 /* * Platform specific flags for Unix. */ #define ENTRY_HELP_MENU ENTRY_PLATFORM_FLAG1 /* * Shared with button widget. */ MODULE_SCOPE void TkpDrawCheckIndicator(Tk_Window tkwin, Display *display, Drawable d, int x, int y, Tk_3DBorder bgBorder, XColor *indicatorColor, XColor *selectColor, XColor *disColor, int on, int disabled, int mode); /* * Indicator Draw Modes */ #define CHECK_BUTTON 0 #define CHECK_MENU 1 #define RADIO_BUTTON 2 #define RADIO_MENU 3 /* * Procedures used internally. */ static void SetHelpMenu(TkMenu *menuPtr); static void DrawMenuEntryAccelerator(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, Tk_3DBorder activeBorder, int x, int y, int width, int height, int drawArrow); static void DrawMenuEntryBackground(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, Tk_3DBorder activeBorder, Tk_3DBorder bgBorder, int x, int y, int width, int heigth); static void DrawMenuEntryIndicator(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, Tk_3DBorder border, XColor *indicatorColor, XColor *disableColor, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawMenuEntryLabel(TkMenu * menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawMenuSeparator(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawTearoffEntry(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawMenuUnderline(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void GetMenuAccelGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetMenuLabelGeometry(TkMenuEntry *mePtr, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetMenuIndicatorGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetMenuSeparatorGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetTearoffEntryGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); /* *---------------------------------------------------------------------- * * TkpNewMenu -- * * Gets the platform-specific piece of the menu. Invoked during idle * after the generic part of the menu has been created. * * Results: * Standard TCL error. * * Side effects: * Allocates any platform specific allocations and places them in the * platformData field of the menuPtr. * *---------------------------------------------------------------------- */ int TkpNewMenu( TkMenu *menuPtr) { SetHelpMenu(menuPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TkpDestroyMenu -- * * Destroys platform-specific menu structures. Called when the generic * menu structure is destroyed for the menu. * * Results: * None. * * Side effects: * All platform-specific allocations are freed up. * *---------------------------------------------------------------------- */ void TkpDestroyMenu( TkMenu *menuPtr) { /* * Nothing to do. */ } /* *---------------------------------------------------------------------- * * TkpDestroyMenuEntry -- * * Cleans up platform-specific menu entry items. Called when entry is * destroyed in the generic code. * * Results: * None. * * Side effects: * All platform specific allocations are freed up. * *---------------------------------------------------------------------- */ void TkpDestroyMenuEntry( TkMenuEntry *mEntryPtr) { /* * Nothing to do. */ } /* *---------------------------------------------------------------------- * * TkpConfigureMenuEntry -- * * Processes configuration options for menu entries. Called when the * generic options are processed for the menu. * * Results: * Returns standard TCL result. If TCL_ERROR is returned, then the * interp's result contains an error message. * * Side effects: * Configuration information get set for mePtr; old resources get freed, * if any need it. * *---------------------------------------------------------------------- */ int TkpConfigureMenuEntry( register TkMenuEntry *mePtr)/* Information about menu entry; may or may * not already have values for some fields. */ { /* * If this is a cascade menu, and the child menu exists, check to see if * the child menu is a help menu. */ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) { TkMenuReferences *menuRefPtr; menuRefPtr = TkFindMenuReferencesObj(mePtr->menuPtr->interp, mePtr->namePtr); if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) { SetHelpMenu(menuRefPtr->menuPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TkpMenuNewEntry -- * * Called when a new entry is created in a menu. Fills in platform * specific data for the entry. The platformEntryData field is used to * store the indicator diameter for radio button and check box entries. * * Results: * Standard TCL error. * * Side effects: * None on Unix. * *---------------------------------------------------------------------- */ int TkpMenuNewEntry( TkMenuEntry *mePtr) { return TCL_OK; } /* *---------------------------------------------------------------------- * * TkpSetWindowMenuBar -- * * Sets up the menu as a menubar in the given window. * * Results: * None. * * Side effects: * Recomputes geometry of given window. * *---------------------------------------------------------------------- */ void TkpSetWindowMenuBar( Tk_Window tkwin, /* The window we are setting */ TkMenu *menuPtr) /* The menu we are setting */ { if (menuPtr == NULL) { TkUnixSetMenubar(tkwin, NULL); } else { TkUnixSetMenubar(tkwin, menuPtr->tkwin); } } /* *---------------------------------------------------------------------- * * TkpSetMainMenuBar -- * * Called when a toplevel widget is brought to front. On the Macintosh, * sets up the menubar that goes accross the top of the main monitor. On * other platforms, nothing is necessary. * * Results: * None. * * Side effects: * Recompute geometry of given window. * *---------------------------------------------------------------------- */ void TkpSetMainMenubar( Tcl_Interp *interp, Tk_Window tkwin, char *menuName) { /* * Nothing to do. */ } /* *---------------------------------------------------------------------- * * GetMenuIndicatorGeometry -- * * Fills out the geometry of the indicator in a menu item. Note that the * mePtr->height field must have already been filled in by * GetMenuLabelGeometry since this height depends on the label height. * * Results: * widthPtr and heightPtr point to the new geometry values. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void GetMenuIndicatorGeometry( TkMenu *menuPtr, /* The menu we are drawing. */ TkMenuEntry *mePtr, /* The entry we are interested in. */ Tk_Font tkfont, /* The precalculated font */ CONST Tk_FontMetrics *fmPtr,/* The precalculated metrics */ int *widthPtr, /* The resulting width */ int *heightPtr) /* The resulting height */ { if ((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY)) { if (!mePtr->hideMargin && mePtr->indicatorOn) { if ((mePtr->image != NULL) || (mePtr->bitmapPtr != NULL)) { *widthPtr = (14 * mePtr->height) / 10; *heightPtr = mePtr->height; if (mePtr->type == CHECK_BUTTON_ENTRY) { mePtr->platformEntryData = (TkMenuPlatformEntryData) INT2PTR((65 * mePtr->height) / 100); } else { mePtr->platformEntryData = (TkMenuPlatformEntryData) INT2PTR((75 * mePtr->height) / 100); } } else { *widthPtr = *heightPtr = mePtr->height; if (mePtr->type == CHECK_BUTTON_ENTRY) { mePtr->platformEntryData = (TkMenuPlatformEntryData) INT2PTR((80 * mePtr->height) / 100); } else { mePtr->platformEntryData = (TkMenuPlatformEntryData) INT2PTR(mePtr->height); } } } else { int borderWidth; Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); *heightPtr = 0; *widthPtr = borderWidth; } } else { int borderWidth; Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); *heightPtr = 0; *widthPtr = borderWidth; } } /* *---------------------------------------------------------------------- * * GetMenuAccelGeometry -- * * Get the geometry of the accelerator area of a menu item. * * Results: * heightPtr and widthPtr are set. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void GetMenuAccelGeometry( TkMenu *menuPtr, /* The menu was are drawing */ TkMenuEntry *mePtr, /* The entry we are getting the geometry for */ Tk_Font tkfont, /* The precalculated font */ CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ int *widthPtr, /* The width of the acclerator area */ int *heightPtr) /* The height of the accelerator area */ { *heightPtr = fmPtr->linespace; if (mePtr->type == CASCADE_ENTRY) { *widthPtr = 2 * CASCADE_ARROW_WIDTH; } else if ((menuPtr->menuType != MENUBAR) && (mePtr->accelPtr != NULL)) { char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength); } else { *widthPtr = 0; } } /* *---------------------------------------------------------------------- * * DrawMenuEntryBackground -- * * This procedure draws the background part of a menu. * * Results: * None. * * Side effects: * Commands are output to X to display the menu in its current mode. * *---------------------------------------------------------------------- */ static void DrawMenuEntryBackground( TkMenu *menuPtr, /* The menu we are drawing */ TkMenuEntry *mePtr, /* The entry we are drawing. */ Drawable d, /* The drawable we are drawing into */ Tk_3DBorder activeBorder, /* The border for an active item */ Tk_3DBorder bgBorder, /* The background border */ int x, /* Left coordinate of entry rect */ int y, /* Right coordinate of entry rect */ int width, /* Width of entry rect */ int height) /* Height of entry rect */ { if (mePtr->state == ENTRY_ACTIVE) { int relief; int activeBorderWidth; bgBorder = activeBorder; if ((menuPtr->menuType == MENUBAR) && ((menuPtr->postedCascade == NULL) || (menuPtr->postedCascade != mePtr))) { relief = TK_RELIEF_FLAT; } else { relief = TK_RELIEF_RAISED; } Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height, activeBorderWidth, relief); } else { Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height, 0, TK_RELIEF_FLAT); } } /* *---------------------------------------------------------------------- * * DrawMenuEntryAccelerator -- * * This procedure draws the background part of a menu. * * Results: * None. * * Side effects: * Commands are output to X to display the menu in its current mode. * *---------------------------------------------------------------------- */ static void DrawMenuEntryAccelerator( TkMenu *menuPtr, /* The menu we are drawing */ TkMenuEntry *mePtr, /* The entry we are drawing */ Drawable d, /* The drawable we are drawing into */ GC gc, /* The precalculated gc to draw with */ Tk_Font tkfont, /* The precalculated font */ CONST Tk_FontMetrics *fmPtr,/* The precalculated metrics */ Tk_3DBorder activeBorder, /* The border for an active item */ int x, /* Left coordinate of entry rect */ int y, /* Top coordinate of entry rect */ int width, /* Width of entry */ int height, /* Height of entry */ int drawArrow) /* Whether or not to draw arrow. */ { XPoint points[3]; int borderWidth, activeBorderWidth; /* * Draw accelerator or cascade arrow. */ if (menuPtr->menuType == MENUBAR) { return; } Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); if ((mePtr->type == CASCADE_ENTRY) && drawArrow) { points[0].x = x + width - borderWidth - activeBorderWidth - CASCADE_ARROW_WIDTH; points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2; points[1].x = points[0].x; points[1].y = points[0].y + CASCADE_ARROW_HEIGHT; points[2].x = points[0].x + CASCADE_ARROW_WIDTH; points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2; Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 3, DECORATION_BORDER_WIDTH, (menuPtr->postedCascade == mePtr) ? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED); } else if (mePtr->accelPtr != NULL) { char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); int left = x + mePtr->labelWidth + activeBorderWidth + mePtr->indicatorSpace; if (menuPtr->menuType == MENUBAR) { left += 5; } Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, mePtr->accelLength, left, (y + (height + fmPtr->ascent - fmPtr->descent) / 2)); } } /* *---------------------------------------------------------------------- * * DrawMenuEntryIndicator -- * * This procedure draws the background part of a menu. * * Results: * None. * * Side effects: * Commands are output to X to display the menu in its current mode. * *---------------------------------------------------------------------- */ static void DrawMenuEntryIndicator( TkMenu *menuPtr, /* The menu we are drawing */ TkMenuEntry *mePtr, /* The entry we are drawing */ Drawable d, /* The drawable to draw into */ Tk_3DBorder border, /* The background color */ XColor *indicatorColor, /* The color to draw indicators with */ XColor *disableColor, /* The color use use when disabled */ Tk_Font tkfont, /* The font to draw with */ CONST Tk_FontMetrics *fmPtr,/* The font metrics of the font */ int x, /* The left of the entry rect */ int y, /* The top of the entry rect */ int width, /* Width of menu entry */ int height) /* Height of menu entry */ { /* * Draw check-button indicator. */ if ((mePtr->type == CHECK_BUTTON_ENTRY) && mePtr->indicatorOn) { int top, left, activeBorderWidth; int disabled = (mePtr->state == ENTRY_DISABLED); XColor *bg; Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); bg = Tk_3DBorderColor(border); top = y + height/2; left = x + activeBorderWidth + DECORATION_BORDER_WIDTH + mePtr->indicatorSpace/2; TkpDrawCheckIndicator(menuPtr->tkwin, menuPtr->display, d, left, top, border, indicatorColor, bg, disableColor, (mePtr->entryFlags & ENTRY_SELECTED), disabled, CHECK_MENU); } /* * Draw radio-button indicator. */ if ((mePtr->type == RADIO_BUTTON_ENTRY) && mePtr->indicatorOn) { int top, left, activeBorderWidth; int disabled = (mePtr->state == ENTRY_DISABLED); XColor *bg; Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); bg = Tk_3DBorderColor(border); top = y + height/2; left = x + activeBorderWidth + DECORATION_BORDER_WIDTH + mePtr->indicatorSpace/2; TkpDrawCheckIndicator(menuPtr->tkwin, menuPtr->display, d, left, top, border, indicatorColor, bg, disableColor, (mePtr->entryFlags & ENTRY_SELECTED), disabled, RADIO_MENU); } } /* *---------------------------------------------------------------------- * * DrawMenuSeparator -- * * This procedure draws a separator menu item. * * Results: * None. * * Side effects: * Commands are output to X to display the menu in its current mode. * *---------------------------------------------------------------------- */ static void DrawMenuSeparator( TkMenu *menuPtr, /* The menu we are drawing */ TkMenuEntry *mePtr, /* The entry we are drawing */ Drawable d, /* The drawable we are using */ GC gc, /* The gc to draw into */ Tk_Font tkfont, /* The font to draw with */ CONST Tk_FontMetrics *fmPtr,/* The font metrics from the font */ int x, int y, int width, int height) { XPoint points[2]; Tk_3DBorder border; if (menuPtr->menuType == MENUBAR) { return; } points[0].x = x; points[0].y = y + height/2; points[1].x = width - 1; points[1].y = points[0].y; border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, TK_RELIEF_RAISED); } /* *---------------------------------------------------------------------- * * DrawMenuEntryLabel -- * * This procedure draws the label part of a menu. * * Results: * None. * * Side effects: * Commands are output to X to display the menu in its current mode. * *---------------------------------------------------------------------- */ static void DrawMenuEntryLabel( TkMenu *menuPtr, /* The menu we are drawing. */ TkMenuEntry *mePtr, /* The entry we are drawing. */ Drawable d, /* What we are drawing into. */ GC gc, /* The gc we are drawing into.*/ Tk_Font tkfont, /* The precalculated font. */ CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics. */ int x, /* Left edge. */ int y, /* Top edge. */ int width, /* width of entry. */ int height) /* height of entry. */ { int indicatorSpace = mePtr->indicatorSpace; int activeBorderWidth, leftEdge, imageHeight, imageWidth; int textHeight = 0, textWidth = 0; /* stop GCC warning */ int haveImage = 0, haveText = 0; int imageXOffset = 0, imageYOffset = 0; int textXOffset = 0, textYOffset = 0; Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); leftEdge = x + indicatorSpace + activeBorderWidth; if (menuPtr->menuType == MENUBAR) { leftEdge += 5; } /* * Work out what we will need to draw first. */ if (mePtr->image != NULL) { Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight); haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight); haveImage = 1; } if (!haveImage || (mePtr->compound != COMPOUND_NONE)) { if (mePtr->labelLength > 0) { char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength); textHeight = fmPtr->linespace; haveText = 1; } } /* * Now work out what the relative positions are. */ if (haveImage && haveText) { int fullWidth = (imageWidth > textWidth ? imageWidth : textWidth); switch ((enum compound) mePtr->compound) { case COMPOUND_TOP: textXOffset = (fullWidth - textWidth)/2; textYOffset = imageHeight/2 + 2; imageXOffset = (fullWidth - imageWidth)/2; imageYOffset = -textHeight/2; break; case COMPOUND_BOTTOM: textXOffset = (fullWidth - textWidth)/2; textYOffset = -imageHeight/2; imageXOffset = (fullWidth - imageWidth)/2; imageYOffset = textHeight/2 + 2; break; case COMPOUND_LEFT: /* * Position image in the indicator space to the left of the * entries, unless this entry is a radio|check button because then * the indicator space will be used. */ textXOffset = imageWidth + 2; textYOffset = 0; imageXOffset = 0; imageYOffset = 0; if ((mePtr->type != CHECK_BUTTON_ENTRY) && (mePtr->type != RADIO_BUTTON_ENTRY)) { textXOffset -= indicatorSpace; if (textXOffset < 0) { textXOffset = 0; } imageXOffset = -indicatorSpace; } break; case COMPOUND_RIGHT: textXOffset = 0; textYOffset = 0; imageXOffset = textWidth + 2; imageYOffset = 0; break; case COMPOUND_CENTER: textXOffset = (fullWidth - textWidth)/2; textYOffset = 0; imageXOffset = (fullWidth - imageWidth)/2; imageYOffset = 0; break; case COMPOUND_NONE: break; } } else { textXOffset = 0; textYOffset = 0; imageXOffset = 0; imageYOffset = 0; } /* * Draw label and/or bitmap or image for entry. */ if (mePtr->image != NULL) { if ((mePtr->selectImage != NULL) && (mePtr->entryFlags & ENTRY_SELECTED)) { Tk_RedrawImage(mePtr->selectImage, 0, 0, imageWidth, imageHeight, d, leftEdge + imageXOffset, (int) (y + (mePtr->height-imageHeight)/2 + imageYOffset)); } else { Tk_RedrawImage(mePtr->image, 0, 0, imageWidth, imageHeight, d, leftEdge + imageXOffset, (int) (y + (mePtr->height-imageHeight)/2 + imageYOffset)); } } else if (mePtr->bitmapPtr != None) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0, (unsigned) imageWidth, (unsigned) imageHeight, leftEdge + imageXOffset, (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset), 1); } if ((mePtr->compound != COMPOUND_NONE) || !haveImage) { int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; if (mePtr->labelLength > 0) { char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); Tk_DrawChars(menuPtr->display, d, gc, tkfont, label, mePtr->labelLength, leftEdge + textXOffset, baseline + textYOffset); DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x + textXOffset, y + textYOffset, width, height); } } if (mePtr->state == ENTRY_DISABLED) { if (menuPtr->disabledFgPtr == NULL) { XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y, (unsigned) width, (unsigned) height); } else if ((mePtr->image != NULL) && (menuPtr->disabledImageGC != None)) { XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC, leftEdge + imageXOffset, (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset), (unsigned) imageWidth, (unsigned) imageHeight); } } } /* *---------------------------------------------------------------------- * * DrawMenuUnderline -- * * On appropriate platforms, draw the underline character for the menu. * * Results: * None. * * Side effects: * Commands are output to X to display the menu in its current mode. * *---------------------------------------------------------------------- */ static void DrawMenuUnderline( TkMenu *menuPtr, /* The menu to draw into */ TkMenuEntry *mePtr, /* The entry we are drawing */ Drawable d, /* What we are drawing into */ GC gc, /* The gc to draw into */ Tk_Font tkfont, /* The precalculated font */ CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ int x, int y, int width, int height) { if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) { int len; /* * Do the unicode call just to prevent overruns. */ Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len); if (mePtr->underline < len) { int activeBorderWidth, leftEdge; CONST char *label, *start, *end; label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); start = Tcl_UtfAtIndex(label, mePtr->underline); end = Tcl_UtfNext(start); Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); leftEdge = x + mePtr->indicatorSpace + activeBorderWidth; if (menuPtr->menuType == MENUBAR) { leftEdge += 5; } Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, label, leftEdge, y + (height + fmPtr->ascent - fmPtr->descent) / 2, start - label, end - label); } } } /* *---------------------------------------------------------------------- * * TkpPostMenu -- * * Posts a menu on the screen * * Results: * None. * * Side effects: * The menu is posted and handled. * *---------------------------------------------------------------------- */ int TkpPostMenu( Tcl_Interp *interp, TkMenu *menuPtr, int x, int y) { return TkPostTearoffMenu(interp, menuPtr, x, y); } /* *---------------------------------------------------------------------- * * GetMenuSeparatorGeometry -- * * Gets the width and height of the indicator area of a menu. * * Results: * widthPtr and heightPtr are set. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void GetMenuSeparatorGeometry( TkMenu *menuPtr, /* The menu we are measuring */ TkMenuEntry *mePtr, /* The entry we are measuring */ Tk_Font tkfont, /* The precalculated font */ CONST Tk_FontMetrics *fmPtr,/* The precalcualted font metrics */ int *widthPtr, /* The resulting width */ int *heightPtr) /* The resulting height */ { *widthPtr = 0; *heightPtr = fmPtr->linespace; } /* *---------------------------------------------------------------------- * * GetTearoffEntryGeometry -- * * Gets the width and height of the indicator area of a menu. * * Results: * widthPtr and heightPtr are set. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void GetTearoffEntryGeometry( TkMenu *menuPtr, /* The menu we are drawing */ TkMenuEntry *mePtr, /* The entry we are measuring */ Tk_Font tkfont, /* The precalculated font */ CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ int *widthPtr, /* The resulting width */ int *heightPtr) /* The resulting height */ { if (menuPtr->menuType != MASTER_MENU) { *heightPtr = 0; *widthPtr = 0; } else { *heightPtr = fmPtr->linespace; *widthPtr = Tk_TextWidth(tkfont, "W", 1); } } /* *-------------------------------------------------------------- * * TkpComputeMenubarGeometry -- * * This procedure is invoked to recompute the size and layout of a menu * that is a menubar clone. * * Results: * None. * * Side effects: * Fields of menu entries are changed to reflect their current positions, * and the size of the menu window itself may be changed. * *-------------------------------------------------------------- */ void TkpComputeMenubarGeometry( TkMenu *menuPtr) /* Structure describing menu. */ { Tk_Font tkfont, menuFont; Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr; int width, height, i, j, x, y, currentRowHeight, maxWidth; int maxWindowWidth, lastRowBreak, lastEntry; int borderWidth, activeBorderWidth, helpMenuIndex = -1; TkMenuEntry *mePtr; if (menuPtr->tkwin == NULL) { return; } Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); maxWidth = 0; if (menuPtr->numEntries == 0) { height = 0; } else { int borderWidth; maxWindowWidth = Tk_Width(menuPtr->tkwin); if (maxWindowWidth == 1) { maxWindowWidth = 0x7ffffff; } currentRowHeight = 0; Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); x = y = borderWidth; lastRowBreak = 0; /* * On the Mac especially, getting font metrics can be quite slow, so * we want to do it intelligently. We are going to precalculate them * and pass them down to all of the measureing and drawing routines. * We will measure the font metrics of the menu once, and if an entry * has a font set, we will measure it as we come to it, and then we * decide which set to give the geometry routines. */ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); Tk_GetFontMetrics(menuFont, &menuMetrics); for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; mePtr->entryFlags &= ~ENTRY_LAST_COLUMN; if (mePtr->fontPtr != NULL) { tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } else { tkfont = menuFont; fmPtr = &menuMetrics; } /* * For every entry, we need to check to see whether or not we * wrap. If we do wrap, then we have to adjust all of the previous * entries' height and y position, because when we see them the * first time, we don't know how big its neighbor might be. */ if ((mePtr->type == SEPARATOR_ENTRY) || (mePtr->type == TEAROFF_ENTRY)) { mePtr->height = mePtr->width = 0; } else { GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width, &height); mePtr->height = height + 2 * activeBorderWidth + 10; mePtr->width = width; GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, &width, &height); mePtr->indicatorSpace = width; if (width > 0) { mePtr->width += width; } mePtr->width += 2 * activeBorderWidth + 10; } if (mePtr->entryFlags & ENTRY_HELP_MENU) { helpMenuIndex = i; } else if (x + mePtr->width + borderWidth > maxWindowWidth) { if (i == lastRowBreak) { mePtr->y = y; mePtr->x = x; lastRowBreak++; y += mePtr->height; currentRowHeight = 0; } else { x = borderWidth; for (j = lastRowBreak; j < i; j++) { menuPtr->entries[j]->y = y + currentRowHeight - menuPtr->entries[j]->height; menuPtr->entries[j]->x = x; x += menuPtr->entries[j]->width; } lastRowBreak = i; y += currentRowHeight; currentRowHeight = mePtr->height; } if (x > maxWidth) { maxWidth = x; } x = borderWidth; } else { x += mePtr->width; if (mePtr->height > currentRowHeight) { currentRowHeight = mePtr->height; } } } lastEntry = menuPtr->numEntries - 1; if (helpMenuIndex == lastEntry) { lastEntry--; } if ((lastEntry >= 0) && (x + menuPtr->entries[lastEntry]->width + borderWidth > maxWidth)) { maxWidth = x + menuPtr->entries[lastEntry]->width + borderWidth; } x = borderWidth; for (j = lastRowBreak; j < menuPtr->numEntries; j++) { if (j == helpMenuIndex) { continue; } menuPtr->entries[j]->y = y + currentRowHeight - menuPtr->entries[j]->height; menuPtr->entries[j]->x = x; x += menuPtr->entries[j]->width; } if (helpMenuIndex != -1) { mePtr = menuPtr->entries[helpMenuIndex]; if (x + mePtr->width + borderWidth > maxWindowWidth) { y += currentRowHeight; currentRowHeight = mePtr->height; x = borderWidth; } else if (mePtr->height > currentRowHeight) { currentRowHeight = mePtr->height; } mePtr->x = maxWindowWidth - borderWidth - mePtr->width; mePtr->y = y + currentRowHeight - mePtr->height; } height = y + currentRowHeight + borderWidth; } width = Tk_Width(menuPtr->tkwin); /* * The X server doesn't like zero dimensions, so round up to at least 1 (a * zero-sized menu should never really occur, anyway). */ if (width <= 0) { width = 1; } if (height <= 0) { height = 1; } menuPtr->totalWidth = maxWidth; menuPtr->totalHeight = height; } /* *---------------------------------------------------------------------- * * DrawTearoffEntry -- * * This procedure draws the background part of a menu. * * Results: * None. * * Side effects: * Commands are output to X to display the menu in its current mode. * *---------------------------------------------------------------------- */ static void DrawTearoffEntry( TkMenu *menuPtr, /* The menu we are drawing */ TkMenuEntry *mePtr, /* The entry we are drawing */ Drawable d, /* The drawable we are drawing into */ GC gc, /* The gc we are drawing with */ Tk_Font tkfont, /* The font we are drawing with */ CONST Tk_FontMetrics *fmPtr,/* The metrics we are drawing with */ int x, int y, int width, int height) { XPoint points[2]; int segmentWidth, maxX; Tk_3DBorder border; if (menuPtr->menuType != MASTER_MENU) { return; } points[0].x = x; points[0].y = y + height/2; points[1].y = points[0].y; segmentWidth = 6; maxX = width - 1; border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr); while (points[0].x < maxX) { points[1].x = points[0].x + segmentWidth; if (points[1].x > maxX) { points[1].x = maxX; } Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, TK_RELIEF_RAISED); points[0].x += 2 * segmentWidth; } } /* *-------------------------------------------------------------- * * TkpInitializeMenuBindings -- * * For every interp, initializes the bindings for Windows menus. Does * nothing on Mac or XWindows. * * Results: * None. * * Side effects: * C-level bindings are setup for the interp which will handle Alt-key * sequences for menus without beeping or interfering with user-defined * Alt-key bindings. * *-------------------------------------------------------------- */ void TkpInitializeMenuBindings( Tcl_Interp *interp, /* The interpreter to set. */ Tk_BindingTable bindingTable) /* The table to add to. */ { /* * Nothing to do. */ } /* *---------------------------------------------------------------------- * * SetHelpMenu -- * * Given a menu, check to see whether or not it is a help menu cascade in * a menubar. If it is, the entry that points to this menu will be * marked. * * RESULTS: * None. * * Side effects: * Will set the ENTRY_HELP_MENU flag appropriately. * *---------------------------------------------------------------------- */ static void SetHelpMenu( TkMenu *menuPtr) /* The menu we are checking */ { TkMenuEntry *cascadeEntryPtr; int useMotifHelp = 0; const char *option = NULL; if (menuPtr->tkwin) { option = Tk_GetOption(menuPtr->tkwin, "useMotifHelp", "UseMotifHelp"); if (option != NULL) { Tcl_GetBoolean(NULL, option, &useMotifHelp); } } if (!useMotifHelp) { return; } for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr; cascadeEntryPtr != NULL; cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { if ((cascadeEntryPtr->menuPtr->menuType == MENUBAR) && (cascadeEntryPtr->menuPtr->masterMenuPtr->tkwin != NULL) && (menuPtr->masterMenuPtr->tkwin != NULL)) { TkMenu *masterMenuPtr = cascadeEntryPtr->menuPtr->masterMenuPtr; char *helpMenuName = ckalloc(strlen(Tk_PathName( masterMenuPtr->tkwin)) + strlen(".help") + 1); strcpy(helpMenuName, Tk_PathName(masterMenuPtr->tkwin)); strcat(helpMenuName, ".help"); if (strcmp(helpMenuName, Tk_PathName(menuPtr->masterMenuPtr->tkwin)) == 0) { cascadeEntryPtr->entryFlags |= ENTRY_HELP_MENU; } else { cascadeEntryPtr->entryFlags &= ~ENTRY_HELP_MENU; } ckfree(helpMenuName); } } } /* *---------------------------------------------------------------------- * * TkpDrawMenuEntry -- * * Draws the given menu entry at the given coordinates with the given * attributes. * * Results: * None. * * Side effects: * X Server commands are executed to display the menu entry. * *---------------------------------------------------------------------- */ void TkpDrawMenuEntry( TkMenuEntry *mePtr, /* The entry to draw */ Drawable d, /* What to draw into */ Tk_Font tkfont, /* Precalculated font for menu */ CONST Tk_FontMetrics *menuMetricsPtr, /* Precalculated metrics for menu */ int x, /* X-coordinate of topleft of entry */ int y, /* Y-coordinate of topleft of entry */ int width, /* Width of the entry rectangle */ int height, /* Height of the current rectangle */ int strictMotif, /* Boolean flag */ int drawArrow) /* Whether or not to draw the cascade * arrow for cascade items. Only applies * to Windows. */ { GC gc, indicatorGC; XColor *indicatorColor, *disableColor = NULL; TkMenu *menuPtr = mePtr->menuPtr; Tk_3DBorder bgBorder, activeBorder; CONST Tk_FontMetrics *fmPtr; Tk_FontMetrics entryMetrics; int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0; int adjustedY = y + padY; int adjustedHeight = height - 2 * padY; /* * Choose the gc for drawing the foreground part of the entry. */ if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) { gc = mePtr->activeGC; if (gc == NULL) { gc = menuPtr->activeGC; } } else { TkMenuEntry *cascadeEntryPtr; int parentDisabled = 0; for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr; cascadeEntryPtr != NULL; cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { if (cascadeEntryPtr->namePtr != NULL) { char *name = Tcl_GetString(cascadeEntryPtr->namePtr); if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) { if (cascadeEntryPtr->state == ENTRY_DISABLED) { parentDisabled = 1; } break; } } } if (((parentDisabled || (mePtr->state == ENTRY_DISABLED))) && (menuPtr->disabledFgPtr != NULL)) { gc = mePtr->disabledGC; if (gc == NULL) { gc = menuPtr->disabledGC; } } else { gc = mePtr->textGC; if (gc == NULL) { gc = menuPtr->textGC; } } } indicatorGC = mePtr->indicatorGC; if (indicatorGC == NULL) { indicatorGC = menuPtr->indicatorGC; } if (mePtr->indicatorFgPtr) { indicatorColor = Tk_GetColorFromObj(menuPtr->tkwin, mePtr->indicatorFgPtr); } else { indicatorColor = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->indicatorFgPtr); } if (menuPtr->disabledFgPtr != NULL) { disableColor = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->disabledFgPtr); } bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, (mePtr->borderPtr == NULL) ? menuPtr->borderPtr : mePtr->borderPtr); if (strictMotif) { activeBorder = bgBorder; } else { activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, (mePtr->activeBorderPtr == NULL) ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr); } if (mePtr->fontPtr == NULL) { fmPtr = menuMetricsPtr; } else { tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } /* * Need to draw the entire background, including padding. On Unix, for * menubars, we have to draw the rest of the entry taking into account the * padding. */ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder, bgBorder, x, y, width, height); if (mePtr->type == SEPARATOR_ENTRY) { DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY, width, adjustedHeight); } else if (mePtr->type == TEAROFF_ENTRY) { DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY, width, adjustedHeight); } else { DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY, width, adjustedHeight); DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder, x, adjustedY, width, adjustedHeight, drawArrow); if (!mePtr->hideMargin) { if (mePtr->state == ENTRY_ACTIVE) { bgBorder = activeBorder; } DrawMenuEntryIndicator(menuPtr, mePtr, d, bgBorder, indicatorColor, disableColor, tkfont, fmPtr, x, adjustedY, width, adjustedHeight); } } } /* *---------------------------------------------------------------------- * * GetMenuLabelGeometry -- * * Figures out the size of the label portion of a menu item. * * Results: * widthPtr and heightPtr are filled in with the correct geometry * information. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void GetMenuLabelGeometry( TkMenuEntry *mePtr, /* The entry we are computing */ Tk_Font tkfont, /* The precalculated font */ CONST Tk_FontMetrics *fmPtr,/* The precalculated metrics */ int *widthPtr, /* The resulting width of the label portion */ int *heightPtr) /* The resulting height of the label * portion */ { TkMenu *menuPtr = mePtr->menuPtr; int haveImage = 0; if (mePtr->image != NULL) { Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr); haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr); haveImage = 1; } else { *heightPtr = 0; *widthPtr = 0; } if (haveImage && (mePtr->compound == COMPOUND_NONE)) { /* * We don't care about the text in this case. */ } else { /* * Either it is compound or we don't have an image. */ if (mePtr->labelPtr != NULL) { int textWidth; char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength); if ((mePtr->compound != COMPOUND_NONE) && haveImage) { switch ((enum compound) mePtr->compound) { case COMPOUND_TOP: case COMPOUND_BOTTOM: if (textWidth > *widthPtr) { *widthPtr = textWidth; } /* * Add text and padding. */ *heightPtr += fmPtr->linespace + 2; break; case COMPOUND_LEFT: case COMPOUND_RIGHT: if (fmPtr->linespace > *heightPtr) { *heightPtr = fmPtr->linespace; } /* * Add text and padding. */ *widthPtr += textWidth + 2; break; case COMPOUND_CENTER: if (fmPtr->linespace > *heightPtr) { *heightPtr = fmPtr->linespace; } if (textWidth > *widthPtr) { *widthPtr = textWidth; } break; case COMPOUND_NONE: break; } } else { /* * We don't have an image or we're not compound. */ *heightPtr = fmPtr->linespace; *widthPtr = textWidth; } } else { /* * An empty entry still has this height. */ *heightPtr = fmPtr->linespace; } } *heightPtr += 1; } /* *-------------------------------------------------------------- * * TkpComputeStandardMenuGeometry -- * * This procedure is invoked to recompute the size and layout of a menu * that is not a menubar clone. * * Results: * None. * * Side effects: * Fields of menu entries are changed to reflect their current positions, * and the size of the menu window itself may be changed. * *-------------------------------------------------------------- */ void TkpComputeStandardMenuGeometry( TkMenu *menuPtr) /* Structure describing menu. */ { Tk_Font tkfont, menuFont; Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr; int x, y, height, width, indicatorSpace, labelWidth, accelWidth; int windowWidth, windowHeight, accelSpace, i, j, lastColumnBreak = 0; TkMenuEntry *mePtr; int borderWidth, activeBorderWidth; if (menuPtr->tkwin == NULL) { return; } Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr, &activeBorderWidth); x = y = borderWidth; indicatorSpace = labelWidth = accelWidth = 0; windowHeight = windowWidth = 0; /* * On the Mac especially, getting font metrics can be quite slow, so we * want to do it intelligently. We are going to precalculate them and pass * them down to all of the measuring and drawing routines. We will measure * the font metrics of the menu once. If an entry does not have its own * font set, then we give the geometry/drawing routines the menu's font * and metrics. If an entry has its own font, we will measure that font * and give all of the geometry/drawing the entry's font and metrics. */ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr); Tk_GetFontMetrics(menuFont, &menuMetrics); accelSpace = Tk_TextWidth(menuFont, "M", 1); for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; if (mePtr->fontPtr == NULL) { tkfont = menuFont; fmPtr = &menuMetrics; } else { tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr); Tk_GetFontMetrics(tkfont, &entryMetrics); fmPtr = &entryMetrics; } if ((i > 0) && mePtr->columnBreak) { if (accelWidth != 0) { labelWidth += accelSpace; } for (j = lastColumnBreak; j < i; j++) { menuPtr->entries[j]->indicatorSpace = indicatorSpace; menuPtr->entries[j]->labelWidth = labelWidth; menuPtr->entries[j]->width = indicatorSpace + labelWidth + accelWidth + 2 * activeBorderWidth; menuPtr->entries[j]->x = x; menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN; } x += indicatorSpace + labelWidth + accelWidth + 2 * activeBorderWidth; windowWidth = x; indicatorSpace = labelWidth = accelWidth = 0; lastColumnBreak = i; y = borderWidth; } if (mePtr->type == SEPARATOR_ENTRY) { GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont, fmPtr, &width, &height); mePtr->height = height; } else if (mePtr->type == TEAROFF_ENTRY) { GetTearoffEntryGeometry(menuPtr, mePtr, tkfont, fmPtr, &width, &height); mePtr->height = height; labelWidth = width; } else { /* * For each entry, compute the height required by that particular * entry, plus three widths: the width of the label, the width to * allow for an indicator to be displayed to the left of the label * (if any), and the width of the accelerator to be displayed to * the right of the label (if any). These sizes depend, of course, * on the type of the entry. */ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width, &height); mePtr->height = height; if (!mePtr->hideMargin) { width += MENU_MARGIN_WIDTH; } if (width > labelWidth) { labelWidth = width; } GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr, &width, &height); if (height > mePtr->height) { mePtr->height = height; } if (!mePtr->hideMargin) { width += MENU_MARGIN_WIDTH; } if (width > accelWidth) { accelWidth = width; } GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, &width, &height); if (height > mePtr->height) { mePtr->height = height; } if (!mePtr->hideMargin) { width += MENU_MARGIN_WIDTH; } if (width > indicatorSpace) { indicatorSpace = width; } mePtr->height += 2 * activeBorderWidth + MENU_DIVIDER_HEIGHT; } mePtr->y = y; y += mePtr->height; if (y > windowHeight) { windowHeight = y; } } if (accelWidth != 0) { labelWidth += accelSpace; } for (j = lastColumnBreak; j < menuPtr->numEntries; j++) { menuPtr->entries[j]->indicatorSpace = indicatorSpace; menuPtr->entries[j]->labelWidth = labelWidth; menuPtr->entries[j]->width = indicatorSpace + labelWidth + accelWidth + 2 * activeBorderWidth; menuPtr->entries[j]->x = x; menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN; } windowWidth = x + indicatorSpace + labelWidth + accelWidth + 2 * activeBorderWidth + 2 * borderWidth; windowHeight += borderWidth; /* * The X server doesn't like zero dimensions, so round up to at least 1 (a * zero-sized menu should never really occur, anyway). */ if (windowWidth <= 0) { windowWidth = 1; } if (windowHeight <= 0) { windowHeight = 1; } menuPtr->totalWidth = windowWidth; menuPtr->totalHeight = windowHeight; } /* *---------------------------------------------------------------------- * * TkpMenuNotifyToplevelCreate -- * * This routine reconfigures the menu and the clones indicated by * menuName becuase a toplevel has been created and any system menus need * to be created. Not applicable to UNIX. * * Results: * None. * * Side effects: * An idle handler is set up to do the reconfiguration. * *---------------------------------------------------------------------- */ void TkpMenuNotifyToplevelCreate( Tcl_Interp *interp, /* The interp the menu lives in. */ char *menuName) /* The name of the menu to reconfigure. */ { /* * Nothing to do. */ } /* *---------------------------------------------------------------------- * * TkpMenuInit -- * * Does platform-specific initialization of menus. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TkpMenuInit(void) { /* * Nothing to do. */ } /* *---------------------------------------------------------------------- * * TkpMenuThreadInit -- * * Does platform-specific initialization of thread-specific menu state. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TkpMenuThreadInit(void) { /* * Nothing to do. */ } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tcl.m40000644003604700454610000031311712656405252012576 0ustar dgp771div#------------------------------------------------------------------------ # SC_PATH_TCLCONFIG -- # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --with-tcl=... # # Defines the following vars: # TCL_BIN_DIR Full path to the directory containing # the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TCLCONFIG], [ # # Ok, lets find the tcl configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, AC_HELP_STRING([--with-tcl], [directory containing tcl configuration (tclConfig.sh)]), with_tclconfig="${withval}") AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then case "${with_tclconfig}" in */tclConfig.sh ) if test -f "${with_tclconfig}"; then AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" fi ;; esac if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" else AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) fi fi # then check for a private Tcl installation if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ../tcl \ `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tcl \ `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tcl \ `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" break fi done fi # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ `ls -d /System/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tcl.framework/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" break fi done fi # check in a few common install locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" break fi done fi # check in a few other private locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" break fi done fi ]) if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) else no_tcl= TCL_BIN_DIR="${ac_cv_c_tclconfig}" AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_PATH_TKCONFIG -- # # Locate the tkConfig.sh file # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --with-tk=... # # Defines the following vars: # TK_BIN_DIR Full path to the directory containing # the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Ok, lets find the tk configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, AC_HELP_STRING([--with-tk], [directory containing tk configuration (tkConfig.sh)]), with_tkconfig="${withval}") AC_MSG_CHECKING([for Tk configuration]) AC_CACHE_VAL(ac_cv_c_tkconfig,[ # First check to see if --with-tkconfig was specified. if test x"${with_tkconfig}" != x ; then case "${with_tkconfig}" in */tkConfig.sh ) if test -f "${with_tkconfig}"; then AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" fi ;; esac if test -f "${with_tkconfig}/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" else AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) fi fi # then check for a private Tk library if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ../tk \ `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tk \ `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tk \ `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" break fi done fi # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ `ls -d /System/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tk.framework/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/Tk.framework; pwd)`" break fi done fi # check in a few common install locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ ; do if test -f "$i/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i; pwd)`" break fi done fi # check in a few other private locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ${srcdir}/../tk \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" break fi done fi ]) if test x"${ac_cv_c_tkconfig}" = x ; then TK_BIN_DIR="# no Tk configs found" AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) else no_tk= TK_BIN_DIR="${ac_cv_c_tkconfig}" AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_LOAD_TCLCONFIG -- # # Load the tclConfig.sh file # # Arguments: # # Requires the following vars to be set: # TCL_BIN_DIR # # Results: # # Subst the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE # #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # eval is required to do the TCL_DBGX substitution eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tcl.framework installed in an arbitrary location. case ${TCL_DEFS} in *TCL_FRAMEWORK*) if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" break fi done fi if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi # eval is required to do the TCL_DBGX substitution eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" AC_SUBST(TCL_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) ]) #------------------------------------------------------------------------ # SC_LOAD_TKCONFIG -- # # Load the tkConfig.sh file # # Arguments: # # Requires the following vars to be set: # TK_BIN_DIR # # Results: # # Sets the following vars that should be in tkConfig.sh: # TK_BIN_DIR #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi # eval is required to do the TK_DBGX substitution eval "TK_LIB_FILE=\"${TK_LIB_FILE}\"" eval "TK_STUB_LIB_FILE=\"${TK_STUB_LIB_FILE}\"" # If the TK_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TK_LIB_SPEC will be set to the value # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TK_BIN_DIR}/Makefile" ; then TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tk was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tk.framework installed in an arbitrary location. case ${TK_DEFS} in *TK_FRAMEWORK*) if test -f "${TK_BIN_DIR}/${TK_LIB_FILE}"; then for i in "`cd "${TK_BIN_DIR}"; pwd`" \ "`cd "${TK_BIN_DIR}"/../..; pwd`"; do if test "`basename "$i"`" = "${TK_LIB_FILE}.framework"; then TK_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TK_LIB_FILE}" break fi done fi if test -f "${TK_BIN_DIR}/${TK_STUB_LIB_FILE}"; then TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi ;; esac fi # eval is required to do the TK_DBGX substitution eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}\"" eval "TK_LIB_SPEC=\"${TK_LIB_SPEC}\"" eval "TK_STUB_LIB_FLAG=\"${TK_STUB_LIB_FLAG}\"" eval "TK_STUB_LIB_SPEC=\"${TK_STUB_LIB_SPEC}\"" AC_SUBST(TK_VERSION) AC_SUBST(TK_BIN_DIR) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_LIB_FILE) AC_SUBST(TK_LIB_FLAG) AC_SUBST(TK_LIB_SPEC) AC_SUBST(TK_STUB_LIB_FILE) AC_SUBST(TK_STUB_LIB_FLAG) AC_SUBST(TK_STUB_LIB_SPEC) ]) #------------------------------------------------------------------------ # SC_PROG_TCLSH # Locate a tclsh shell installed on the system path. This macro # will only find a Tcl shell that already exists on the system. # It will not find a Tcl shell in the Tcl build directory or # a Tcl shell that has been installed from the Tcl build directory. # If a Tcl shell can't be located on the PATH, then TCLSH_PROG will # be set to "". Extensions should take care not to create Makefile # rules that are run by default and depend on TCLSH_PROG. An # extension can't assume that an executable Tcl shell exists at # build time. # # Arguments # none # # Results # Subst's the following values: # TCLSH_PROG #------------------------------------------------------------------------ AC_DEFUN([SC_PROG_TCLSH], [ AC_MSG_CHECKING([for tclsh]) AC_CACHE_VAL(ac_cv_path_tclsh, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[[8-9]]* 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done ]) if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" AC_MSG_RESULT([$TCLSH_PROG]) else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" AC_MSG_RESULT([No tclsh found on PATH]) fi AC_SUBST(TCLSH_PROG) ]) #------------------------------------------------------------------------ # SC_BUILD_TCLSH # Determine the fully qualified path name of the tclsh executable # in the Tcl build directory. This macro will correctly determine # the name of the tclsh executable even if tclsh has not yet # been built in the build directory. The build tclsh must be used # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # # Arguments # none # # Results # Subst's the following values: # BUILD_TCLSH #------------------------------------------------------------------------ AC_DEFUN([SC_BUILD_TCLSH], [ AC_MSG_CHECKING([for tclsh in Tcl build directory]) BUILD_TCLSH="${TCL_BIN_DIR}"/tclsh AC_MSG_RESULT([$BUILD_TCLSH]) AC_SUBST(BUILD_TCLSH) ]) #------------------------------------------------------------------------ # SC_ENABLE_SHARED -- # # Allows the building of shared libraries # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-shared=yes|no # # Defines the following vars: # STATIC_BUILD Used for building import/export libraries # on Windows. # # Sets the following vars: # SHARED_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, AC_HELP_STRING([--enable-shared], [build and link with shared libraries (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi if test "$tcl_ok" = "yes" ; then AC_MSG_RESULT([shared]) SHARED_BUILD=1 else AC_MSG_RESULT([static]) SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi ]) #------------------------------------------------------------------------ # SC_ENABLE_FRAMEWORK -- # # Allows the building of shared libraries into frameworks # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-framework=yes|no # # Sets the following vars: # FRAMEWORK_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_FRAMEWORK], [ if test "`uname -s`" = "Darwin" ; then AC_MSG_CHECKING([how to package libraries]) AC_ARG_ENABLE(framework, AC_HELP_STRING([--enable-framework], [package shared libraries in MacOSX frameworks (default: off)]), [enable_framework=$enableval], [enable_framework=no]) if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then AC_MSG_WARN([Frameworks can only be built if --enable-shared is yes]) enable_framework=no fi if test $tcl_corefoundation = no; then AC_MSG_WARN([Frameworks can only be used when CoreFoundation is available]) enable_framework=no fi fi if test $enable_framework = yes; then AC_MSG_RESULT([framework]) FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then AC_MSG_RESULT([shared library]) else AC_MSG_RESULT([static library]) fi FRAMEWORK_BUILD=0 fi fi ]) #------------------------------------------------------------------------ # SC_ENABLE_THREADS -- # # Specify if thread support should be enabled # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-threads # # Sets the following vars: # THREADS_LIBS Thread library(s) # # Defines the following vars: # TCL_THREADS # _REENTRANT # _THREAD_SAFE # #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_THREADS], [ AC_ARG_ENABLE(threads, AC_HELP_STRING([--enable-threads], [build with threads (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) if test "${TCL_THREADS}" = 1; then tcl_threaded_core=1; fi if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then TCL_THREADS=1 # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention AC_DEFINE(USE_THREAD_ALLOC, 1, [Do we want to use the threaded memory allocator?]) AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) if test "`uname -s`" = "SunOS" ; then AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, [Do we really want to follow the standard? Yes we do!]) fi AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?]) AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) if test "$tcl_ok" = "no"; then # Check a little harder for __pthread_mutex_init in the same # library, as some systems hide it there until pthread.h is # defined. We could alternatively do an AC_TRY_COMPILE with # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] AC_CHECK_LIB(pthread, __pthread_mutex_init, tcl_ok=yes, tcl_ok=no) fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthread" else AC_CHECK_LIB(pthreads, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthreads" else AC_CHECK_LIB(c, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "no"; then AC_CHECK_LIB(c_r, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -pthread" else TCL_THREADS=0 AC_MSG_WARN([Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...]) fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork) AC_CHECK_FUNC(pthread_attr_get_np,tcl_ok=yes,tcl_ok=no) if test $tcl_ok = yes ; then AC_DEFINE(HAVE_PTHREAD_ATTR_GET_NP, 1, [Do we want a BSD-like thread-attribute interface?]) AC_CACHE_CHECK([for pthread_attr_get_np declaration], tcl_cv_grep_pthread_attr_get_np, [ AC_EGREP_HEADER(pthread_attr_get_np, pthread.h, tcl_cv_grep_pthread_attr_get_np=present, tcl_cv_grep_pthread_attr_get_np=missing)]) if test $tcl_cv_grep_pthread_attr_get_np = missing ; then AC_DEFINE(ATTRGETNP_NOT_DECLARED, 1, [Is pthread_attr_get_np() declared in ?]) fi else AC_CHECK_FUNC(pthread_getattr_np,tcl_ok=yes,tcl_ok=no) if test $tcl_ok = yes ; then AC_DEFINE(HAVE_PTHREAD_GETATTR_NP, 1, [Do we want a Linux-like thread-attribute interface?]) AC_CACHE_CHECK([for pthread_getattr_np declaration], tcl_cv_grep_pthread_getattr_np, [ AC_EGREP_HEADER(pthread_getattr_np, pthread.h, tcl_cv_grep_pthread_getattr_np=present, tcl_cv_grep_pthread_getattr_np=missing)]) if test $tcl_cv_grep_pthread_getattr_np = missing ; then AC_DEFINE(GETATTRNP_NOT_DECLARED, 1, [Is pthread_getattr_np declared in ?]) fi fi fi if test $tcl_ok = no; then # Darwin thread stacksize API AC_CHECK_FUNCS(pthread_get_stacksize_np) fi LIBS=$ac_saved_libs else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with threads]) if test "${TCL_THREADS}" = 1; then AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) if test "${tcl_threaded_core}" = 1; then AC_MSG_RESULT([yes (threaded core)]) else AC_MSG_RESULT([yes]) fi else AC_MSG_RESULT([no (default)]) fi AC_SUBST(TCL_THREADS) ]) #------------------------------------------------------------------------ # SC_ENABLE_SYMBOLS -- # # Specify if debugging symbols should be used. # Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging # can also be enabled. # # Arguments: # none # # Requires the following vars to be set in the Makefile: # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # LDFLAGS_DEBUG # LDFLAGS_OPTIMIZE # # Results: # # Adds the following arguments to configure: # --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 # DBGX Formerly used as debug library extension; # always blank now. # #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, AC_HELP_STRING([--enable-symbols], [build with debugging symbols (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. DBGX="" if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) AC_MSG_RESULT([no]) AC_DEFINE(TCL_CFG_OPTIMIZED, 1, [Is this an optimized build?]) else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then AC_MSG_RESULT([yes (standard debugging)]) fi fi AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(LDFLAGS_DEFAULT) if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?]) fi ifelse($1,bccdebug,dnl Only enable 'compile' for the Tcl core itself if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then AC_DEFINE(TCL_COMPILE_DEBUG, 1, [Is bytecode debugging enabled?]) AC_DEFINE(TCL_COMPILE_STATS, 1, [Are bytecode statistics enabled?]) fi) if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then AC_MSG_RESULT([enabled symbols mem ]ifelse($1,bccdebug,[compile ])[debugging]) else AC_MSG_RESULT([enabled $tcl_ok debugging]) fi fi ]) #------------------------------------------------------------------------ # SC_ENABLE_LANGINFO -- # # Allows use of modern nl_langinfo check for better l10n. # This is only relevant for Unix. # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-langinfo=yes|no (default is yes) # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. # #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_LANGINFO], [ AC_ARG_ENABLE(langinfo, AC_HELP_STRING([--enable-langinfo], [use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on)]), [langinfo_ok=$enableval], [langinfo_ok=yes]) HAVE_LANGINFO=0 if test "$langinfo_ok" = "yes"; then AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no]) fi AC_MSG_CHECKING([whether to use nl_langinfo]) if test "$langinfo_ok" = "yes"; then AC_CACHE_VAL(tcl_cv_langinfo_h, [ AC_TRY_COMPILE([#include ], [nl_langinfo(CODESET);], [tcl_cv_langinfo_h=yes],[tcl_cv_langinfo_h=no])]) AC_MSG_RESULT([$tcl_cv_langinfo_h]) if test $tcl_cv_langinfo_h = yes; then AC_DEFINE(HAVE_LANGINFO, 1, [Do we have nl_langinfo()?]) fi else AC_MSG_RESULT([$langinfo_ok]) fi ]) #-------------------------------------------------------------------- # SC_CONFIG_MANPAGES # # Decide whether to use symlinks for linking the manpages, # whether to compress the manpages after installation, and # whether to add a package name suffix to the installed # manpages to avoidfile name clashes. # If compression is enabled also find out what file name suffix # the given compression program is using. # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-man-symlinks # --enable-man-compression=PROG # --enable-man-suffix[=STRING] # # Defines the following variable: # # MAN_FLAGS - The apropriate flags for installManPage # according to the user's selection. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_MANPAGES], [ AC_MSG_CHECKING([whether to use symlinks for manpages]) AC_ARG_ENABLE(man-symlinks, AC_HELP_STRING([--enable-man-symlinks], [use symlinks for the manpages (default: off)]), test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks", enableval="no") AC_MSG_RESULT([$enableval]) AC_MSG_CHECKING([whether to compress the manpages]) AC_ARG_ENABLE(man-compression, AC_HELP_STRING([--enable-man-compression=PROG], [compress the manpages with PROG (default: off)]), [case $enableval in yes) AC_MSG_ERROR([missing argument to --enable-man-compression]);; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac], enableval="no") AC_MSG_RESULT([$enableval]) if test "$enableval" != "no"; then AC_MSG_CHECKING([for compressed file suffix]) touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" AC_MSG_RESULT([$Z]) fi AC_MSG_CHECKING([whether to add a package name suffix for the manpages]) AC_ARG_ENABLE(man-suffix, AC_HELP_STRING([--enable-man-suffix=STRING], [use STRING as a suffix to manpage file names (default: no, AC_PACKAGE_NAME if enabled without specifying STRING)]), [case $enableval in yes) enableval="AC_PACKAGE_NAME" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac], enableval="no") AC_MSG_RESULT([$enableval]) AC_SUBST(MAN_FLAGS) ]) #-------------------------------------------------------------------- # SC_CONFIG_SYSTEM # # Determine what the system is (some things cannot be easily checked # on a feature-driven basis, alas). This can usually be done via the # "uname" command, but there are a few systems, like Next, where # this doesn't work. # # Arguments: # none # # Results: # Defines the following var: # # system - System/platform/version identification code. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_SYSTEM], [ AC_CACHE_CHECK([system version], tcl_cv_sys_version, [ if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then AC_MSG_WARN([can't find uname command]) tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print $[3]}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi fi fi ]) system=$tcl_cv_sys_version ]) #-------------------------------------------------------------------- # SC_CONFIG_CFLAGS # # Try to determine the proper flags to pass to the compiler # for building shared libraries and other such nonsense. # # Arguments: # none # # Results: # # Defines and substitutes the following vars: # # DL_OBJS - Name of the object file that implements dynamic # loading for Tcl on this system. # DL_LIBS - Library file(s) to include in tclsh and other base # applications in order for the "load" command to work. # LDFLAGS - Flags to pass to the compiler when linking object # files into an executable application binary such # as tclsh. # LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib", # that tell the run-time dynamic linker where to look # for shared libraries such as libtcl.so. Depends on # the variable LIB_RUNTIME_DIR in the Makefile. Could # be the same as CC_SEARCH_FLAGS if ${CC} is used to link. # CC_SEARCH_FLAGS-Flags to pass to ${CC}, such as "-Wl,-rpath,/usr/local/tcl/lib", # that tell the run-time dynamic linker where to look # for shared libraries such as libtcl.so. Depends on # the variable LIB_RUNTIME_DIR in the Makefile. # MAKE_LIB - Command to execute to build the a library; # differs when building shared or static. # MAKE_STUB_LIB - # Command to execute to build a stub library. # INSTALL_LIB - Command to execute to install a library; # differs when building shared or static. # INSTALL_STUB_LIB - # Command to execute to install a stub library. # STLIB_LD - Base command to use for combining object files # into a static library. # SHLIB_CFLAGS - Flags to pass to cc when compiling the components # of a shared library (may request position-independent # code, among other things). # SHLIB_LD - Base command to use for combining object files # into a shared library. # SHLIB_LD_LIBS - Dependent libraries for the linker to scan when # creating shared libraries. This symbol typically # goes at the end of the "ld" commands that build # shared libraries. The value of the symbol is # "${LIBS}" if all of the dependent libraries should # be specified when creating a shared library. If # dependent libraries should not be specified (as on # SunOS 4.x, where they cause the link to fail, or in # general if Tcl and Tk aren't themselves shared # libraries), then this symbol has an empty string # as its value. # SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable # extensions. An empty string means we don't know how # to use shared libraries on this platform. # TCL_SHLIB_LD_EXTRAS - Additional element which are added to SHLIB_LD_LIBS # TK_SHLIB_LD_EXTRAS for the build of Tcl and Tk, but not recorded in the # tclConfig.sh, since they are only used for the build # of Tcl and Tk. # Examples: MacOS X records the library version and # compatibility version in the shared library. But # of course the Tcl version of this is only used for Tcl. # LIB_SUFFIX - Specifies everything that comes after the "libfoo" # in a static or shared library name, using the $VERSION variable # to put the version in the right place. This is used # by platforms that need non-standard library names. # Examples: ${VERSION}.so.1.1 on NetBSD, since it needs # to have a version after the .so, and ${VERSION}.a # on AIX, since a shared library needs to have # a .a extension whereas shared objects for loadable # extensions have a .so extension. Defaults to # ${VERSION}${SHLIB_SUFFIX}. # TCL_LIBS - # Libs to use when linking Tcl shell or some other # shell that includes Tcl libs. # CFLAGS_DEBUG - # Flags used when running the compiler in debug mode # CFLAGS_OPTIMIZE - # Flags used when running the compiler in optimize mode # CFLAGS - Additional CFLAGS added as necessary (usually 64-bit) # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_CFLAGS], [ # Step 0.a: Enable 64 bit support? AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit, AC_HELP_STRING([--enable-64bit], [enable 64bit support (default: off)]), [do64bit=$enableval], [do64bit=no]) AC_MSG_RESULT([$do64bit]) # Step 0.b: Enable Solaris 64 bit VIS support? AC_MSG_CHECKING([if 64bit Sparc VIS support is requested]) AC_ARG_ENABLE(64bit-vis, AC_HELP_STRING([--enable-64bit-vis], [enable 64bit Sparc VIS support (default: off)]), [do64bitVIS=$enableval], [do64bitVIS=no]) AC_MSG_RESULT([$do64bitVIS]) # Force 64bit on with VIS AS_IF([test "$do64bitVIS" = "yes"], [do64bit=yes]) # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. AC_CACHE_CHECK([if compiler supports visibility "hidden"], tcl_cv_cc_visibility_hidden, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_TRY_LINK([ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes, tcl_cv_cc_visibility_hidden=no) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ AC_DEFINE(MODULE_SCOPE, [extern __attribute__((__visibility__("hidden")))], [Compiler support for module scope symbols]) ]) # Step 0.d: Disable -rpath support? AC_MSG_CHECKING([if rpath support is requested]) AC_ARG_ENABLE(rpath, AC_HELP_STRING([--disable-rpath], [disable rpath support (default: on)]), [doRpath=$enableval], [doRpath=yes]) AC_MSG_RESULT([$doRpath]) # Step 1: set the variable "system" to hold the name and version number # for the system. SC_CONFIG_SYSTEM # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no) # Require ranlib early so we can override it in special cases below. AS_IF([test x"${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"]) AC_REQUIRE([AC_PROG_RANLIB]) # Step 3: set configuration options based on system name and version. do64bit_ok=no # default to '{$LIBS}' and set to "" on per-platform necessary basis SHLIB_LD_LIBS='${LIBS}' LDFLAGS_ORIG="$LDFLAGS" # When ld needs options to work in 64-bit mode, put them in # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] # is disabled by the user. [Bug 1016796] LDFLAGS_ARCH="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE=-O AS_IF([test "$GCC" = yes], [ CFLAGS_WARNING="-Wall" ], [CFLAGS_WARNING=""]) AC_CHECK_TOOL(AR, ar) STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" case $system in AIX-*) AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [ # AIX requires the _r compiler when gcc isn't being used case "${CC}" in *_r|*_r\ *) # ok ... ;; *) # Make sure only first arg gets _r CC=`echo "$CC" | sed -e 's/^\([[^ ]]*\)/\1_r/'` ;; esac AC_MSG_RESULT([Using $CC for compiling with threads]) ]) LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" LD_LIBRARY_PATH_VAR="LIBPATH" # ldAix No longer needed with use of -bexpall/-brtl # but some extensions may still reference it LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ AS_IF([test "$GCC" = yes], [ AC_MSG_WARN([64bit mode not supported with GCC on $system]) ], [ do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS_ARCH="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" ]) ]) AS_IF([test "`uname -m`" = ia64], [ # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" AS_IF([test "$GCC" = yes], [ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' ], [ CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' ]) LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' ], [ AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared -Wl,-bexpall' ], [ SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" LDFLAGS="$LDFLAGS -brtl" ]) SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ]) ;; BeOS*) SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -nostart' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- AC_CHECK_LIB(bind, inet_ntoa, [LIBS="$LIBS -lbind -lsocket"]) ;; BSD/OS-2.1*|BSD/OS-3*) SHLIB_CFLAGS="" SHLIB_LD="shlicc -r" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; BSD/OS-4.*) SHLIB_CFLAGS="-export-dynamic -fPIC" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o tclWinError.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" AC_CACHE_CHECK(for Cygwin version of gcc, ac_cv_cygwin, AC_TRY_COMPILE([ #ifdef __CYGWIN__ #error cygwin #endif ], [], ac_cv_cygwin=no, ac_cv_cygwin=yes) ) if test "$ac_cv_cygwin" = "no"; then AC_MSG_ERROR([${CC} is not a cygwin compiler.]) fi if test "x${TCL_THREADS}" = "x0"; then AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads]) fi do64bit_ok=yes if test "x${SHARED_BUILD}" = "x1"; then echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args" # The eval makes quoting arguments work. if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix then : else { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } fi fi ;; dgux*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" AC_CHECK_LIB(network, inet_ntoa, [LIBS="$LIBS -lnetwork"]) ;; HP-UX-*.11.*) # Use updated header definitions where possible AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Do we want to use the XOPEN network library?]) AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) LIBS="$LIBS -lxnet" # Use the XOPEN network library AS_IF([test "`uname -m`" = ia64], [ SHLIB_SUFFIX=".so" ], [ SHLIB_SUFFIX=".sl" ]) AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) AS_IF([test "$tcl_ok" = yes], [ SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" ]) AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ]) # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = "yes"], [ AS_IF([test "$GCC" = yes], [ case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) AC_MSG_WARN([64bit mode not supported with GCC on $system]) ;; esac ], [ do64bit_ok=yes CFLAGS="$CFLAGS +DD64" LDFLAGS_ARCH="+DD64" ]) ]) ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) AS_IF([test "$tcl_ok" = yes], [ SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS="" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" ]) ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) ;; IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) AS_IF([test "$GCC" = yes], [ CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" ], [ case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" ;; *) CFLAGS="$CFLAGS -n32" ;; esac LDFLAGS="$LDFLAGS -n32" ]) ;; IRIX64-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ AS_IF([test "$GCC" = yes], [ AC_MSG_WARN([64bit mode not supported by gcc]) ], [ do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" ]) ]) ;; Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"]) AS_IF([test $do64bit = yes], [ AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" AC_TRY_LINK(,, tcl_cv_cc_m64=yes, tcl_cv_cc_m64=no) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_m64 = yes], [ CFLAGS="$CFLAGS -m64" do64bit_ok=yes ]) ]) # The combo of gcc + glibc has a bug related to inlining of # functions like strtod(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-02 SHLIB_LD='${CC} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; MP-RAS-*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,-Bexport" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OpenBSD-*) arch=`arch -s` case "$arch" in vax) # Equivalent using configure option --disable-load # Step 4 will set the necessary variables DL_OBJS="" SHLIB_LD_LIBS="" LDFLAGS="" ;; *) case "$arch" in alpha|sparc|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" ;; esac case "$arch" in vax) CFLAGS_OPTIMIZE="-O1" ;; sh) CFLAGS_OPTIMIZE="-O0" ;; *) CFLAGS_OPTIMIZE="-O2" ;; esac AS_IF([test "${TCL_THREADS}" = "1"], [ # On OpenBSD: Compile with -pthread # Don't link with -lpthread LIBS=`echo $LIBS | sed s/-lpthread//` CFLAGS="$CFLAGS -pthread" ]) # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "${TCL_THREADS}" = "1"], [ # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" ]) ;; FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) AS_IF([test "${TCL_THREADS}" = "1"], [ # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) case $system in FreeBSD-3.*) # Version numbers are dot-stripped by system policy. TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' TCL_LIB_VERSIONS_OK=nodots ;; esac ;; Darwin-*) CFLAGS_OPTIMIZE="-Os" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if ([$]i~/^(isysroot|mmacosx-version-min)/) print "-"[$]i}'`" CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!([$]i~/^(isysroot|mmacosx-version-min)/)) print "-"[$]i}'`" AS_IF([test $do64bit = yes], [ case `arch` in ppc) AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag], tcl_cv_cc_arch_ppc64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" AC_TRY_LINK(,, tcl_cv_cc_arch_ppc64=yes, tcl_cv_cc_arch_ppc64=no) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [ CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes ]);; i386) AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag], tcl_cv_cc_arch_x86_64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" AC_TRY_LINK(,, tcl_cv_cc_arch_x86_64=yes, tcl_cv_cc_arch_x86_64=no) CFLAGS=$hold_cflags]) AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [ CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes ]);; *) AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);; esac ], [ # Check for combined 32-bit and 64-bit fat build AS_IF([echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '], [ fat_32_64=yes]) ]) SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" AC_TRY_LINK(, [int i;], tcl_cv_ld_single_module=yes, tcl_cv_ld_single_module=no) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_single_module = yes], [ SHLIB_LD="${SHLIB_LD} -Wl,-single_module" ]) SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" # Don't use -prebind when building for Mac OS X 10.4 or later only: AS_IF([test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int([$]2)}'`" -lt 4 -a \ "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int([$]2)}'`" -lt 4], [ LDFLAGS="$LDFLAGS -prebind"]) LDFLAGS="$LDFLAGS -headerpad_max_install_names" AC_CACHE_CHECK([if ld accepts -search_paths_first flag], tcl_cv_ld_search_paths_first, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" AC_TRY_LINK(, [int i;], tcl_cv_ld_search_paths_first=yes, tcl_cv_ld_search_paths_first=no) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_search_paths_first = yes], [ LDFLAGS="$LDFLAGS -Wl,-search_paths_first" ]) AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [__private_extern__], [Compiler support for module scope symbols]) ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?]) PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' AC_MSG_CHECKING([whether to use CoreFoundation]) AC_ARG_ENABLE(corefoundation, AC_HELP_STRING([--enable-corefoundation], [use CoreFoundation API on MacOSX (default: on)]), [tcl_corefoundation=$enableval], [tcl_corefoundation=yes]) AC_MSG_RESULT([$tcl_corefoundation]) AS_IF([test $tcl_corefoundation = yes], [ AC_CACHE_CHECK([for CoreFoundation.framework], tcl_cv_lib_corefoundation, [ hold_libs=$LIBS AS_IF([test "$fat_32_64" = yes], [ for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit # archs from CFLAGS et al. while testing for # presence of CF. 64-bit CF is disabled in # tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done]) LIBS="$LIBS -framework CoreFoundation" AC_TRY_LINK([#include ], [CFBundleRef b = CFBundleGetMainBundle();], tcl_cv_lib_corefoundation=yes, tcl_cv_lib_corefoundation=no) AS_IF([test "$fat_32_64" = yes], [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) LIBS=$hold_libs]) AS_IF([test $tcl_cv_lib_corefoundation = yes], [ LIBS="$LIBS -framework CoreFoundation" AC_DEFINE(HAVE_COREFOUNDATION, 1, [Do we have access to Darwin CoreFoundation.framework?]) ], [tcl_corefoundation=no]) AS_IF([test "$fat_32_64" = yes -a $tcl_corefoundation = yes],[ AC_CACHE_CHECK([for 64-bit CoreFoundation], tcl_cv_lib_corefoundation_64, [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done AC_TRY_LINK([#include ], [CFBundleRef b = CFBundleGetMainBundle();], tcl_cv_lib_corefoundation_64=yes, tcl_cv_lib_corefoundation_64=no) for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) AS_IF([test $tcl_cv_lib_corefoundation_64 = no], [ AC_DEFINE(NO_COREFOUNDATION_64, 1, [Is Darwin CoreFoundation unavailable for 64-bit?]) LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" ]) ]) ]) ;; NEXTSTEP-*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -nostdlib -r' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadNext.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OS/390-*) SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h [Should OS/390 do the right thing with sockets?]) ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1 SHLIB_CFLAGS="" # Hack: make package name same as library name SHLIB_LD='ld -R -export $@:' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadOSF.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" AS_IF([test "$SHARED_BUILD" = 1], [SHLIB_LD="ld -shared"], [ SHLIB_LD="ld -non_shared" ]) SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" AS_IF([test "$SHARED_BUILD" = 1], [ SHLIB_LD='ld -shared -expect_unresolved "*"' ], [ SHLIB_LD='ld -non_shared -expect_unresolved "*"' ]) SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [ CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"]) # see pthread_intro(3) for pthread support on osf1, k.furukawa AS_IF([test "${TCL_THREADS}" = 1], [ CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` AS_IF([test "$GCC" = yes], [ LIBS="$LIBS -lpthread -lmach -lexc" ], [ CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" ]) ]) ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. AS_IF([test "$GCC" = yes], [ SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" ], [ SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" ]) SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SINIX*5.4*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SunOS-4*) SHLIB_CFLAGS="-PIC" SHLIB_LD="ld" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # SunOS can't handle version numbers with dots in them in library # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it # requires an extra version number at the end of .so file names. # So, the library has to have a name like libtcl75.so.1.0 SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[[0-6]]) # Careful to not let 5.10+ fall into this case # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, [Do we really want to follow the standard? Yes we do!]) SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ], [ SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ]) ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, [Do we really want to follow the standard? Yes we do!]) SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ arch=`isainfo` AS_IF([test "$arch" = "sparcv9 sparc"], [ AS_IF([test "$GCC" = yes], [ AS_IF([test "`${CC} -dumpversion | awk -F. '{print [$]1}'`" -lt 3], [ AC_MSG_WARN([64bit mode not supported with GCC < 3.2 on $system]) ], [ do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" ]) ], [ do64bit_ok=yes AS_IF([test "$do64bitVIS" = yes], [ CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" ], [ CFLAGS="$CFLAGS -xarch=v9" LDFLAGS_ARCH="-xarch=v9" ]) # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" ]) ], [AS_IF([test "$arch" = "amd64 i386"], [ AS_IF([test "$GCC" = yes], [ case $system in SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) do64bit_ok=yes CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) AC_MSG_WARN([64bit mode not supported with GCC on $system]);; esac ], [ do64bit_ok=yes case $system in SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64";; esac ]) ], [AC_MSG_WARN([64bit mode not supported for $arch])])]) ]) #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- AS_IF([test "$GCC" = yes],[use_sunmath=no],[ arch=`isainfo` AC_MSG_CHECKING([whether to use -lsunmath for fp rounding control]) AS_IF([test "$arch" = "amd64 i386"], [ AC_MSG_RESULT([yes]) MATH_LIBS="-lsunmath $MATH_LIBS" AC_CHECK_HEADER(sunmath.h) use_sunmath=yes ], [ AC_MSG_RESULT([no]) use_sunmath=no ]) ]) SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "$do64bit_ok" = yes], [ AS_IF([test "$arch" = "sparcv9 sparc"], [ # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" # for finding sparcv9 libgcc, get the regular libgcc # path, remove so name and append 'sparcv9' #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" ], [AS_IF([test "$arch" = "amd64 i386"], [ SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" ])]) ]) ], [ AS_IF([test "$use_sunmath" = yes], [textmode=textoff],[textmode=text]) case $system in SunOS-5.[[1-9]][[0-9]]*) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' ]) ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" AC_TRY_LINK(, [int i;], tcl_cv_ld_Bexport=yes, tcl_cv_ld_Bexport=no) LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_Bexport = yes], [ LDFLAGS="$LDFLAGS -Wl,-Bexport" ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac AS_IF([test "$do64bit" = yes -a "$do64bit_ok" = no], [ AC_MSG_WARN([64bit support being disabled -- don't know magic for this platform]) ]) AS_IF([test "$do64bit" = yes -a "$do64bit_ok" = yes], [ AC_DEFINE(TCL_CFG_DO64BIT, 1, [Is this a 64-bit build?]) ]) dnl # Add any CPPFLAGS set in the environment to our CFLAGS, but delay doing so dnl # until the end of configure, as configure's compile and link tests use dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's dnl # preprocessing tests use only CPPFLAGS. AC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""]) # Step 4: disable dynamic loading if requested via a command-line switch. AC_ARG_ENABLE(load, AC_HELP_STRING([--enable-load], [allow dynamic loading and "load" command (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) AS_IF([test "$tcl_ok" = no], [DL_OBJS=""]) AS_IF([test "x$DL_OBJS" != x], [BUILD_DLTEST="\$(DLTEST_TARGETS)"], [ AC_MSG_WARN([Can't figure out how to do dynamic loading or shared libraries on this system.]) SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" DL_OBJS="tclLoadNone.o" DL_LIBS="" LDFLAGS="$LDFLAGS_ORIG" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" ]) LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [ case $system in AIX-*) ;; BSD/OS*) ;; CYGWIN_*|MINGW32_*) ;; IRIX*) ;; NetBSD-*|FreeBSD-*|OpenBSD-*) ;; Darwin-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac]) AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [ SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}']) AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ UNSHARED_LIB_SUFFIX='${VERSION}.a']) DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [ LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" ], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ]) ], [ LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} AS_IF([test "$RANLIB" = ""], [ MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ], [ MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' ]) ]) # Stub lib does not depend on shared/static configuration AS_IF([test "$RANLIB" = ""], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}' INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' ], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@' INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))' ]) # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. AS_IF([test "x${TCL_LIBS}" = x], [ TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"]) AC_SUBST(TCL_LIBS) # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. AC_CACHE_CHECK(for cast to union support, tcl_cv_cast_to_union, AC_TRY_COMPILE([], [ union foo { int i; double d; }; union foo f = (union foo) (int) 0; ], tcl_cv_cast_to_union=yes, tcl_cv_cast_to_union=no) ) if test "$tcl_cv_cast_to_union" = "yes"; then AC_DEFINE(HAVE_CAST_TO_UNION, 1, [Defined when compiler supports casting to union type.]) fi # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. AC_SUBST(DL_LIBS) AC_SUBST(DL_OBJS) AC_SUBST(PLAT_OBJS) AC_SUBST(PLAT_SRCS) AC_SUBST(LDAIX_SRC) AC_SUBST(CFLAGS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(LDFLAGS) AC_SUBST(LDFLAGS_DEBUG) AC_SUBST(LDFLAGS_OPTIMIZE) AC_SUBST(CC_SEARCH_FLAGS) AC_SUBST(LD_SEARCH_FLAGS) AC_SUBST(STLIB_LD) AC_SUBST(SHLIB_LD) AC_SUBST(TCL_SHLIB_LD_EXTRAS) AC_SUBST(TK_SHLIB_LD_EXTRAS) AC_SUBST(SHLIB_LD_LIBS) AC_SUBST(SHLIB_CFLAGS) AC_SUBST(SHLIB_SUFFIX) AC_DEFINE_UNQUOTED(TCL_SHLIB_EXT,"${SHLIB_SUFFIX}", [What is the default extension for shared libraries?]) AC_SUBST(MAKE_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(INSTALL_LIB) AC_SUBST(DLL_INSTALL_DIR) AC_SUBST(INSTALL_STUB_LIB) AC_SUBST(RANLIB) ]) #-------------------------------------------------------------------- # SC_SERIAL_PORT # # Determine which interface to use to talk to the serial port. # Note that #include lines must begin in leftmost column for # some compilers to recognize them as preprocessor directives, # and some build environments have stdin not pointing at a # pseudo-terminal (usually /dev/null instead.) # # Arguments: # none # # Results: # # Defines only one of the following vars: # HAVE_SYS_MODEM_H # USE_TERMIOS # USE_TERMIO # USE_SGTTY # #-------------------------------------------------------------------- AC_DEFUN([SC_SERIAL_PORT], [ AC_CHECK_HEADERS(sys/modem.h) AC_CACHE_CHECK([termios vs. termio vs. sgtty], tcl_cv_api_serial, [ AC_TRY_RUN([ #include int main() { struct termios t; if (tcgetattr(0, &t) == 0) { cfsetospeed(&t, 0); t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; return 0; } return 1; }], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) if test $tcl_cv_api_serial = no ; then AC_TRY_RUN([ #include int main() { struct termio t; if (ioctl(0, TCGETA, &t) == 0) { t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; return 0; } return 1; }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) fi if test $tcl_cv_api_serial = no ; then AC_TRY_RUN([ #include int main() { struct sgttyb t; if (ioctl(0, TIOCGETP, &t) == 0) { t.sg_ospeed = 0; t.sg_flags |= ODDP | EVENP | RAW; return 0; } return 1; }], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=no, tcl_cv_api_serial=no) fi if test $tcl_cv_api_serial = no ; then AC_TRY_RUN([ #include #include int main() { struct termios t; if (tcgetattr(0, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { cfsetospeed(&t, 0); t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; return 0; } return 1; }], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) fi if test $tcl_cv_api_serial = no; then AC_TRY_RUN([ #include #include int main() { struct termio t; if (ioctl(0, TCGETA, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; return 0; } return 1; }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) fi if test $tcl_cv_api_serial = no; then AC_TRY_RUN([ #include #include int main() { struct sgttyb t; if (ioctl(0, TIOCGETP, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { t.sg_ospeed = 0; t.sg_flags |= ODDP | EVENP | RAW; return 0; } return 1; }], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) fi]) case $tcl_cv_api_serial in termios) AC_DEFINE(USE_TERMIOS, 1, [Use the termios API for serial lines]);; termio) AC_DEFINE(USE_TERMIO, 1, [Use the termio API for serial lines]);; sgtty) AC_DEFINE(USE_SGTTY, 1, [Use the sgtty API for serial lines]);; esac ]) #-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special # notes: # - stdlib.h doesn't define strtol, strtoul, or # strtod insome versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # # Arguments: # none # # Results: # # Defines some of the following vars: # NO_DIRENT_H # NO_VALUES_H # HAVE_LIMITS_H or NO_LIMITS_H # NO_STDLIB_H # NO_STRING_H # NO_SYS_WAIT_H # NO_DLFCN_H # HAVE_SYS_PARAM_H # # HAVE_STRING_H ? # #-------------------------------------------------------------------- AC_DEFUN([SC_MISSING_POSIX_HEADERS], [ AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [ AC_TRY_LINK([#include #include ], [ #ifndef _POSIX_SOURCE # ifdef __Lynx__ /* * Generate compilation error to make the test fail: Lynx headers * are only valid if really in the POSIX environment. */ missing_procedure(); # endif #endif DIR *d; struct dirent *entryPtr; char *p; d = opendir("foobar"); entryPtr = readdir(d); p = entryPtr->d_name; closedir(d); ], tcl_cv_dirent_h=yes, tcl_cv_dirent_h=no)]) if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H, 1, [Do we have ?]) fi AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have ?])]) AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have ?])]) AC_CHECK_HEADER(limits.h, [AC_DEFINE(HAVE_LIMITS_H, 1, [Do we have ?])], [AC_DEFINE(NO_LIMITS_H, 1, [Do we have ?])]) AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0) if test $tcl_ok = 0; then AC_DEFINE(NO_STDLIB_H, 1, [Do we have ?]) fi AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0) AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0) # See also memmove check below for a place where NO_STRING_H can be # set and why. if test $tcl_ok = 0; then AC_DEFINE(NO_STRING_H, 1, [Do we have ?]) fi AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H, 1, [Do we have ?])]) AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H, 1, [Do we have ?])]) # OS/390 lacks sys/param.h (and doesn't need it, by chance). AC_HAVE_HEADERS(sys/param.h) ]) #-------------------------------------------------------------------- # SC_PATH_X # # Locate the X11 header files and the X11 library archive. Try # the ac_path_x macro first, but if it doesn't find the X stuff # (e.g. because there's no xmkmf program) then check through # a list of possible directories. Under some conditions the # autoconf macro will return an include directory that contains # no include files, so double-check its result just to be safe. # # Arguments: # none # # Results: # # Sets the following vars: # XINCLUDES # XLIBSW # #-------------------------------------------------------------------- AC_DEFUN([SC_PATH_X], [ AC_PATH_X not_really_there="" if test "$no_x" = ""; then if test "$x_includes" = ""; then AC_TRY_CPP([#include ], , not_really_there="yes") else if test ! -r $x_includes/X11/Xlib.h; then not_really_there="yes" fi fi fi if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then AC_MSG_CHECKING([for X11 header files]) found_xincludes="no" AC_TRY_CPP([#include ], found_xincludes="yes", found_xincludes="no") if test "$found_xincludes" = "no"; then dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" for i in $dirs ; do if test -r $i/X11/Xlib.h; then AC_MSG_RESULT([$i]) XINCLUDES=" -I$i" found_xincludes="yes" break fi done fi else if test "$x_includes" != ""; then XINCLUDES="-I$x_includes" found_xincludes="yes" fi fi if test "$found_xincludes" = "no"; then AC_MSG_RESULT([couldn't find any!]) fi if test "$no_x" = yes; then AC_MSG_CHECKING([for X11 libraries]) 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 if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl -o -r $i/libX11.dylib; then AC_MSG_RESULT([$i]) XLIBSW="-L$i -lX11" x_libraries="$i" break fi done else if test "$x_libraries" = ""; then XLIBSW=-lX11 else XLIBSW="-L$x_libraries -lX11" fi fi if test "$XLIBSW" = nope ; then AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow) fi if test "$XLIBSW" = nope ; then AC_MSG_RESULT([could not find any! Using -lX11.]) XLIBSW=-lX11 fi ]) #-------------------------------------------------------------------- # SC_BLOCKING_STYLE # # The statements below check for systems where POSIX-style # non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. # On these systems (mostly older ones), use the old BSD-style # FIONBIO approach instead. # # Arguments: # none # # Results: # # Defines some of the following vars: # HAVE_SYS_IOCTL_H # HAVE_SYS_FILIO_H # USE_FIONBIO # O_NONBLOCK # #-------------------------------------------------------------------- AC_DEFUN([SC_BLOCKING_STYLE], [ AC_CHECK_HEADERS(sys/ioctl.h) AC_CHECK_HEADERS(sys/filio.h) SC_CONFIG_SYSTEM AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) case $system in # There used to be code here to use FIONBIO under AIX. However, it # was reported that FIONBIO doesn't work under AIX 3.2.5. Since # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO # code (JO, 5/31/97). OSF*) AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?]) AC_MSG_RESULT([FIONBIO]) ;; SunOS-4*) AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?]) AC_MSG_RESULT([FIONBIO]) ;; *) AC_MSG_RESULT([O_NONBLOCK]) ;; esac ]) #-------------------------------------------------------------------- # SC_TIME_HANLDER # # Checks how the system deals with time.h, what time structures # are used on the system, and what fields the structures have. # # Arguments: # none # # Results: # # Defines some of the following vars: # USE_DELTA_FOR_TZ # HAVE_TM_GMTOFF # HAVE_TM_TZADJ # HAVE_TIMEZONE_VAR # #-------------------------------------------------------------------- AC_DEFUN([SC_TIME_HANDLER], [ AC_CHECK_HEADERS(sys/time.h) AC_HEADER_TIME AC_CHECK_FUNCS(gmtime_r localtime_r mktime) AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [ AC_TRY_COMPILE([#include ], [struct tm tm; tm.tm_tzadj;], tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)]) if test $tcl_cv_member_tm_tzadj = yes ; then AC_DEFINE(HAVE_TM_TZADJ, 1, [Should we use the tm_tzadj field of struct tm?]) fi AC_CACHE_CHECK([tm_gmtoff in struct tm], tcl_cv_member_tm_gmtoff, [ AC_TRY_COMPILE([#include ], [struct tm tm; tm.tm_gmtoff;], tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)]) if test $tcl_cv_member_tm_gmtoff = yes ; then AC_DEFINE(HAVE_TM_GMTOFF, 1, [Should we use the tm_gmtoff field of struct tm?]) fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [ AC_TRY_COMPILE([#include ], [extern long timezone; timezone += 1; exit (0);], tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no)]) if test $tcl_cv_timezone_long = yes ; then AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) else # # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. # AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [ AC_TRY_COMPILE([#include ], [extern time_t timezone; timezone += 1; exit (0);], tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)]) if test $tcl_cv_timezone_time = yes ; then AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) fi fi ]) #-------------------------------------------------------------------- # SC_BUGGY_STRTOD # # Under Solaris 2.4, strtod returns the wrong value for the # terminating character under some conditions. Check for this # and if the problem exists use a substitute procedure # "fixstrtod" (provided by Tcl) that corrects the error. # Also, on Compaq's Tru64 Unix 5.0, # strtod(" ") returns 0.0 instead of a failure to convert. # # Arguments: # none # # Results: # # Might defines some of the following vars: # strtod (=fixstrtod) # #-------------------------------------------------------------------- AC_DEFUN([SC_BUGGY_STRTOD], [ AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) if test "$tcl_strtod" = 1; then AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[ AC_TRY_RUN([ extern double strtod(); int main() { char *infString="Inf", *nanString="NaN", *spaceString=" "; char *term; double value; value = strtod(infString, &term); if ((term != infString) && (term[-1] == 0)) { exit(1); } value = strtod(nanString, &term); if ((term != nanString) && (term[-1] == 0)) { exit(1); } value = strtod(spaceString, &term); if (term == (spaceString+1)) { exit(1); } exit(0); }], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy, tcl_cv_strtod_buggy=buggy)]) if test "$tcl_cv_strtod_buggy" = buggy; then AC_LIBOBJ([fixstrtod]) USE_COMPAT=1 AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?]) fi fi ]) #-------------------------------------------------------------------- # SC_TCL_LINK_LIBS # # Search for the libraries needed to link the Tcl shell. # Things like the math library (-lm) and socket stuff (-lsocket vs. # -lnsl) are dealt with here. # # Arguments: # None. # # Results: # # Might append to the following vars: # LIBS # MATH_LIBS # # Might define the following vars: # HAVE_NET_ERRNO_H # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_LINK_LIBS], [ #-------------------------------------------------------------------- # On a few very rare systems, all of the libm.a stuff is # already in libc.a. Set compiler flags accordingly. # Also, Linux requires the "ieee" library for math to work # right (and it must appear before "-lm"). #-------------------------------------------------------------------- AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm") AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"]) #-------------------------------------------------------------------- # Interactive UNIX requires -linet instead of -lsocket, plus it # needs net/errno.h to define the socket-related error codes. #-------------------------------------------------------------------- AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"]) AC_CHECK_HEADER(net/errno.h, [ AC_DEFINE(HAVE_NET_ERRNO_H, 1, [Do we have ?])]) #-------------------------------------------------------------------- # Check for the existence of the -lsocket and -lnsl libraries. # The order here is important, so that they end up in the right # order in the command line generated by make. Here are some # special considerations: # 1. Use "connect" and "accept" to check for -lsocket, and # "gethostbyname" to check for -lnsl. # 2. Use each function name only once: can't redo a check because # autoconf caches the results of the last check and won't redo it. # 3. Use -lnsl and -lsocket only if they supply procedures that # aren't already present in the normal libraries. This is because # IRIX 5.2 has libraries, but they aren't needed and they're # bogus: they goof up name resolution if used. # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- tcl_checkBoth=0 AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1) if test "$tcl_checkSocket" = 1; then AC_CHECK_FUNC(setsockopt, , [AC_CHECK_LIB(socket, setsockopt, LIBS="$LIBS -lsocket", tcl_checkBoth=1)]) fi if test "$tcl_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs]) fi AC_CHECK_FUNC(gethostbyname, , [AC_CHECK_LIB(nsl, gethostbyname, [LIBS="$LIBS -lnsl"])]) ]) #-------------------------------------------------------------------- # SC_TCL_EARLY_FLAGS # # Check for what flags are needed to be passed so the correct OS # features are available. # # Arguments: # None # # Results: # # Might define the following vars: # _ISOC99_SOURCE # _LARGEFILE64_SOURCE # _LARGEFILE_SOURCE64 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_EARLY_FLAG],[ AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no, AC_TRY_COMPILE([[#define ]$1[ 1 ]$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no))) if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then AC_DEFINE($1, 1, [Add the ]$1[ flag when building]) tcl_flags="$tcl_flags $1" fi ]) AC_DEFUN([SC_TCL_EARLY_FLAGS],[ AC_MSG_CHECKING([for required early compiler flags]) tcl_flags="" SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include ], [char *p = (char *)strtoll; char *q = (char *)strtoull;]) SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include ], [struct stat64 buf; int i = stat64("/", &buf);]) SC_TCL_EARLY_FLAG(_LARGEFILE_SOURCE64,[#include ], [char *p = (char *)open64;]) if test "x${tcl_flags}" = "x" ; then AC_MSG_RESULT([none]) else AC_MSG_RESULT([${tcl_flags}]) fi ]) #-------------------------------------------------------------------- # SC_TCL_64BIT_FLAGS # # Check for what is defined in the way of 64-bit features. # # Arguments: # None # # Results: # # Might define the following vars: # TCL_WIDE_INT_IS_LONG # TCL_WIDE_INT_TYPE # HAVE_STRUCT_DIRENT64 # HAVE_STRUCT_STAT64 # HAVE_TYPE_OFF64_T # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_64BIT_FLAGS], [ AC_MSG_CHECKING([for 64-bit integer type]) AC_CACHE_VAL(tcl_cv_type_64bit,[ tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 AC_TRY_COMPILE(,[__int64 value = (__int64) 0;], tcl_type_64bit=__int64, tcl_type_64bit="long long") # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... AC_TRY_COMPILE(,[switch (0) { case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ; }],tcl_cv_type_64bit=${tcl_type_64bit})]) if test "${tcl_cv_type_64bit}" = none ; then AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?]) AC_MSG_RESULT([using long]) else AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit}, [What type should be used to define wide integers?]) AC_MSG_RESULT([${tcl_cv_type_64bit}]) # Now check for auxiliary declarations AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ AC_TRY_COMPILE([#include #include ],[struct dirent64 p;], tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)]) if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in ?]) fi AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ AC_TRY_COMPILE([#include ],[struct stat64 p; ], tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)]) if test "x${tcl_cv_struct_stat64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in ?]) fi AC_CHECK_FUNCS(open64 lseek64) AC_MSG_CHECKING([for off64_t]) AC_CACHE_VAL(tcl_cv_type_off64_t,[ AC_TRY_COMPILE([#include ],[off64_t offset; ], tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)]) dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the dnl functions lseek64 and open64 are defined. if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then AC_DEFINE(HAVE_TYPE_OFF64_T, 1, [Is off64_t in ?]) AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) fi fi ]) #-------------------------------------------------------------------- # SC_TCL_CFG_ENCODING TIP #59 # # Declare the encoding to use for embedded configuration information. # # Arguments: # None. # # Results: # Might append to the following vars: # DEFS (implicit) # # Will define the following vars: # TCL_CFGVAL_ENCODING # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ AC_ARG_WITH(encoding, AC_HELP_STRING([--with-encoding], [encoding for configuration values (default: iso8859-1)]), with_tcencoding=${withval}) if test x"${with_tcencoding}" != x ; then AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}", [What encoding should be used for embedded configuration info?]) else AC_DEFINE(TCL_CFGVAL_ENCODING,"iso8859-1", [What encoding should be used for embedded configuration info?]) fi ]) #-------------------------------------------------------------------- # SC_TCL_CHECK_BROKEN_FUNC # # Check for broken function. # # Arguments: # funcName - function to test for # advancedTest - the advanced test to run if the function is present # # Results: # Might cause compatability versions of the function to be used. # Might affect the following vars: # USE_COMPAT (implicit) # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[ AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0) if test ["$tcl_ok"] = 1; then AC_CACHE_CHECK([proper ]$1[ implementation], [tcl_cv_]$1[_unbroken], AC_TRY_RUN([[int main() {]$2[}]],[tcl_cv_]$1[_unbroken]=ok, [tcl_cv_]$1[_unbroken]=broken,[tcl_cv_]$1[_unbroken]=unknown)) if test ["$tcl_cv_]$1[_unbroken"] = "ok"; then tcl_ok=1 else tcl_ok=0 fi fi if test ["$tcl_ok"] = 0; then AC_LIBOBJ($1) USE_COMPAT=1 fi ]) #-------------------------------------------------------------------- # SC_TCL_GETHOSTBYADDR_R # # Check if we have MT-safe variant of gethostbyaddr(). # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETHOSTBYADDR_R # HAVE_GETHOSTBYADDR_R_7 # HAVE_GETHOSTBYADDR_R_8 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETHOSTBYADDR_R], [AC_CHECK_FUNC(gethostbyaddr_r, [ AC_CACHE_CHECK([for gethostbyaddr_r with 7 args], tcl_cv_api_gethostbyaddr_r_7, [ AC_TRY_COMPILE([ #include ], [ char *addr; int length; int type; struct hostent *result; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &h_errnop); ], tcl_cv_api_gethostbyaddr_r_7=yes, tcl_cv_api_gethostbyaddr_r_7=no)]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_7, 1, [Define to 1 if gethostbyaddr_r takes 7 args.]) else AC_CACHE_CHECK([for gethostbyaddr_r with 8 args], tcl_cv_api_gethostbyaddr_r_8, [ AC_TRY_COMPILE([ #include ], [ char *addr; int length; int type; struct hostent *result, *resultp; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &resultp, &h_errnop); ], tcl_cv_api_gethostbyaddr_r_8=yes, tcl_cv_api_gethostbyaddr_r_8=no)]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_8, 1, [Define to 1 if gethostbyaddr_r takes 8 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R, 1, [Define to 1 if gethostbyaddr_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETHOSTBYNAME_R # # Check to see what variant of gethostbyname_r() we have. # Based on David Arnold's example from the comp.programming.threads # FAQ Q213 # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETHOSTBYADDR_R # HAVE_GETHOSTBYADDR_R_3 # HAVE_GETHOSTBYADDR_R_5 # HAVE_GETHOSTBYADDR_R_6 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETHOSTBYNAME_R], [AC_CHECK_FUNC(gethostbyname_r, [ AC_CACHE_CHECK([for gethostbyname_r with 6 args], tcl_cv_api_gethostbyname_r_6, [ AC_TRY_COMPILE([ #include ], [ char *name; struct hostent *he, *res; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); ], tcl_cv_api_gethostbyname_r_6=yes, tcl_cv_api_gethostbyname_r_6=no)]) tcl_ok=$tcl_cv_api_gethostbyname_r_6 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_6, 1, [Define to 1 if gethostbyname_r takes 6 args.]) else AC_CACHE_CHECK([for gethostbyname_r with 5 args], tcl_cv_api_gethostbyname_r_5, [ AC_TRY_COMPILE([ #include ], [ char *name; struct hostent *he; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ], tcl_cv_api_gethostbyname_r_5=yes, tcl_cv_api_gethostbyname_r_5=no)]) tcl_ok=$tcl_cv_api_gethostbyname_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_5, 1, [Define to 1 if gethostbyname_r takes 5 args.]) else AC_CACHE_CHECK([for gethostbyname_r with 3 args], tcl_cv_api_gethostbyname_r_3, [ AC_TRY_COMPILE([ #include ], [ char *name; struct hostent *he; struct hostent_data data; (void) gethostbyname_r(name, he, &data); ], tcl_cv_api_gethostbyname_r_3=yes, tcl_cv_api_gethostbyname_r_3=no)]) tcl_ok=$tcl_cv_api_gethostbyname_r_3 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_3, 1, [Define to 1 if gethostbyname_r takes 3 args.]) fi fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R, 1, [Define to 1 if gethostbyname_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETADDRINFO # # Check if we have 'getaddrinfo' # # Arguments: # None # # Results: # Might define the following vars: # HAVE_GETADDRINFO # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETADDRINFO], [AC_CHECK_FUNC(getaddrinfo, [ AC_CACHE_CHECK([for working getaddrinfo], tcl_cv_api_getaddrinfo, [ AC_TRY_COMPILE([ #include ], [ const char *name, *port; struct addrinfo *aiPtr, hints; (void)getaddrinfo(name,port, &hints, &aiPtr); (void)freeaddrinfo(aiPtr); ], tcl_cv_api_getaddrinfo=yes, tcl_cv_getaddrinfo=no)]) tcl_ok=$tcl_cv_api_getaddrinfo if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETADDRINFO, 1, [Define to 1 if getaddrinfo is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETPWUID_R # # Check if we have MT-safe variant of getpwuid() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETPWUID_R # HAVE_GETPWUID_R_4 # HAVE_GETPWUID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWUID_R], [AC_CHECK_FUNC(getpwuid_r, [ AC_CACHE_CHECK([for getpwuid_r with 5 args], tcl_cv_api_getpwuid_r_5, [ AC_TRY_COMPILE([ #include #include ], [ uid_t uid; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ], tcl_cv_api_getpwuid_r_5=yes, tcl_cv_api_getpwuid_r_5=no)]) tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_5, 1, [Define to 1 if getpwuid_r takes 5 args.]) else AC_CACHE_CHECK([for getpwuid_r with 4 args], tcl_cv_api_getpwuid_r_4, [ AC_TRY_COMPILE([ #include #include ], [ uid_t uid; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(uid, &pw, buf, buflen); ], tcl_cv_api_getpwuid_r_4=yes, tcl_cv_api_getpwuid_r_4=no)]) tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_4, 1, [Define to 1 if getpwuid_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R, 1, [Define to 1 if getpwuid_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETPWNAM_R # # Check if we have MT-safe variant of getpwnam() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETPWNAM_R # HAVE_GETPWNAM_R_4 # HAVE_GETPWNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWNAM_R], [AC_CHECK_FUNC(getpwnam_r, [ AC_CACHE_CHECK([for getpwnam_r with 5 args], tcl_cv_api_getpwnam_r_5, [ AC_TRY_COMPILE([ #include #include ], [ char *name; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwnam_r(name, &pw, buf, buflen, &pwp); ], tcl_cv_api_getpwnam_r_5=yes, tcl_cv_api_getpwnam_r_5=no)]) tcl_ok=$tcl_cv_api_getpwnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_5, 1, [Define to 1 if getpwnam_r takes 5 args.]) else AC_CACHE_CHECK([for getpwnam_r with 4 args], tcl_cv_api_getpwnam_r_4, [ AC_TRY_COMPILE([ #include #include ], [ char *name; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(name, &pw, buf, buflen); ], tcl_cv_api_getpwnam_r_4=yes, tcl_cv_api_getpwnam_r_4=no)]) tcl_ok=$tcl_cv_api_getpwnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_4, 1, [Define to 1 if getpwnam_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R, 1, [Define to 1 if getpwnam_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETGRGID_R # # Check if we have MT-safe variant of getgrgid() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETGRGID_R # HAVE_GETGRGID_R_4 # HAVE_GETGRGID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRGID_R], [AC_CHECK_FUNC(getgrgid_r, [ AC_CACHE_CHECK([for getgrgid_r with 5 args], tcl_cv_api_getgrgid_r_5, [ AC_TRY_COMPILE([ #include #include ], [ gid_t gid; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrgid_r(gid, &gr, buf, buflen, &grp); ], tcl_cv_api_getgrgid_r_5=yes, tcl_cv_api_getgrgid_r_5=no)]) tcl_ok=$tcl_cv_api_getgrgid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_5, 1, [Define to 1 if getgrgid_r takes 5 args.]) else AC_CACHE_CHECK([for getgrgid_r with 4 args], tcl_cv_api_getgrgid_r_4, [ AC_TRY_COMPILE([ #include #include ], [ gid_t gid; struct group gr; char buf[512]; int buflen = 512; (void)getgrgid_r(gid, &gr, buf, buflen); ], tcl_cv_api_getgrgid_r_4=yes, tcl_cv_api_getgrgid_r_4=no)]) tcl_ok=$tcl_cv_api_getgrgid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_4, 1, [Define to 1 if getgrgid_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R, 1, [Define to 1 if getgrgid_r is available.]) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETGRNAM_R # # Check if we have MT-safe variant of getgrnam() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETGRNAM_R # HAVE_GETGRNAM_R_4 # HAVE_GETGRNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [ AC_CACHE_CHECK([for getgrnam_r with 5 args], tcl_cv_api_getgrnam_r_5, [ AC_TRY_COMPILE([ #include #include ], [ char *name; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrnam_r(name, &gr, buf, buflen, &grp); ], tcl_cv_api_getgrnam_r_5=yes, tcl_cv_api_getgrnam_r_5=no)]) tcl_ok=$tcl_cv_api_getgrnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_5, 1, [Define to 1 if getgrnam_r takes 5 args.]) else AC_CACHE_CHECK([for getgrnam_r with 4 args], tcl_cv_api_getgrnam_r_4, [ AC_TRY_COMPILE([ #include #include ], [ char *name; struct group gr; char buf[512]; int buflen = 512; (void)getgrnam_r(name, &gr, buf, buflen); ], tcl_cv_api_getgrnam_r_4=yes, tcl_cv_api_getgrnam_r_4=no)]) tcl_ok=$tcl_cv_api_getgrnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_4, 1, [Define to 1 if getgrnam_r takes 4 args.]) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R, 1, [Define to 1 if getgrnam_r is available.]) fi ])]) # Local Variables: # mode: autoconf # End: tk8.5.19/unix/tkConfig.sh.in0000644003604700454610000000634112656405252014255 0ustar dgp771div# tkConfig.sh -- # # This shell script (for sh) is generated automatically by Tk's # configure script. It will create shell variables for most of # the configuration options discovered by the configure script. # This script is intended to be included by the configure scripts # for Tk extensions so that they don't have to figure this all # out for themselves. This file does not duplicate information # already provided by tclConfig.sh, so you may need to use that # file in addition to this one. # # The information in this file is specific to a single platform. # Tk's version number. TK_VERSION='@TK_VERSION@' TK_MAJOR_VERSION='@TK_MAJOR_VERSION@' TK_MINOR_VERSION='@TK_MINOR_VERSION@' TK_PATCH_LEVEL='@TK_PATCH_LEVEL@' # -D flags for use with the C compiler. TK_DEFS='@DEFS@' # Flag, 1: we built a shared lib, 0 we didn't TK_SHARED_BUILD=@TK_SHARED_BUILD@ # TK_DBGX used to be used to distinguish debug vs. non-debug builds. # This was a righteous pain so the core doesn't do that any more. TK_DBGX= # The name of the Tk library (may be either a .a file or a shared library): TK_LIB_FILE='@TK_LIB_FILE@' # Additional libraries to use when linking Tk. TK_LIBS='@XLIBSW@ @XFT_LIBS@ @LIBS@ @TCL_LIBS@' # Top-level directory in which Tk's platform-independent files are # installed. TK_PREFIX='@prefix@' # Top-level directory in which Tk's platform-specific files (e.g. # executables) are installed. TK_EXEC_PREFIX='@exec_prefix@' # -I switch(es) to use to make all of the X11 include files accessible: TK_XINCLUDES='@XINCLUDES@' # Linker switch(es) to use to link with the X11 library archive. TK_XLIBSW='@XLIBSW@' # -l flag to pass to the linker to pick up the Tk library TK_LIB_FLAG='@TK_LIB_FLAG@' # String to pass to linker to pick up the Tk library from its # build directory. TK_BUILD_LIB_SPEC='@TK_BUILD_LIB_SPEC@' # String to pass to linker to pick up the Tk library from its # installed directory. TK_LIB_SPEC='@TK_LIB_SPEC@' # String to pass to the compiler so that an extension can # find installed Tk headers. TK_INCLUDE_SPEC='@TK_INCLUDE_SPEC@' # Location of the top-level source directory from which Tk was built. # This is the directory that contains a README file as well as # subdirectories such as generic, unix, etc. If Tk was compiled in a # different place than the directory containing the source files, this # points to the location of the sources, not the location where Tk was # compiled. TK_SRC_DIR='@TK_SRC_DIR@' # Needed if you want to make a 'fat' shared library library # containing tk objects or link a different wish. TK_CC_SEARCH_FLAGS='@CC_SEARCH_FLAGS@' TK_LD_SEARCH_FLAGS='@LD_SEARCH_FLAGS@' # The name of the Tk stub library (.a): TK_STUB_LIB_FILE='@TK_STUB_LIB_FILE@' # -l flag to pass to the linker to pick up the Tk stub library TK_STUB_LIB_FLAG='@TK_STUB_LIB_FLAG@' # String to pass to linker to pick up the Tk stub library from its # build directory. TK_BUILD_STUB_LIB_SPEC='@TK_BUILD_STUB_LIB_SPEC@' # String to pass to linker to pick up the Tk stub library from its # installed directory. TK_STUB_LIB_SPEC='@TK_STUB_LIB_SPEC@' # Path to the Tk stub library in the build directory. TK_BUILD_STUB_LIB_PATH='@TK_BUILD_STUB_LIB_PATH@' # Path to the Tk stub library in the install directory. TK_STUB_LIB_PATH='@TK_STUB_LIB_PATH@' tk8.5.19/unix/tkUnixWm.c0000644003604700454610000065112112612445655013507 0ustar dgp771div/* * tkUnixWm.c -- * * This module takes care of the interactions between a Tk-based * application and the window manager. Among other things, it implements * the "wm" command and passes geometry information to the window * manager. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" /* * A data structure of the following type holds information for each window * manager protocol (such as WM_DELETE_WINDOW) for which a handler (i.e. a Tcl * command) has been defined for a particular top-level window. */ typedef struct ProtocolHandler { Atom protocol; /* Identifies the protocol. */ struct ProtocolHandler *nextPtr; /* Next in list of protocol handlers for the * same top-level window, or NULL for end of * list. */ Tcl_Interp *interp; /* Interpreter in which to invoke command. */ char command[4]; /* Tcl command to invoke when a client message * for this protocol arrives. The actual size * of the structure varies to accommodate the * needs of the actual command. THIS MUST BE * THE LAST FIELD OF THE STRUCTURE. */ } ProtocolHandler; #define HANDLER_SIZE(cmdLength) \ ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength)) /* * Data for [wm attributes] command: */ typedef struct { double alpha; /* Transparency; 0.0=transparent, 1.0=opaque */ int topmost; /* Flag: true=>stay-on-top */ int zoomed; /* Flag: true=>maximized */ int fullscreen; /* Flag: true=>fullscreen */ } WmAttributes; typedef enum { WMATT_ALPHA, WMATT_TOPMOST, WMATT_ZOOMED, WMATT_FULLSCREEN, WMATT_TYPE, _WMATT_LAST_ATTRIBUTE } WmAttribute; static const char *WmAttributeNames[] = { "-alpha", "-topmost", "-zoomed", "-fullscreen", "-type", NULL }; /* * A data structure of the following type holds window-manager-related * information for each top-level window in an application. */ typedef struct TkWmInfo { TkWindow *winPtr; /* Pointer to main Tk information for this * window. */ Window reparent; /* If the window has been reparented, this * gives the ID of the ancestor of the window * that is a child of the root window (may not * be window's immediate parent). If the * window isn't reparented, this has the value * None. */ char *title; /* Title to display in window caption. If * NULL, use name of widget. Malloced. */ char *iconName; /* Name to display in icon. Malloced. */ XWMHints hints; /* Various pieces of information for window * manager. */ char *leaderName; /* Path name of leader of window group * (corresponds to hints.window_group). * Malloc-ed. Note: this field doesn't get * updated if leader is destroyed. */ TkWindow *masterPtr; /* Master window for TRANSIENT_FOR property, * or NULL. */ Tk_Window icon; /* Window to use as icon for this window, or * NULL. */ Tk_Window iconFor; /* Window for which this window is icon, or * NULL if this isn't an icon for anyone. */ int withdrawn; /* Non-zero means window has been withdrawn. */ /* * In order to support menubars transparently under X, each toplevel * window is encased in an additional window, called the wrapper, that * holds the toplevel and the menubar, if any. The information below is * used to keep track of the wrapper and the menubar. */ TkWindow *wrapperPtr; /* Pointer to information about the wrapper. * This is the "real" toplevel window as seen * by the window manager. Although this is an * official Tk window, it doesn't appear in * the application's window hierarchy. NULL * means that the wrapper hasn't been created * yet. */ Tk_Window menubar; /* Pointer to information about the menubar, * or NULL if there is no menubar for this * toplevel. */ int menuHeight; /* Amount of vertical space needed for * menubar, measured in pixels. If menubar is * non-NULL, this is >= 1 (X servers don't * like dimensions of 0). */ /* * Information used to construct an XSizeHints structure for the window * manager: */ int sizeHintsFlags; /* Flags word for XSizeHints structure. If the * PBaseSize flag is set then the window is * gridded; otherwise it isn't gridded. */ int minWidth, minHeight; /* Minimum dimensions of window, in pixels or * grid units. */ int maxWidth, maxHeight; /* Maximum dimensions of window, in pixels or * grid units. 0 to default.*/ Tk_Window gridWin; /* Identifies the window that controls * gridding for this top-level, or NULL if the * top-level isn't currently gridded. */ int widthInc, heightInc; /* Increments for size changes (# pixels per * step). */ struct { int x; /* numerator */ int y; /* denominator */ } minAspect, maxAspect; /* Min/max aspect ratios for window. */ int reqGridWidth, reqGridHeight; /* The dimensions of the window (in grid * units) requested through the geometry * manager. */ int gravity; /* Desired window gravity. */ /* * Information used to manage the size and location of a window. */ int width, height; /* Desired dimensions of window, specified in * pixels or grid units. These values are set * by the "wm geometry" command and by * ConfigureNotify events (for when wm resizes * window). -1 means user hasn't requested * dimensions. */ int x, y; /* Desired X and Y coordinates for window. * These values are set by "wm geometry", plus * by ConfigureNotify events (when wm moves * window). These numbers are different than * the numbers stored in winPtr->changes * because (a) they could be measured from the * right or bottom edge of the screen (see * WM_NEGATIVE_X and WM_NEGATIVE_Y flags) and * (b) if the window has been reparented then * they refer to the parent rather than the * window itself. */ int parentWidth, parentHeight; /* Width and height of reparent, in pixels * *including border*. If window hasn't been * reparented then these will be the outer * dimensions of the window, including * border. */ int xInParent, yInParent; /* Offset of wrapperPtr within reparent, * measured in pixels from upper-left outer * corner of reparent's border to upper-left * outer corner of wrapperPtr's border. If not * reparented then these are zero. */ int configWidth, configHeight; /* Dimensions passed to last request that we * issued to change geometry of the wrapper. * Used to eliminate redundant resize * operations. */ /* * Information about the virtual root window for this top-level, if there * is one. */ Window vRoot; /* Virtual root window for this top-level, or * None if there is no virtual root window * (i.e. just use the screen's root). */ int vRootX, vRootY; /* Position of the virtual root inside the * root window. If the WM_VROOT_OFFSET_STALE * flag is set then this information may be * incorrect and needs to be refreshed from * the X server. If vRoot is None then these * values are both 0. */ int vRootWidth, vRootHeight;/* Dimensions of the virtual root window. If * vRoot is None, gives the dimensions of the * containing screen. This information is * never stale, even though vRootX and vRootY * can be. */ /* * Miscellaneous information. */ WmAttributes attributes; /* Current state of [wm attributes] */ WmAttributes reqState; /* Requested state of [wm attributes] */ ProtocolHandler *protPtr; /* First in list of protocol handlers for this * window (NULL means none). */ int cmdArgc; /* Number of elements in cmdArgv below. */ CONST char **cmdArgv; /* Array of strings to store in the WM_COMMAND * property. NULL means nothing available. */ char *clientMachine; /* String to store in WM_CLIENT_MACHINE * property, or NULL. */ int flags; /* Miscellaneous flags, defined below. */ int numTransients; /* number of transients on this window */ int iconDataSize; /* size of iconphoto image data */ unsigned char *iconDataPtr; /* iconphoto image data, if set */ struct TkWmInfo *nextPtr; /* Next in list of all top-level windows. */ } WmInfo; /* * Flag values for WmInfo structures: * * WM_NEVER_MAPPED - non-zero means window has never been mapped; * need to update all info when window is first * mapped. * WM_UPDATE_PENDING - non-zero means a call to UpdateGeometryInfo * has already been scheduled for this window; * no need to schedule another one. * WM_NEGATIVE_X - non-zero means x-coordinate is measured in * pixels from right edge of screen, rather than * from left edge. * WM_NEGATIVE_Y - non-zero means y-coordinate is measured in * pixels up from bottom of screen, rather than * down from top. * WM_UPDATE_SIZE_HINTS - non-zero means that new size hints need to be * propagated to window manager. * WM_SYNC_PENDING - set to non-zero while waiting for the window * manager to respond to some state change. * WM_VROOT_OFFSET_STALE - non-zero means that (x,y) offset information * about the virtual root window is stale and * needs to be fetched fresh from the X server. * WM_ABOUT_TO_MAP - non-zero means that the window is about to be * mapped by TkWmMapWindow. This is used by * UpdateGeometryInfo to modify its behavior. * WM_MOVE_PENDING - non-zero means the application has requested a * new position for the window, but it hasn't * been reflected through the window manager yet. * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were set * explicitly via "wm colormapwindows". * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows" * was called the top-level itself wasn't * specified, so we added it implicitly at the * end of the list. * WM_WIDTH_NOT_RESIZABLE - non-zero means that we're not supposed to * allow the user to change the width of the * window (controlled by "wm resizable" command). * WM_HEIGHT_NOT_RESIZABLE - non-zero means that we're not supposed to * allow the user to change the height of the * window (controlled by "wm resizable" command). * WM_WITHDRAWN - non-zero means that this window has explicitly * been withdrawn. If it's a transient, it should * not mirror state changes in the master. */ #define WM_NEVER_MAPPED 1 #define WM_UPDATE_PENDING 2 #define WM_NEGATIVE_X 4 #define WM_NEGATIVE_Y 8 #define WM_UPDATE_SIZE_HINTS 0x10 #define WM_SYNC_PENDING 0x20 #define WM_VROOT_OFFSET_STALE 0x40 #define WM_ABOUT_TO_MAP 0x100 #define WM_MOVE_PENDING 0x200 #define WM_COLORMAPS_EXPLICIT 0x400 #define WM_ADDED_TOPLEVEL_COLORMAP 0x800 #define WM_WIDTH_NOT_RESIZABLE 0x1000 #define WM_HEIGHT_NOT_RESIZABLE 0x2000 #define WM_WITHDRAWN 0x4000 /* * This module keeps a list of all top-level windows, primarily to simplify * the job of Tk_CoordsToWindow. The list is called firstWmPtr and is stored * in the TkDisplay structure. */ /* * The following structures are the official type records for geometry * management of top-level and menubar windows. */ static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); static void RemapWindows(TkWindow *winPtr, TkWindow *parentPtr); static void MenubarReqProc(ClientData clientData, Tk_Window tkwin); static const Tk_GeomMgr wmMgrType = { "wm", /* name */ TopLevelReqProc, /* requestProc */ NULL, /* lostSlaveProc */ }; static const Tk_GeomMgr menubarMgrType = { "menubar", /* name */ MenubarReqProc, /* requestProc */ NULL, /* lostSlaveProc */ }; /* * Structures of the following type are used for communication between * WaitForEvent, WaitRestrictProc, and WaitTimeoutProc. */ typedef struct WaitRestrictInfo { Display *display; /* Window belongs to this display. */ WmInfo *wmInfoPtr; int type; /* We only care about this type of event. */ XEvent *eventPtr; /* Where to store the event when it's found. */ int foundEvent; /* Non-zero means that an event of the desired * type has been found. */ } WaitRestrictInfo; /* * Forward declarations for functions defined in this file: */ static int ComputeReparentGeometry(WmInfo *wmPtr); static void ConfigureEvent(WmInfo *wmPtr, XConfigureEvent *eventPtr); static void CreateWrapper(WmInfo *wmPtr); static void GetMaxSize(WmInfo *wmPtr, int *maxWidthPtr, int *maxHeightPtr); static void MenubarDestroyProc(ClientData clientData, XEvent *eventPtr); static int ParseGeometry(Tcl_Interp *interp, char *string, TkWindow *winPtr); static void ReparentEvent(WmInfo *wmPtr, XReparentEvent *eventPtr); static void PropertyEvent(WmInfo *wmPtr, XPropertyEvent *eventPtr); static void TkWmStackorderToplevelWrapperMap(TkWindow *winPtr, Display *display, Tcl_HashTable *reparentTable); static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); static void RemapWindows(TkWindow *winPtr, TkWindow *parentPtr); static void UpdateCommand(TkWindow *winPtr); static void UpdateGeometryInfo(ClientData clientData); static void UpdateHints(TkWindow *winPtr); static void UpdateSizeHints(TkWindow *winPtr, int newWidth, int newHeight); static void UpdateTitle(TkWindow *winPtr); static void UpdatePhotoIcon(TkWindow *winPtr); static void UpdateVRootGeometry(WmInfo *wmPtr); static void UpdateWmProtocols(WmInfo *wmPtr); static int SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr); static Tcl_Obj * GetNetWmType(TkWindow *winPtr); static void SetNetWmState(TkWindow*, const char *atomName, int on); static void CheckNetWmState(WmInfo *, Atom *atoms, int numAtoms); static void UpdateNetWmState(WmInfo *); static void WaitForConfigureNotify(TkWindow *winPtr, unsigned long serial); static int WaitForEvent(Display *display, WmInfo *wmInfoPtr, int type, XEvent *eventPtr); static void WaitForMapNotify(TkWindow *winPtr, int mapped); static Tk_RestrictAction WaitRestrictProc(ClientData clientData, XEvent *eventPtr); static void WrapperEventProc(ClientData clientData, XEvent *eventPtr); static void WmWaitMapProc(ClientData clientData, XEvent *eventPtr); static int WmAspectCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmAttributesCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmClientCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmColormapwindowsCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmCommandCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmDeiconifyCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmFocusmodelCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmForgetCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmFrameCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmGeometryCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmGridCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmIconifyCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmIconmaskCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmIconnameCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmIconphotoCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmIconpositionCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmIconwindowCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmManageCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmMaxsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmMinsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmOverrideredirectCmd(Tk_Window tkwin,TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmPositionfromCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmProtocolCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmResizableCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmSizefromCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmStackorderCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmStateCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmTitleCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmTransientCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int WmWithdrawCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static void WmUpdateGeom(WmInfo *wmPtr, TkWindow *winPtr); /* *-------------------------------------------------------------- * * TkWmCleanup -- * * This function is invoked to cleanup remaining wm resources associated * with a display. * * Results: * None. * * Side effects: * All WmInfo structure resources are freed and invalidated. * *-------------------------------------------------------------- */ void TkWmCleanup( TkDisplay *dispPtr) { WmInfo *wmPtr, *nextPtr; for (wmPtr = dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = nextPtr) { /* * We can't assume we have access to winPtr's anymore, so some cleanup * requiring winPtr data is avoided. */ nextPtr = wmPtr->nextPtr; if (wmPtr->title != NULL) { ckfree(wmPtr->title); } if (wmPtr->iconName != NULL) { ckfree(wmPtr->iconName); } if (wmPtr->iconDataPtr != NULL) { ckfree((char *) wmPtr->iconDataPtr); } if (wmPtr->leaderName != NULL) { ckfree(wmPtr->leaderName); } if (wmPtr->menubar != NULL) { Tk_DestroyWindow(wmPtr->menubar); } if (wmPtr->wrapperPtr != NULL) { Tk_DestroyWindow((Tk_Window) wmPtr->wrapperPtr); } while (wmPtr->protPtr != NULL) { ProtocolHandler *protPtr; protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); } if (wmPtr->cmdArgv != NULL) { ckfree((char *) wmPtr->cmdArgv); } if (wmPtr->clientMachine != NULL) { ckfree((char *) wmPtr->clientMachine); } ckfree((char *) wmPtr); } if (dispPtr->iconDataPtr != NULL) { ckfree((char *) dispPtr->iconDataPtr); dispPtr->iconDataPtr = NULL; } } /* *-------------------------------------------------------------- * * TkWmNewWindow -- * * This function is invoked whenever a new top-level window is created. * Its job is to initialize the WmInfo structure for the window. * * Results: * None. * * Side effects: * A WmInfo structure gets allocated and initialized. * *-------------------------------------------------------------- */ void TkWmNewWindow( TkWindow *winPtr) /* Newly-created top-level window. */ { register WmInfo *wmPtr; TkDisplay *dispPtr = winPtr->dispPtr; wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo)); memset(wmPtr, 0, sizeof(WmInfo)); wmPtr->winPtr = winPtr; wmPtr->reparent = None; wmPtr->masterPtr = NULL; wmPtr->numTransients = 0; wmPtr->hints.flags = InputHint | StateHint; wmPtr->hints.input = True; wmPtr->hints.initial_state = NormalState; wmPtr->hints.icon_pixmap = None; wmPtr->hints.icon_window = None; wmPtr->hints.icon_x = wmPtr->hints.icon_y = 0; wmPtr->hints.icon_mask = None; wmPtr->hints.window_group = None; /* * Initialize attributes. */ wmPtr->attributes.alpha = 1.0; wmPtr->attributes.topmost = 0; wmPtr->attributes.zoomed = 0; wmPtr->attributes.fullscreen = 0; wmPtr->reqState = wmPtr->attributes; /* * Default the maximum dimensions to the size of the display, minus a * guess about how space is needed for window manager decorations. */ wmPtr->gridWin = NULL; wmPtr->minWidth = wmPtr->minHeight = 1; wmPtr->maxWidth = wmPtr->maxHeight = 0; wmPtr->widthInc = wmPtr->heightInc = 1; wmPtr->minAspect.x = wmPtr->minAspect.y = 1; wmPtr->maxAspect.x = wmPtr->maxAspect.y = 1; wmPtr->reqGridWidth = wmPtr->reqGridHeight = -1; wmPtr->gravity = NorthWestGravity; wmPtr->width = -1; wmPtr->height = -1; wmPtr->x = winPtr->changes.x; wmPtr->y = winPtr->changes.y; wmPtr->parentWidth = winPtr->changes.width + 2*winPtr->changes.border_width; wmPtr->parentHeight = winPtr->changes.height + 2*winPtr->changes.border_width; wmPtr->configWidth = -1; wmPtr->configHeight = -1; wmPtr->vRoot = None; wmPtr->flags = WM_NEVER_MAPPED; wmPtr->nextPtr = (WmInfo *) dispPtr->firstWmPtr; dispPtr->firstWmPtr = wmPtr; winPtr->wmInfoPtr = wmPtr; UpdateVRootGeometry(wmPtr); /* * Arrange for geometry requests to be reflected from the window to the * window manager. */ Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0); } /* *-------------------------------------------------------------- * * TkWmMapWindow -- * * This function is invoked to map a top-level window. This module gets a * chance to update all window-manager-related information in properties * before the window manager sees the map event and checks the * properties. It also gets to decide whether or not to even map the * window after all. * * Results: * None. * * Side effects: * Properties of winPtr may get updated to provide up-to-date information * to the window manager. The window may also get mapped, but it may not * be if this function decides that isn't appropriate (e.g. because the * window is withdrawn). * *-------------------------------------------------------------- */ void TkWmMapWindow( TkWindow *winPtr) /* Top-level window that's about to be * mapped. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; XTextProperty textProp; if (wmPtr->flags & WM_NEVER_MAPPED) { Tcl_DString ds; wmPtr->flags &= ~WM_NEVER_MAPPED; /* * This is the first time this window has ever been mapped. First * create the wrapper window that provides space for a menubar. */ if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } /* * Store all the window-manager-related information for the window. */ TkWmSetClass(winPtr); UpdateTitle(winPtr); UpdatePhotoIcon(winPtr); if (wmPtr->masterPtr != NULL) { /* * Don't map a transient if the master is not mapped. */ if (!Tk_IsMapped(wmPtr->masterPtr)) { wmPtr->withdrawn = 1; wmPtr->hints.initial_state = WithdrawnState; } /* * Make sure that we actually set the transient-for property, even * if we are withdrawn. [Bug 1163496] */ XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window, wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window); } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; UpdateHints(winPtr); UpdateWmProtocols(wmPtr); if (wmPtr->cmdArgv != NULL) { UpdateCommand(winPtr); } if (wmPtr->clientMachine != NULL) { Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds); if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, &textProp) != 0) { unsigned long pid = (unsigned long) getpid(); Atom atom; XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); /* * Inform the server (and more particularly any session * manager) what our process ID is. We only do this when the * CLIENT_MACHINE property is set since the spec for * _NET_WM_PID requires that to be set too. */ atom = Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_PID"); XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, atom, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &pid, 1); } Tcl_DStringFree(&ds); } } if (wmPtr->hints.initial_state == WithdrawnState) { return; } if (wmPtr->iconFor != NULL) { /* * This window is an icon for somebody else. Make sure that the * geometry is up-to-date, then return without mapping the window. */ if (wmPtr->flags & WM_UPDATE_PENDING) { Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); } UpdateGeometryInfo((ClientData) winPtr); return; } wmPtr->flags |= WM_ABOUT_TO_MAP; if (wmPtr->flags & WM_UPDATE_PENDING) { Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); } UpdateGeometryInfo((ClientData) winPtr); wmPtr->flags &= ~WM_ABOUT_TO_MAP; /* * Update _NET_WM_STATE hints: */ UpdateNetWmState(wmPtr); /* * Map the window, then wait to be sure that the window manager has * processed the map operation. */ XMapWindow(winPtr->display, wmPtr->wrapperPtr->window); if (wmPtr->hints.initial_state == NormalState) { WaitForMapNotify(winPtr, 1); } } /* *-------------------------------------------------------------- * * TkWmUnmapWindow -- * * This function is invoked to unmap a top-level window. The only thing * it does special is to wait for the window actually to be unmapped. * * Results: * None. * * Side effects: * Unmaps the window. * *-------------------------------------------------------------- */ void TkWmUnmapWindow( TkWindow *winPtr) /* Top-level window that's about to be * mapped. */ { /* * It seems to be important to wait after unmapping a top-level window * until the window really gets unmapped. I don't completely understand * all the interactions with the window manager, but if we go on without * waiting, and if the window is then mapped again quickly, events seem to * get lost so that we think the window isn't mapped when in fact it is * mapped. I suspect that this has something to do with the window manager * filtering Map events (and possily not filtering Unmap events?). */ XUnmapWindow(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window); WaitForMapNotify(winPtr, 0); } /* *-------------------------------------------------------------- * * TkWmDeadWindow -- * * This function is invoked when a top-level window is about to be * deleted. It cleans up the wm-related data structures for the window. * * Results: * None. * * Side effects: * The WmInfo structure for winPtr gets freed up. * *-------------------------------------------------------------- */ void TkWmDeadWindow( TkWindow *winPtr) /* Top-level window that's being deleted. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; WmInfo *wmPtr2; if (wmPtr == NULL) { return; } if ((WmInfo *) winPtr->dispPtr->firstWmPtr == wmPtr) { winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr; } else { register WmInfo *prevPtr; for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ; prevPtr = prevPtr->nextPtr) { /* ASSERT: prevPtr != NULL [Bug 1789819] */ if (prevPtr->nextPtr == wmPtr) { prevPtr->nextPtr = wmPtr->nextPtr; break; } } } if (wmPtr->title != NULL) { ckfree(wmPtr->title); } if (wmPtr->iconName != NULL) { ckfree(wmPtr->iconName); } if (wmPtr->iconDataPtr != NULL) { ckfree((char *) wmPtr->iconDataPtr); } if (wmPtr->hints.flags & IconPixmapHint) { Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); } if (wmPtr->hints.flags & IconMaskHint) { Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); } if (wmPtr->leaderName != NULL) { ckfree(wmPtr->leaderName); } if (wmPtr->icon != NULL) { wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; wmPtr2->iconFor = NULL; wmPtr2->withdrawn = 1; } if (wmPtr->iconFor != NULL) { wmPtr2 = ((TkWindow *) wmPtr->iconFor)->wmInfoPtr; wmPtr2->icon = NULL; wmPtr2->hints.flags &= ~IconWindowHint; UpdateHints((TkWindow *) wmPtr->iconFor); } if (wmPtr->menubar != NULL) { Tk_DestroyWindow(wmPtr->menubar); } if (wmPtr->wrapperPtr != NULL) { /* * The rest of Tk doesn't know that we reparent the toplevel inside * the wrapper, so reparent it back out again before deleting the * wrapper; otherwise the toplevel will get deleted twice (once * implicitly by the deletion of the wrapper). */ XUnmapWindow(winPtr->display, winPtr->window); XReparentWindow(winPtr->display, winPtr->window, XRootWindow(winPtr->display, winPtr->screenNum), 0, 0); Tk_DestroyWindow((Tk_Window) wmPtr->wrapperPtr); } while (wmPtr->protPtr != NULL) { ProtocolHandler *protPtr; protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); } if (wmPtr->cmdArgv != NULL) { ckfree((char *) wmPtr->cmdArgv); } if (wmPtr->clientMachine != NULL) { ckfree((char *) wmPtr->clientMachine); } if (wmPtr->flags & WM_UPDATE_PENDING) { Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); } /* * Reset all transient windows whose master is the dead window. */ for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL; wmPtr2 = wmPtr2->nextPtr) { if (wmPtr2->masterPtr == winPtr) { wmPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) wmPtr2->masterPtr, StructureNotifyMask, WmWaitMapProc, (ClientData) wmPtr2->winPtr); wmPtr2->masterPtr = NULL; if (!(wmPtr2->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, wmPtr2->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "WM_TRANSIENT_FOR")); /* * FIXME: Need a call like Win32's UpdateWrapper() so we can * recreate the wrapper and get rid of the transient window * decorations. */ } } } /* ASSERT: numTransients == 0 [Bug 1789819] */ if (wmPtr->masterPtr != NULL) { wmPtr2 = wmPtr->masterPtr->wmInfoPtr; /* * If we had a master, tell them that we aren't tied to them anymore */ if (wmPtr2 != NULL) { wmPtr2->numTransients--; } Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, StructureNotifyMask, WmWaitMapProc, (ClientData) winPtr); wmPtr->masterPtr = NULL; } ckfree((char *) wmPtr); winPtr->wmInfoPtr = NULL; } /* *-------------------------------------------------------------- * * TkWmSetClass -- * * This function is invoked whenever a top-level window's class is * changed. If the window has been mapped then this function updates the * window manager property for the class. If the window hasn't been * mapped, the update is deferred until just before the first mapping. * * Results: * None. * * Side effects: * A window property may get updated. * *-------------------------------------------------------------- */ void TkWmSetClass( TkWindow *winPtr) /* Newly-created top-level window. */ { if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) { return; } if (winPtr->classUid != NULL) { XClassHint *classPtr; Tcl_DString name, class; Tcl_UtfToExternalDString(NULL, winPtr->nameUid, -1, &name); Tcl_UtfToExternalDString(NULL, winPtr->classUid, -1, &class); classPtr = XAllocClassHint(); classPtr->res_name = Tcl_DStringValue(&name); classPtr->res_class = Tcl_DStringValue(&class); XSetClassHint(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window, classPtr); XFree((char *) classPtr); Tcl_DStringFree(&name); Tcl_DStringFree(&class); } } /* *---------------------------------------------------------------------- * * Tk_WmObjCmd -- * * This function is invoked to process the "wm" Tcl command. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tk_WmObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tk_Window tkwin = (Tk_Window) clientData; static CONST char *optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", "frame", "geometry", "grid", "group", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", "withdraw", NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW }; int index; int length; char *argv1; TkWindow *winPtr; Tk_Window targetWin; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; if (objc < 2) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?"); return TCL_ERROR; } argv1 = Tcl_GetStringFromObj(objv[1], &length); if ((argv1[0] == 't') && (strncmp(argv1, "tracing", (size_t) length) == 0) && (length >= 3)) { int wmTracing; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); return TCL_ERROR; } if (objc == 2) { Tcl_SetResult(interp, ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), TCL_STATIC); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { return TCL_ERROR; } if (wmTracing) { dispPtr->flags |= TK_DISPLAY_WM_TRACING; } else { dispPtr->flags &= ~TK_DISPLAY_WM_TRACING; } return TCL_OK; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (objc < 3) { goto wrongNumArgs; } if (TkGetWindowFromObj(interp, tkwin, objv[2], &targetWin) != TCL_OK) { return TCL_ERROR; } winPtr = (TkWindow *) targetWin; if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't a top-level window", NULL); return TCL_ERROR; } switch ((enum options) index) { case WMOPT_ASPECT: return WmAspectCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ATTRIBUTES: return WmAttributesCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_CLIENT: return WmClientCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_COLORMAPWINDOWS: return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_COMMAND: return WmCommandCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_DEICONIFY: return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FOCUSMODEL: return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FORGET: return WmForgetCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FRAME: return WmFrameCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GEOMETRY: return WmGeometryCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GRID: return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONIFY: return WmIconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONMASK: return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONNAME: return WmIconnameCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONPHOTO: return WmIconphotoCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONPOSITION: return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONWINDOW: return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MANAGE: return WmManageCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MAXSIZE: return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MINSIZE: return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_OVERRIDEREDIRECT: return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_POSITIONFROM: return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_PROTOCOL: return WmProtocolCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_RESIZABLE: return WmResizableCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_SIZEFROM: return WmSizefromCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_STACKORDER: return WmStackorderCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_STATE: return WmStateCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_TITLE: return WmTitleCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_TRANSIENT: return WmTransientCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_WITHDRAW: return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv); } /* This should not happen */ return TCL_ERROR; } /* *---------------------------------------------------------------------- * * WmAspectCmd -- * * This function is invoked to process the "wm aspect" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmAspectCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int numer1, denom1, numer2, denom2; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?minNumer minDenom maxNumer maxDenom?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { char buf[TCL_INTEGER_SPACE * 4]; sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, wmPtr->minAspect.y, wmPtr->maxAspect.x, wmPtr->maxAspect.y); Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~PAspect; } else { if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) { return TCL_ERROR; } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC); return TCL_ERROR; } wmPtr->minAspect.x = numer1; wmPtr->minAspect.y = denom1; wmPtr->maxAspect.x = numer2; wmPtr->maxAspect.y = denom2; wmPtr->sizeHintsFlags |= PAspect; } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmSetAttribute -- * * Helper routine for WmAttributesCmd. Sets the value of the specified * attribute. * * Returns: * * TCL_OK if successful, TCL_ERROR otherwise. In case of an error, leaves * a message in the interpreter's result. * *---------------------------------------------------------------------- */ static int WmSetAttribute( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter */ WmAttribute attribute, /* Code of attribute to set */ Tcl_Obj *value) /* New value */ { WmInfo *wmPtr = winPtr->wmInfoPtr; switch (attribute) { case WMATT_ALPHA: { unsigned long opacity; /* 0=transparent, 0xFFFFFFFF=opaque */ if (TCL_OK != Tcl_GetDoubleFromObj(interp, value, &wmPtr->reqState.alpha)) { return TCL_ERROR; } if (wmPtr->reqState.alpha < 0.0) { wmPtr->reqState.alpha = 0.0; } if (wmPtr->reqState.alpha > 1.0) { wmPtr->reqState.alpha = 1.0; } if (!wmPtr->wrapperPtr) { break; } opacity = 0xFFFFFFFFul * wmPtr->reqState.alpha; XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_WINDOW_OPACITY"), XA_CARDINAL, 32, PropModeReplace, (unsigned char *)&opacity, 1L); wmPtr->attributes.alpha = wmPtr->reqState.alpha; break; } case WMATT_TOPMOST: if (TCL_OK != Tcl_GetBooleanFromObj(interp, value, &wmPtr->reqState.topmost)) { return TCL_ERROR; } SetNetWmState(winPtr, "_NET_WM_STATE_ABOVE", wmPtr->reqState.topmost); break; case WMATT_TYPE: if (TCL_OK != SetNetWmType(winPtr, value)) return TCL_ERROR; break; case WMATT_ZOOMED: if (TCL_OK != Tcl_GetBooleanFromObj(interp, value, &wmPtr->reqState.zoomed)) { return TCL_ERROR; } SetNetWmState(winPtr, "_NET_WM_STATE_MAXIMIZED_VERT", wmPtr->reqState.zoomed); SetNetWmState(winPtr, "_NET_WM_STATE_MAXIMIZED_HORZ", wmPtr->reqState.zoomed); break; case WMATT_FULLSCREEN: if (TCL_OK != Tcl_GetBooleanFromObj(interp, value, &wmPtr->reqState.fullscreen)) { return TCL_ERROR; } SetNetWmState(winPtr, "_NET_WM_STATE_FULLSCREEN", wmPtr->reqState.fullscreen); break; case _WMATT_LAST_ATTRIBUTE: /* NOTREACHED */ return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmGetAttribute -- * * Helper routine for WmAttributesCmd. Returns the current value of the * specified attribute. * * See also: CheckNetWmState(). * *---------------------------------------------------------------------- */ static Tcl_Obj * WmGetAttribute( TkWindow *winPtr, /* Toplevel to work with */ WmAttribute attribute) /* Code of attribute to get */ { WmInfo *wmPtr = winPtr->wmInfoPtr; switch (attribute) { case WMATT_ALPHA: return Tcl_NewDoubleObj(wmPtr->attributes.alpha); case WMATT_TOPMOST: return Tcl_NewBooleanObj(wmPtr->attributes.topmost); case WMATT_ZOOMED: return Tcl_NewBooleanObj(wmPtr->attributes.zoomed); case WMATT_FULLSCREEN: return Tcl_NewBooleanObj(wmPtr->attributes.fullscreen); case WMATT_TYPE: return GetNetWmType(winPtr); case _WMATT_LAST_ATTRIBUTE: /*NOTREACHED*/ break; } /*NOTREACHED*/ return NULL; } /* *---------------------------------------------------------------------- * * WmAttributesCmd -- * * This function is invoked to process the "wm attributes" Tcl command. * * Syntax: * * wm attributes $win ?-attribute ?value attribute value...?? * * Notes: * * Attributes of mapped windows are set by sending a _NET_WM_STATE * ClientMessage to the root window (see SetNetWmState). For withdrawn * windows, we keep track of the requested attribute state, and set the * _NET_WM_STATE property ourselves immediately prior to mapping the * window. * * See also: TIP#231, EWMH. * *---------------------------------------------------------------------- */ static int WmAttributesCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { int attribute = 0; if (objc == 3) { /* wm attributes $win */ Tcl_Obj *result = Tcl_NewListObj(0,0); for (attribute = 0; attribute < _WMATT_LAST_ATTRIBUTE; ++attribute) { Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(WmAttributeNames[attribute], -1)); Tcl_ListObjAppendElement(interp, result, WmGetAttribute(winPtr, attribute)); } Tcl_SetObjResult(interp, result); return TCL_OK; } else if (objc == 4) { /* wm attributes $win -attribute */ if (Tcl_GetIndexFromObj(interp, objv[3], WmAttributeNames, "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, WmGetAttribute(winPtr, attribute)); return TCL_OK; } else if ((objc - 3) % 2 == 0) { /* wm attributes $win -att value... */ int i; for (i = 3; i < objc; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], WmAttributeNames, "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } if (WmSetAttribute(winPtr,interp,attribute,objv[i+1]) != TCL_OK) { return TCL_ERROR; } } return TCL_OK; } Tcl_WrongNumArgs(interp, 2, objv, "window ?-attribute ?value ...??"); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * WmClientCmd -- * * This function is invoked to process the "wm client" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmClientCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; char *argv3; int length; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->clientMachine != NULL) { Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); } return TCL_OK; } argv3 = Tcl_GetStringFromObj(objv[3], &length); if (argv3[0] == 0) { if (wmPtr->clientMachine != NULL) { ckfree((char *) wmPtr->clientMachine); wmPtr->clientMachine = NULL; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "WM_CLIENT_MACHINE")); } } return TCL_OK; } if (wmPtr->clientMachine != NULL) { ckfree((char *) wmPtr->clientMachine); } wmPtr->clientMachine = ckalloc((unsigned) length + 1); strcpy(wmPtr->clientMachine, argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XTextProperty textProp; Tcl_DString ds; Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds); if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, &textProp) != 0) { unsigned long pid = (unsigned long) getpid(); XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); /* * Inform the server (and more particularly any session manager) * what our process ID is. We only do this when the CLIENT_MACHINE * property is set since the spec for _NET_WM_PID requires that to * be set too. */ XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_PID"), XA_CARDINAL,32, PropModeReplace, (unsigned char *) &pid, 1); } Tcl_DStringFree(&ds); } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmColormapwindowsCmd -- * * This function is invoked to process the "wm colormapwindows" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmColormapwindowsCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window *cmapList; TkWindow *winPtr2; int count, i, windowObjc, gotToplevel; Tcl_Obj **windowObjv; char buffer[20]; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); return TCL_ERROR; } Tk_MakeWindowExist((Tk_Window) winPtr); if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } if (objc == 3) { if (XGetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window, &cmapList, &count) == 0) { return TCL_OK; } for (i = 0; i < count; i++) { if ((i == (count-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display, cmapList[i]); if (winPtr2 == NULL) { sprintf(buffer, "0x%lx", cmapList[i]); Tcl_AppendElement(interp, buffer); } else { Tcl_AppendElement(interp, winPtr2->pathName); } } XFree((char *) cmapList); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) != TCL_OK) { return TCL_ERROR; } cmapList = (Window *) ckalloc((unsigned) (windowObjc+1) * sizeof(Window)); gotToplevel = 0; for (i = 0; i < windowObjc; i++) { Tk_Window mapWin; if (TkGetWindowFromObj(interp, tkwin, windowObjv[i], &mapWin) != TCL_OK) { ckfree((char *) cmapList); return TCL_ERROR; } winPtr2 = (TkWindow *) mapWin; if (winPtr2 == winPtr) { gotToplevel = 1; } if (winPtr2->window == None) { Tk_MakeWindowExist((Tk_Window) winPtr2); } cmapList[i] = winPtr2->window; } if (!gotToplevel) { wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP; cmapList[windowObjc] = wmPtr->wrapperPtr->window; windowObjc++; } else { wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP; } wmPtr->flags |= WM_COLORMAPS_EXPLICIT; XSetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window, cmapList, windowObjc); ckfree((char *) cmapList); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmCommandCmd -- * * This function is invoked to process the "wm command" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmCommandCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; char *argv3; int cmdArgc; CONST char **cmdArgv; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->cmdArgv != NULL) { Tcl_SetResult(interp, Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), TCL_DYNAMIC); } return TCL_OK; } argv3 = Tcl_GetString(objv[3]); if (argv3[0] == 0) { if (wmPtr->cmdArgv != NULL) { ckfree((char *) wmPtr->cmdArgv); wmPtr->cmdArgv = NULL; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND")); } } return TCL_OK; } if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) { return TCL_ERROR; } if (wmPtr->cmdArgv != NULL) { ckfree((char *) wmPtr->cmdArgv); } wmPtr->cmdArgc = cmdArgc; wmPtr->cmdArgv = cmdArgv; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdateCommand(winPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmDeiconifyCmd -- * * This function is invoked to process the "wm deiconify" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmDeiconifyCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } if (wmPtr->iconFor != NULL) { Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, ": it is an embedded window", NULL); return TCL_ERROR; } wmPtr->flags &= ~WM_WITHDRAWN; TkpWmSetState(winPtr, NormalState); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmFocusmodelCmd -- * * This function is invoked to process the "wm focusmodel" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmFocusmodelCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; static CONST char *optionStrings[] = { "active", "passive", NULL }; enum options { OPT_ACTIVE, OPT_PASSIVE }; int index; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?"); return TCL_ERROR; } if (objc == 3) { Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), TCL_STATIC); return TCL_OK; } if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ACTIVE) { wmPtr->hints.input = False; } else { /* OPT_PASSIVE */ wmPtr->hints.input = True; } UpdateHints(winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmForgetCmd -- * * This procedure is invoked to process the "wm forget" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmForgetCmd(tkwin, winPtr, interp, objc, objv) Tk_Window tkwin; /* Main window of the application. */ TkWindow *winPtr; /* Toplevel or Frame to work with */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { register Tk_Window frameWin = (Tk_Window) winPtr; if (Tk_IsTopLevel(frameWin)) { TkFocusJoin(winPtr); Tk_UnmapWindow(frameWin); TkWmDeadWindow(winPtr); winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); RemapWindows(winPtr, winPtr->parentPtr); /* flags (above) must be cleared before calling */ /* TkMapTopFrame (below) */ TkMapTopFrame(frameWin); } else { /* Already not managed by wm - ignore it */ } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmFrameCmd -- * * This function is invoked to process the "wm frame" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmFrameCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } window = wmPtr->reparent; if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } sprintf(buf, "0x%x", (unsigned int) window); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmGeometryCmd -- * * This function is invoked to process the "wm geometry" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmGeometryCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; char xSign, ySign; int width, height; char *argv3; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?"); return TCL_ERROR; } if (objc == 3) { char buf[16 + TCL_INTEGER_SPACE * 4]; xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { width = wmPtr->reqGridWidth + (winPtr->changes.width - winPtr->reqWidth)/wmPtr->widthInc; height = wmPtr->reqGridHeight + (winPtr->changes.height - winPtr->reqHeight)/wmPtr->heightInc; } else { width = winPtr->changes.width; height = winPtr->changes.height; } sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, ySign, wmPtr->y); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } argv3 = Tcl_GetString(objv[3]); if (*argv3 == '\0') { wmPtr->width = -1; wmPtr->height = -1; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } return ParseGeometry(interp, argv3, winPtr); } /* *---------------------------------------------------------------------- * * WmGridCmd -- * * This function is invoked to process the "wm grid" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmGridCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int reqWidth, reqHeight, widthInc, heightInc; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?baseWidth baseHeight widthInc heightInc?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { char buf[TCL_INTEGER_SPACE * 4]; sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, wmPtr->reqGridHeight, wmPtr->widthInc, wmPtr->heightInc); Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { /* * Turn off gridding and reset the width and height to make sense as * ungridded numbers. */ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc); if (wmPtr->width != -1) { wmPtr->width = winPtr->reqWidth + (wmPtr->width - wmPtr->reqGridWidth)*wmPtr->widthInc; wmPtr->height = winPtr->reqHeight + (wmPtr->height - wmPtr->reqGridHeight)*wmPtr->heightInc; } wmPtr->widthInc = 1; wmPtr->heightInc = 1; } else { if ((Tcl_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) !=TCL_OK)) { return TCL_ERROR; } if (reqWidth < 0) { Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); return TCL_ERROR; } if (reqHeight < 0) { Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); return TCL_ERROR; } if (widthInc <= 0) { Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); return TCL_ERROR; } if (heightInc <= 0) { Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, heightInc); } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmGroupCmd -- * * This function is invoked to process the "wm group" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmGroupCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tk_Window tkwin2; WmInfo *wmPtr2; char *argv3; int length; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); } return TCL_OK; } argv3 = Tcl_GetStringFromObj(objv[3], &length); if (*argv3 == '\0') { wmPtr->hints.flags &= ~WindowGroupHint; if (wmPtr->leaderName != NULL) { ckfree(wmPtr->leaderName); } wmPtr->leaderName = NULL; } else { if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) { return TCL_ERROR; } while (!Tk_TopWinHierarchy(tkwin2)) { /* * Ensure that the group leader is actually a Tk toplevel. */ tkwin2 = Tk_Parent(tkwin2); } Tk_MakeWindowExist(tkwin2); wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->wrapperPtr == NULL) { CreateWrapper(wmPtr2); } if (wmPtr->leaderName != NULL) { ckfree(wmPtr->leaderName); } wmPtr->hints.window_group = Tk_WindowId(wmPtr2->wrapperPtr); wmPtr->hints.flags |= WindowGroupHint; wmPtr->leaderName = ckalloc((unsigned) length + 1); strcpy(wmPtr->leaderName, argv3); } UpdateHints(winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmIconbitmapCmd -- * * This function is invoked to process the "wm iconbitmap" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmIconbitmapCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Pixmap pixmap; char *argv3; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { Tcl_SetResult(interp, (char *) Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), TCL_STATIC); } return TCL_OK; } argv3 = Tcl_GetString(objv[3]); if (*argv3 == '\0') { if (wmPtr->hints.icon_pixmap != None) { Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); wmPtr->hints.icon_pixmap = None; } wmPtr->hints.flags &= ~IconPixmapHint; } else { pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, argv3); if (pixmap == None) { return TCL_ERROR; } wmPtr->hints.icon_pixmap = pixmap; wmPtr->hints.flags |= IconPixmapHint; } UpdateHints(winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmIconifyCmd -- * * This function is invoked to process the "wm iconify" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmIconifyCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, "\": override-redirect flag is set", NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, "\": it is a transient", NULL); return TCL_ERROR; } if (wmPtr->iconFor != NULL) { Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, ": it is an embedded window", NULL); return TCL_ERROR; } if (TkpWmSetState(winPtr, IconicState) == 0) { Tcl_SetResult(interp, "couldn't send iconify message to window manager", TCL_STATIC); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmIconmaskCmd -- * * This function is invoked to process the "wm iconmask" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmIconmaskCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Pixmap pixmap; char *argv3; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { Tcl_SetResult(interp, (char *) Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), TCL_STATIC); } return TCL_OK; } argv3 = Tcl_GetString(objv[3]); if (*argv3 == '\0') { if (wmPtr->hints.icon_mask != None) { Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); } wmPtr->hints.flags &= ~IconMaskHint; } else { pixmap = Tk_GetBitmap(interp, tkwin, argv3); if (pixmap == None) { return TCL_ERROR; } wmPtr->hints.icon_mask = pixmap; wmPtr->hints.flags |= IconMaskHint; } UpdateHints(winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmIconnameCmd -- * * This function is invoked to process the "wm iconname" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmIconnameCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; char *argv3; int length; if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?"); return TCL_ERROR; } if (objc == 3) { Tcl_SetResult(interp, ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), TCL_STATIC); return TCL_OK; } else { if (wmPtr->iconName != NULL) { ckfree((char *) wmPtr->iconName); } argv3 = Tcl_GetStringFromObj(objv[3], &length); wmPtr->iconName = ckalloc((unsigned) length + 1); strcpy(wmPtr->iconName, argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdateTitle(winPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmIconphotoCmd -- * * This function is invoked to process the "wm iconphoto" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmIconphotoCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tk_PhotoHandle photo; Tk_PhotoImageBlock block; int i, size = 0, width, height, index = 0, x, y, isDefault = 0; unsigned long *iconPropertyData; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; } if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) { isDefault = 1; if (objc == 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? image1 ?image2 ...?"); return TCL_ERROR; } } /* * Iterate over all images to retrieve their sizes, in order to allocate a * buffer large enough to hold all images. */ for (i = 3 + isDefault; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), "\" as iconphoto: not a photo image", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); /* * We need to cardinals for width & height and one cardinal for each * image pixel. */ size += 2 + width * height; } /* * We have calculated the size of the data. Try to allocate the needed * memory space. This is an unsigned long array (despite this being twice * as much as is really needed on LP64 platforms) because that's what X * defines CARD32 arrays to use. [Bug 2902814] */ iconPropertyData = (unsigned long *) attemptckalloc(sizeof(unsigned long) * size); if (iconPropertyData == NULL) { return TCL_ERROR; } memset(iconPropertyData, 0, sizeof(unsigned long) * size); for (i = 3 + isDefault; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { Tcl_Free((char *) iconPropertyData); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); Tk_PhotoGetImage(photo, &block); /* * Each image data will be placed as an array of 32bit packed * CARDINAL, in a window property named "_NET_WM_ICON": _NET_WM_ICON * * _NET_WM_ICON CARDINAL[][2+n]/32 * * This is an array of possible icons for the client. This spec. does * not stipulate what size these icons should be, but individual * desktop environments or toolkits may do so. The Window Manager MAY * scale any of these icons to an appropriate size. * * This is an array of 32bit packed CARDINAL ARGB with high byte being * A, low byte being B. The first two cardinals are width, height. * Data is in rows, left to right and top to bottom. The data will be * endian-swapped going to the server if necessary. [Bug 2830420] */ /* * Encode the image data in the iconPropertyData array. */ iconPropertyData[index++] = (unsigned) width; iconPropertyData[index++] = (unsigned) height; for (y = 0; y < height; y++) { for (x = 0; x < width; x++) { register unsigned char *pixelPtr = block.pixelPtr + x*block.pixelSize + y*block.pitch; register unsigned long R, G, B, A; R = pixelPtr[block.offset[0]]; G = pixelPtr[block.offset[1]]; B = pixelPtr[block.offset[2]]; A = pixelPtr[block.offset[3]]; iconPropertyData[index++] = A<<24 | R<<16 | G<<8 | B<<0; } } } if (wmPtr->iconDataPtr != NULL) { ckfree((char *) wmPtr->iconDataPtr); wmPtr->iconDataPtr = NULL; } if (isDefault) { if (winPtr->dispPtr->iconDataPtr != NULL) { ckfree((char *) winPtr->dispPtr->iconDataPtr); } winPtr->dispPtr->iconDataPtr = (unsigned char *) iconPropertyData; winPtr->dispPtr->iconDataSize = size; } else { wmPtr->iconDataPtr = (unsigned char *) iconPropertyData; wmPtr->iconDataSize = size; } if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdatePhotoIcon(winPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmIconpositionCmd -- * * This function is invoked to process the "wm iconposition" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmIconpositionCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { char buf[TCL_INTEGER_SPACE * 2]; sprintf(buf, "%d %d", wmPtr->hints.icon_x, wmPtr->hints.icon_y); Tcl_SetResult(interp, buf, TCL_VOLATILE); } return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->hints.flags &= ~IconPositionHint; } else { if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){ return TCL_ERROR; } wmPtr->hints.icon_x = x; wmPtr->hints.icon_y = y; wmPtr->hints.flags |= IconPositionHint; } UpdateHints(winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmIconwindowCmd -- * * This function is invoked to process the "wm iconwindow" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmIconwindowCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tk_Window tkwin2; WmInfo *wmPtr2; XSetWindowAttributes atts; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->icon != NULL) { Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); } return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->hints.flags &= ~IconWindowHint; if (wmPtr->icon != NULL) { /* * Remove the icon window relationship. In principle we should * also re-enable button events for the window, but this doesn't * work in general because the window manager is probably * selecting on them (we'll get an error if we try to re-enable * the events). So, just leave the icon window event-challenged; * the user will have to recreate it if they want button events. */ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; wmPtr2->iconFor = NULL; wmPtr2->withdrawn = 1; wmPtr2->hints.initial_state = WithdrawnState; } wmPtr->icon = NULL; } else { if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) { return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), " as icon window: not at top level", NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { Tcl_AppendResult(interp, Tcl_GetString(objv[3]), " is already an icon for ", Tk_PathName(wmPtr2->iconFor), NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; wmPtr3->iconFor = NULL; wmPtr3->withdrawn = 1; wmPtr3->hints.initial_state = WithdrawnState; } /* * Disable button events in the icon window: some window managers * (like olvwm) want to get the events themselves, but X only allows * one application at a time to receive button events for a window. */ atts.event_mask = Tk_Attributes(tkwin2)->event_mask & ~ButtonPressMask; Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts); Tk_MakeWindowExist(tkwin2); if (wmPtr2->wrapperPtr == NULL) { CreateWrapper(wmPtr2); } wmPtr->hints.icon_window = Tk_WindowId(wmPtr2->wrapperPtr); wmPtr->hints.flags |= IconWindowHint; wmPtr->icon = tkwin2; wmPtr2->iconFor = (Tk_Window) winPtr; if (!wmPtr2->withdrawn && !(wmPtr2->flags & WM_NEVER_MAPPED)) { wmPtr2->withdrawn = 0; if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(wmPtr2->wrapperPtr), Tk_ScreenNumber(tkwin2)) == 0) { Tcl_SetResult(interp, "couldn't send withdraw message to window manager", TCL_STATIC); return TCL_ERROR; } WaitForMapNotify((TkWindow *) tkwin2, 0); } } UpdateHints(winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmManageCmd -- * * This procedure is invoked to process the "wm manage" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmManageCmd(tkwin, winPtr, interp, objc, objv) Tk_Window tkwin; /* Main window of the application. */ TkWindow *winPtr; /* Toplevel or Frame to work with */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { register Tk_Window frameWin = (Tk_Window) winPtr; register WmInfo *wmPtr = winPtr->wmInfoPtr; if (!Tk_IsTopLevel(frameWin)) { if (!Tk_IsManageable(frameWin)) { Tcl_AppendResult(interp, "window \"", Tk_PathName(frameWin), "\" is not manageable: must be " "a frame, labelframe or toplevel", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); Tk_UnmapWindow(frameWin); winPtr->flags |= TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; if (wmPtr == NULL) { TkWmNewWindow(winPtr); TkWmMapWindow(winPtr); Tk_UnmapWindow(frameWin); } wmPtr = winPtr->wmInfoPtr; winPtr->flags &= ~TK_MAPPED; RemapWindows(winPtr, wmPtr->wrapperPtr); /* flags (above) must be set before calling */ /* TkMapTopFrame (below) */ TkMapTopFrame (frameWin); } else if (Tk_IsTopLevel(frameWin)) { /* Already managed by wm - ignore it */ } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmMaxsizeCmd -- * * This function is invoked to process the "wm maxsize" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmMaxsizeCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } if (objc == 3) { char buf[TCL_INTEGER_SPACE * 2]; GetMaxSize(wmPtr, &width, &height); sprintf(buf, "%d %d", width, height); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } wmPtr->maxWidth = width; wmPtr->maxHeight = height; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (width <= 0 && height <= 0) { wmPtr->sizeHintsFlags &= ~PMaxSize; } else { wmPtr->sizeHintsFlags |= PMaxSize; } WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmMinsizeCmd -- * * This function is invoked to process the "wm minsize" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmMinsizeCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } if (objc == 3) { char buf[TCL_INTEGER_SPACE * 2]; sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } wmPtr->minWidth = width; wmPtr->minHeight = height; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmOverrideredirectCmd -- * * This function is invoked to process the "wm overrideredirect" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmOverrideredirectCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { int boolean, curValue; XSetWindowAttributes atts; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); return TCL_ERROR; } curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; if (objc == 3) { Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) { return TCL_ERROR; } if (curValue != boolean) { /* * Only do this if we are really changing value, because it causes * some funky stuff to occur */ atts.override_redirect = (boolean) ? True : False; Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect, &atts); if (winPtr->wmInfoPtr->wrapperPtr != NULL) { Tk_ChangeWindowAttributes( (Tk_Window) winPtr->wmInfoPtr->wrapperPtr, CWOverrideRedirect, &atts); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmPositionfromCmd -- * * This function is invoked to process the "wm positionfrom" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmPositionfromCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; static CONST char *optionStrings[] = { "program", "user", NULL }; enum options { OPT_PROGRAM, OPT_USER }; int index; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->sizeHintsFlags & USPosition) { Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PPosition) { Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); } else { if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { wmPtr->sizeHintsFlags &= ~PPosition; wmPtr->sizeHintsFlags |= USPosition; } else { wmPtr->sizeHintsFlags &= ~USPosition; wmPtr->sizeHintsFlags |= PPosition; } } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmProtocolCmd -- * * This function is invoked to process the "wm protocol" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmProtocolCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; register ProtocolHandler *protPtr, *prevPtr; Atom protocol; char *cmd; int cmdLength; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); return TCL_ERROR; } if (objc == 3) { /* * Return a list of all defined protocols for the window. */ for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { Tcl_AppendElement(interp, Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); } return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); if (objc == 4) { /* * Return the command to handle a given protocol. */ for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { Tcl_SetResult(interp, protPtr->command, TCL_STATIC); return TCL_OK; } } return TCL_OK; } /* * Special case for _NET_WM_PING: that's always handled directly. */ if (strcmp(Tcl_GetString(objv[3]), "_NET_WM_PING") == 0) { Tcl_SetResult(interp, "may not alter handling of that protocol", TCL_STATIC); return TCL_ERROR; } /* * Delete any current protocol handler, then create a new one with the * specified command, unless the command is empty. */ for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL; prevPtr = protPtr, protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { if (prevPtr == NULL) { wmPtr->protPtr = protPtr->nextPtr; } else { prevPtr->nextPtr = protPtr->nextPtr; } Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); break; } } cmd = Tcl_GetStringFromObj(objv[4], &cmdLength); if (cmdLength > 0) { protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); protPtr->protocol = protocol; protPtr->nextPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr; protPtr->interp = interp; memcpy(protPtr->command, cmd, cmdLength + 1); } if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdateWmProtocols(wmPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmResizableCmd -- * * This function is invoked to process the "wm resizable" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmResizableCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } if (objc == 3) { char buf[TCL_INTEGER_SPACE * 2]; sprintf(buf, "%d %d", (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } if (width) { wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE; } else { wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE; } if (height) { wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE; } else { wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE; } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmSizefromCmd -- * * This function is invoked to process the "wm sizefrom" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmSizefromCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; static CONST char *optionStrings[] = { "program", "user", NULL }; enum options { OPT_PROGRAM, OPT_USER }; int index; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?"); return TCL_ERROR; } if (objc == 3) { if (wmPtr->sizeHintsFlags & USSize) { Tcl_SetResult(interp, "user", TCL_STATIC); } else if (wmPtr->sizeHintsFlags & PSize) { Tcl_SetResult(interp, "program", TCL_STATIC); } return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USSize|PSize); } else { if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { wmPtr->sizeHintsFlags &= ~PSize; wmPtr->sizeHintsFlags |= USSize; } else { /* OPT_PROGRAM */ wmPtr->sizeHintsFlags &= ~USSize; wmPtr->sizeHintsFlags |= PSize; } } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * WmStackorderCmd -- * * This function is invoked to process the "wm stackorder" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmStackorderCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { TkWindow **windows, **window_ptr; static CONST char *optionStrings[] = { "isabove", "isbelow", NULL }; enum options { OPT_ISABOVE, OPT_ISBELOW }; int index; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?"); return TCL_ERROR; } if (objc == 3) { windows = TkWmStackorderToplevel(winPtr); if (windows != NULL) { /* ASSERT: true [Bug 1789819]*/ for (window_ptr = windows; *window_ptr ; window_ptr++) { Tcl_AppendElement(interp, (*window_ptr)->pathName); } ckfree((char *) windows); return TCL_OK; } } else { Tk_Window relWin; TkWindow *winPtr2; int index1=-1, index2=-1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], &relWin) != TCL_OK) { return TCL_ERROR; } winPtr2 = (TkWindow *) relWin; if (!Tk_IsTopLevel(winPtr2)) { Tcl_AppendResult(interp, "window \"", winPtr2->pathName, "\" isn't a top-level window", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't mapped", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr2)) { Tcl_AppendResult(interp, "window \"", winPtr2->pathName, "\" isn't mapped", NULL); return TCL_ERROR; } /* * Lookup stacking order of all toplevels that are children of "." and * find the position of winPtr and winPtr2 in the stacking order. */ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); if (windows == NULL) { Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); return TCL_ERROR; } else { for (window_ptr = windows; *window_ptr ; window_ptr++) { if (*window_ptr == winPtr) { index1 = (window_ptr - windows); } if (*window_ptr == winPtr2) { index2 = (window_ptr - windows); } } /* ASSERT: index1 != -1 && index2 != -2 [Bug 1789819] */ ckfree((char *) windows); } if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ISABOVE) { result = index1 > index2; } else { /* OPT_ISBELOW */ result = index1 < index2; } Tcl_SetIntObj(Tcl_GetObjResult(interp), result); return TCL_OK; } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmStateCmd -- * * This function is invoked to process the "wm state" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmStateCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; static CONST char *optionStrings[] = { "normal", "iconic", "withdrawn", NULL }; enum options { OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN }; int index; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?state?"); return TCL_ERROR; } if (objc == 4) { if (wmPtr->iconFor != NULL) { Tcl_AppendResult(interp, "can't change state of ", Tcl_GetString(objv[2]), ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_NORMAL) { wmPtr->flags &= ~WM_WITHDRAWN; (void) TkpWmSetState(winPtr, NormalState); } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, "\": override-redirect flag is set", NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, "\": it is a transient", NULL); return TCL_ERROR; } if (TkpWmSetState(winPtr, IconicState) == 0) { Tcl_SetResult(interp, "couldn't send iconify message to window manager", TCL_STATIC); return TCL_ERROR; } } else { /* OPT_WITHDRAWN */ wmPtr->flags |= WM_WITHDRAWN; if (TkpWmSetState(winPtr, WithdrawnState) == 0) { Tcl_SetResult(interp, "couldn't send withdraw message to window manager", TCL_STATIC); return TCL_ERROR; } } } else { if (wmPtr->iconFor != NULL) { Tcl_SetResult(interp, "icon", TCL_STATIC); } else if (wmPtr->withdrawn) { Tcl_SetResult(interp, "withdrawn", TCL_STATIC); } else if (Tk_IsMapped((Tk_Window) winPtr) || ((wmPtr->flags & WM_NEVER_MAPPED) && (wmPtr->hints.initial_state == NormalState))) { Tcl_SetResult(interp, "normal", TCL_STATIC); } else { Tcl_SetResult(interp, "iconic", TCL_STATIC); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmTitleCmd -- * * This function is invoked to process the "wm title" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmTitleCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; char *argv3; int length; if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?"); return TCL_ERROR; } if (objc == 3) { Tcl_SetResult(interp, (char *) ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), TCL_STATIC); return TCL_OK; } else { if (wmPtr->title != NULL) { ckfree((char *) wmPtr->title); } argv3 = Tcl_GetStringFromObj(objv[3], &length); wmPtr->title = ckalloc((unsigned) length + 1); strcpy(wmPtr->title, argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdateTitle(winPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmTransientCmd -- * * This function is invoked to process the "wm transient" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmTransientCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; TkWindow *masterPtr = wmPtr->masterPtr; WmInfo *wmPtr2; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?master?"); return TCL_ERROR; } if (objc == 3) { if (masterPtr != NULL) { Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC); } return TCL_OK; } if (Tcl_GetString(objv[3])[0] == '\0') { if (masterPtr != NULL) { /* * If we had a master, tell them that we aren't tied to them * anymore */ masterPtr->wmInfoPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) masterPtr, StructureNotifyMask, WmWaitMapProc, (ClientData) winPtr); /* * FIXME: Need a call like Win32's UpdateWrapper() so we can * recreate the wrapper and get rid of the transient window * decorations. */ } wmPtr->masterPtr = NULL; } else { Tk_Window masterWin; if (TkGetWindowFromObj(interp, tkwin, objv[3], &masterWin)!=TCL_OK) { return TCL_ERROR; } masterPtr = (TkWindow *) masterWin; while (!Tk_TopWinHierarchy(masterPtr)) { /* * Ensure that the master window is actually a Tk toplevel. */ masterPtr = masterPtr->parentPtr; } Tk_MakeWindowExist((Tk_Window) masterPtr); if (wmPtr->iconFor != NULL) { Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), "\" a transient: it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); return TCL_ERROR; } wmPtr2 = masterPtr->wmInfoPtr; if (wmPtr2->wrapperPtr == NULL) { CreateWrapper(wmPtr2); } if (wmPtr2->iconFor != NULL) { Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), "\" a master: it is an icon for ", Tk_PathName(wmPtr2->iconFor), NULL); return TCL_ERROR; } if (masterPtr == winPtr) { Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), "\" its own master", NULL); return TCL_ERROR; } else if (masterPtr != wmPtr->masterPtr) { /* * Remove old master map/unmap binding before setting the new * master. The event handler will ensure that transient states * reflect the state of the master. */ if (wmPtr->masterPtr != NULL) { wmPtr->masterPtr->wmInfoPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, StructureNotifyMask, WmWaitMapProc, (ClientData) winPtr); } masterPtr->wmInfoPtr->numTransients++; Tk_CreateEventHandler((Tk_Window) masterPtr, StructureNotifyMask, WmWaitMapProc, (ClientData) winPtr); wmPtr->masterPtr = masterPtr; } } if (!(wmPtr->flags & WM_NEVER_MAPPED)) { if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) { if (TkpWmSetState(winPtr, WithdrawnState) == 0) { Tcl_SetResult(interp, "couldn't send withdraw message to window manager", TCL_STATIC); return TCL_ERROR; } } else { if (wmPtr->masterPtr != NULL) { XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window, wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window); } else { XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "WM_TRANSIENT_FOR")); } } } return TCL_OK; } /* *---------------------------------------------------------------------- * * WmWithdrawCmd -- * * This function is invoked to process the "wm withdraw" Tcl command. See * the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int WmWithdrawCmd( Tk_Window tkwin, /* Main window of the application. */ TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } if (wmPtr->iconFor != NULL) { Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); return TCL_ERROR; } wmPtr->flags |= WM_WITHDRAWN; if (TkpWmSetState(winPtr, WithdrawnState) == 0) { Tcl_SetResult(interp, "couldn't send withdraw message to window manager", TCL_STATIC); return TCL_ERROR; } return TCL_OK; } /* * Invoked by those wm subcommands that affect geometry. Schedules a geometry * update. */ static void WmUpdateGeom( WmInfo *wmPtr, TkWindow *winPtr) { if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } /* * Invoked when a MapNotify or UnmapNotify event is delivered for a toplevel * that is the master of a transient toplevel. */ static void WmWaitMapProc( ClientData clientData, /* Pointer to window. */ XEvent *eventPtr) /* Information about event. */ { TkWindow *winPtr = (TkWindow *) clientData; TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr; if (masterPtr == NULL) { return; } if (eventPtr->type == MapNotify) { if (!(winPtr->wmInfoPtr->flags & WM_WITHDRAWN)) { (void) TkpWmSetState(winPtr, NormalState); } } else if (eventPtr->type == UnmapNotify) { (void) TkpWmSetState(winPtr, WithdrawnState); } } /* *---------------------------------------------------------------------- * * Tk_SetGrid -- * * This function is invoked by a widget when it wishes to set a grid * coordinate system that controls the size of a top-level window. It * provides a C interface equivalent to the "wm grid" command and is * usually associated with the -setgrid option. * * Results: * None. * * Side effects: * Grid-related information will be passed to the window manager, so that * the top-level window associated with tkwin will resize on even grid * units. If some other window already controls gridding for the * top-level window then this function call has no effect. * *---------------------------------------------------------------------- */ void Tk_SetGrid( Tk_Window tkwin, /* Token for window. New window mgr info will * be posted for the top-level window * associated with this window. */ int reqWidth, /* Width (in grid units) corresponding to the * requested geometry for tkwin. */ int reqHeight, /* Height (in grid units) corresponding to the * requested geometry for tkwin. */ int widthInc, int heightInc)/* Pixel increments corresponding to a change * of one grid unit. */ { TkWindow *winPtr = (TkWindow *) tkwin; register WmInfo *wmPtr; /* * Ensure widthInc and heightInc are greater than 0 */ if (widthInc <= 0) { widthInc = 1; } if (heightInc <= 0) { heightInc = 1; } /* * Find the top-level window for tkwin, plus the window manager * information. */ while (!(winPtr->flags & TK_TOP_HIERARCHY)) { winPtr = winPtr->parentPtr; if (winPtr == NULL) { /* * The window is being deleted... just skip this operation. */ return; } } wmPtr = winPtr->wmInfoPtr; if (wmPtr == NULL) { return; } if ((wmPtr->gridWin != NULL) && (wmPtr->gridWin != tkwin)) { return; } if ((wmPtr->reqGridWidth == reqWidth) && (wmPtr->reqGridHeight == reqHeight) && (wmPtr->widthInc == widthInc) && (wmPtr->heightInc == heightInc) && ((wmPtr->sizeHintsFlags & (PBaseSize|PResizeInc)) == (PBaseSize|PResizeInc))) { return; } /* * If gridding was previously off, then forget about any window size * requests made by the user or via "wm geometry": these are in pixel * units and there's no easy way to translate them to grid units since the * new requested size of the top-level window in pixels may not yet have * been registered yet (it may filter up the hierarchy in DoWhenIdle * handlers). However, if the window has never been mapped yet then just * leave the window size alone: assume that it is intended to be in grid * units but just happened to have been specified before this function was * called. */ if ((wmPtr->gridWin == NULL) && !(wmPtr->flags & WM_NEVER_MAPPED)) { wmPtr->width = -1; wmPtr->height = -1; } /* * Set the new gridding information, and start the process of passing all * of this information to the window manager. */ wmPtr->gridWin = tkwin; wmPtr->reqGridWidth = reqWidth; wmPtr->reqGridHeight = reqHeight; wmPtr->widthInc = widthInc; wmPtr->heightInc = heightInc; wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } /* *---------------------------------------------------------------------- * * Tk_UnsetGrid -- * * This function cancels the effect of a previous call to Tk_SetGrid. * * Results: * None. * * Side effects: * If tkwin currently controls gridding for its top-level window, * gridding is cancelled for that top-level window; if some other window * controls gridding then this function has no effect. * *---------------------------------------------------------------------- */ void Tk_UnsetGrid( Tk_Window tkwin) /* Token for window that is currently * controlling gridding. */ { TkWindow *winPtr = (TkWindow *) tkwin; register WmInfo *wmPtr; /* * Find the top-level window for tkwin, plus the window manager * information. */ while (!(winPtr->flags & TK_TOP_HIERARCHY)) { winPtr = winPtr->parentPtr; if (winPtr == NULL) { /* * The window is being deleted... just skip this operation. */ return; } } wmPtr = winPtr->wmInfoPtr; if (wmPtr == NULL) { return; } if (tkwin != wmPtr->gridWin) { return; } wmPtr->gridWin = NULL; wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc); if (wmPtr->width != -1) { wmPtr->width = winPtr->reqWidth + (wmPtr->width - wmPtr->reqGridWidth)*wmPtr->widthInc; wmPtr->height = winPtr->reqHeight + (wmPtr->height - wmPtr->reqGridHeight)*wmPtr->heightInc; } wmPtr->widthInc = 1; wmPtr->heightInc = 1; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } /* *---------------------------------------------------------------------- * * ConfigureEvent -- * * This function is called to handle ConfigureNotify events on wrapper * windows. * * Results: * None. * * Side effects: * Information gets updated in the WmInfo structure for the window and * the toplevel itself gets repositioned within the wrapper. * *---------------------------------------------------------------------- */ static void ConfigureEvent( WmInfo *wmPtr, /* Information about toplevel window. */ XConfigureEvent *configEventPtr) /* Event that just occurred for * wmPtr->wrapperPtr. */ { TkWindow *wrapperPtr = wmPtr->wrapperPtr; TkWindow *winPtr = wmPtr->winPtr; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; Tk_ErrorHandler handler; /* * Update size information from the event. There are a couple of tricky * points here: * * 1. If the user changed the size externally then set wmPtr->width and * wmPtr->height just as if a "wm geometry" command had been invoked * with the same information. * 2. However, if the size is changing in response to a request coming * from us (WM_SYNC_PENDING is set), then don't set wmPtr->width or * wmPtr->height if they were previously -1 (otherwise the window will * stop tracking geometry manager requests). */ if (((wrapperPtr->changes.width != configEventPtr->width) || (wrapperPtr->changes.height != configEventPtr->height)) && !(wmPtr->flags & WM_SYNC_PENDING)) { if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("TopLevelEventProc: user changed %s size to %dx%d\n", winPtr->pathName, configEventPtr->width, configEventPtr->height); } if ((wmPtr->width == -1) && (configEventPtr->width == winPtr->reqWidth)) { /* * Don't set external width, since the user didn't change it from * what the widgets asked for. */ } else { /* * Note: if this window is embedded then don't set the external * size, since it came from the containing application, not the * user. In this case we want to keep sending our size requests to * the containing application; if the user fixes the size of that * application then it will still percolate down to us in the * right way. */ if (!(winPtr->flags & TK_EMBEDDED)) { if (wmPtr->gridWin != NULL) { wmPtr->width = wmPtr->reqGridWidth + (configEventPtr->width - winPtr->reqWidth)/wmPtr->widthInc; if (wmPtr->width < 0) { wmPtr->width = 0; } } else { wmPtr->width = configEventPtr->width; } } } if ((wmPtr->height == -1) && (configEventPtr->height == (winPtr->reqHeight + wmPtr->menuHeight))) { /* * Don't set external height, since the user didn't change it from * what the widgets asked for. */ } else { /* * See note for wmPtr->width about not setting external size for * embedded windows. */ if (!(winPtr->flags & TK_EMBEDDED)) { if (wmPtr->gridWin != NULL) { wmPtr->height = wmPtr->reqGridHeight + (configEventPtr->height - wmPtr->menuHeight - winPtr->reqHeight)/wmPtr->heightInc; if (wmPtr->height < 0) { wmPtr->height = 0; } } else { wmPtr->height = configEventPtr->height - wmPtr->menuHeight; } } } wmPtr->configWidth = configEventPtr->width; wmPtr->configHeight = configEventPtr->height; } if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("ConfigureEvent: %s x = %d y = %d, width = %d, height = %d\n", winPtr->pathName, configEventPtr->x, configEventPtr->y, configEventPtr->width, configEventPtr->height); printf(" send_event = %d, serial = %ld (win %p, wrapper %p)\n", configEventPtr->send_event, configEventPtr->serial, winPtr, wrapperPtr); } wrapperPtr->changes.width = configEventPtr->width; wrapperPtr->changes.height = configEventPtr->height; wrapperPtr->changes.border_width = configEventPtr->border_width; wrapperPtr->changes.sibling = configEventPtr->above; wrapperPtr->changes.stack_mode = Above; /* * Reparenting window managers make life difficult. If the window manager * reparents a top-level window then the x and y information that comes in * events for the window is wrong: it gives the location of the window * inside its decorative parent, rather than the location of the window in * root coordinates, which is what we want. Window managers are supposed * to send synthetic events with the correct information, but ICCCM * doesn't require them to do this under all conditions, and the * information provided doesn't include everything we need here. So, the * code below maintains a bunch of information about the parent window. * If the window hasn't been reparented, we pretend that there is a parent * shrink-wrapped around the window. */ if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf(" %s parent == %p, above %p\n", winPtr->pathName, (void *) wmPtr->reparent, (void *) configEventPtr->above); } if ((wmPtr->reparent == None) || !ComputeReparentGeometry(wmPtr)) { wmPtr->parentWidth = configEventPtr->width + 2*configEventPtr->border_width; wmPtr->parentHeight = configEventPtr->height + 2*configEventPtr->border_width; wrapperPtr->changes.x = wmPtr->x = configEventPtr->x; wrapperPtr->changes.y = wmPtr->y = configEventPtr->y; if (wmPtr->flags & WM_NEGATIVE_X) { wmPtr->x = wmPtr->vRootWidth - (wmPtr->x + wmPtr->parentWidth); } if (wmPtr->flags & WM_NEGATIVE_Y) { wmPtr->y = wmPtr->vRootHeight - (wmPtr->y + wmPtr->parentHeight); } } /* * Make sure that the toplevel and menubar are properly positioned within * the wrapper. If the menuHeight happens to be zero, we'll get a BadValue * X error that we want to ignore [Bug: 3377] */ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, NULL, NULL); XMoveResizeWindow(winPtr->display, winPtr->window, 0, wmPtr->menuHeight, (unsigned) wrapperPtr->changes.width, (unsigned) (wrapperPtr->changes.height - wmPtr->menuHeight)); Tk_DeleteErrorHandler(handler); if ((wmPtr->menubar != NULL) && ((Tk_Width(wmPtr->menubar) != wrapperPtr->changes.width) || (Tk_Height(wmPtr->menubar) != wmPtr->menuHeight))) { Tk_MoveResizeWindow(wmPtr->menubar, 0, 0, wrapperPtr->changes.width, wmPtr->menuHeight); } /* * Update the coordinates in the toplevel (they should refer to the * position in root window coordinates, not the coordinates of the wrapper * window). Then synthesize a ConfigureNotify event to tell the * application about the change. */ winPtr->changes.x = wrapperPtr->changes.x; winPtr->changes.y = wrapperPtr->changes.y + wmPtr->menuHeight; winPtr->changes.width = wrapperPtr->changes.width; winPtr->changes.height = wrapperPtr->changes.height - wmPtr->menuHeight; TkDoConfigureNotify(winPtr); } /* *---------------------------------------------------------------------- * * ReparentEvent -- * * This function is called to handle ReparentNotify events on wrapper * windows. * * Results: * None. * * Side effects: * Information gets updated in the WmInfo structure for the window. * *---------------------------------------------------------------------- */ static void ReparentEvent( WmInfo *wmPtr, /* Information about toplevel window. */ XReparentEvent *reparentEventPtr) /* Event that just occurred for * wmPtr->wrapperPtr. */ { TkWindow *wrapperPtr = wmPtr->wrapperPtr; Window vRoot, ancestor, *children, dummy2, *virtualRootPtr, **vrPtrPtr; Atom actualType; int actualFormat; unsigned long numItems, bytesAfter; unsigned int dummy; Tk_ErrorHandler handler; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; /* * Identify the root window for wrapperPtr. This is tricky because of * virtual root window managers like tvtwm. If the window has a property * named __SWM_ROOT or __WM_ROOT then this property gives the id for a * virtual root window that should be used instead of the root window of * the screen. */ vRoot = RootWindow(wrapperPtr->display, wrapperPtr->screenNum); wmPtr->vRoot = None; handler = Tk_CreateErrorHandler(wrapperPtr->display, -1,-1,-1, NULL,NULL); vrPtrPtr = &virtualRootPtr; /* Silence GCC warning */ if (((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"), 0, (long) 1, False, XA_WINDOW, &actualType, &actualFormat, &numItems, &bytesAfter, (unsigned char **) vrPtrPtr) == Success) && (actualType == XA_WINDOW)) || ((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"), 0, (long) 1, False, XA_WINDOW, &actualType, &actualFormat, &numItems, &bytesAfter, (unsigned char **) vrPtrPtr) == Success) && (actualType == XA_WINDOW))) { if ((actualFormat == 32) && (numItems == 1)) { vRoot = wmPtr->vRoot = *virtualRootPtr; } else if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("%s format %d numItems %ld\n", "ReparentEvent got bogus VROOT property:", actualFormat, numItems); } XFree((char *) virtualRootPtr); } Tk_DeleteErrorHandler(handler); if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("ReparentEvent: %s (%p) reparented to 0x%x, vRoot = 0x%x\n", wmPtr->winPtr->pathName, wmPtr->winPtr, (unsigned int) reparentEventPtr->parent, (unsigned int) vRoot); } /* * Fetch correct geometry information for the new virtual root. */ UpdateVRootGeometry(wmPtr); /* * If the window's new parent is the root window, then mark it as no * longer reparented. */ if (reparentEventPtr->parent == vRoot) { noReparent: wmPtr->reparent = None; wmPtr->parentWidth = wrapperPtr->changes.width; wmPtr->parentHeight = wrapperPtr->changes.height; wmPtr->xInParent = wmPtr->yInParent = 0; wrapperPtr->changes.x = reparentEventPtr->x; wrapperPtr->changes.y = reparentEventPtr->y; wmPtr->winPtr->changes.x = reparentEventPtr->x; wmPtr->winPtr->changes.y = reparentEventPtr->y + wmPtr->menuHeight; return; } /* * Search up the window hierarchy to find the ancestor of this window that * is just below the (virtual) root. This is tricky because it's possible * that things have changed since the event was generated so that the * ancestry indicated by the event no longer exists. If this happens then * an error will occur and we just discard the event (there will be a more * up-to-date ReparentNotify event coming later). */ handler = Tk_CreateErrorHandler(wrapperPtr->display, -1,-1,-1, NULL,NULL); wmPtr->reparent = reparentEventPtr->parent; while (1) { if (XQueryTree(wrapperPtr->display, wmPtr->reparent, &dummy2, &ancestor, &children, &dummy) == 0) { Tk_DeleteErrorHandler(handler); goto noReparent; } XFree((char *) children); if ((ancestor == vRoot) || (ancestor == RootWindow(wrapperPtr->display, wrapperPtr->screenNum))) { break; } wmPtr->reparent = ancestor; } Tk_DeleteErrorHandler(handler); if (!ComputeReparentGeometry(wmPtr)) { goto noReparent; } } /* *---------------------------------------------------------------------- * * ComputeReparentGeometry -- * * This function is invoked to recompute geometry information related to * a reparented top-level window, such as the position and total size of * the parent and the position within it of the top-level window. * * Results: * The return value is 1 if everything completed successfully and 0 if an * error occurred while querying information about winPtr's parents. In * this case winPtr is marked as no longer being reparented. * * Side effects: * Geometry information in wmPtr, wmPtr->winPtr, and wmPtr->wrapperPtr * gets updated. * *---------------------------------------------------------------------- */ static int ComputeReparentGeometry( WmInfo *wmPtr) /* Information about toplevel window whose * reparent info is to be recomputed. */ { TkWindow *wrapperPtr = wmPtr->wrapperPtr; int width, height, bd; unsigned int dummy; int xOffset, yOffset, x, y; Window dummy2; Status status; Tk_ErrorHandler handler; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; handler = Tk_CreateErrorHandler(wrapperPtr->display, -1,-1,-1, NULL,NULL); (void) XTranslateCoordinates(wrapperPtr->display, wrapperPtr->window, wmPtr->reparent, 0, 0, &xOffset, &yOffset, &dummy2); status = XGetGeometry(wrapperPtr->display, wmPtr->reparent, &dummy2, &x, &y, (unsigned int *) &width, (unsigned int *) &height, (unsigned int *) &bd, &dummy); Tk_DeleteErrorHandler(handler); if (status == 0) { /* * It appears that the reparented parent went away and no-one told us. * Reset the window to indicate that it's not reparented. */ wmPtr->reparent = None; wmPtr->xInParent = wmPtr->yInParent = 0; return 0; } wmPtr->xInParent = xOffset + bd; wmPtr->yInParent = yOffset + bd; wmPtr->parentWidth = width + 2*bd; wmPtr->parentHeight = height + 2*bd; /* * Some tricky issues in updating wmPtr->x and wmPtr->y: * * 1. Don't update them if the event occurred because of something we did * (i.e. WM_SYNC_PENDING and WM_MOVE_PENDING are both set). This is * because window managers treat coords differently than Tk, and no two * window managers are alike. If the window manager moved the window * because we told it to, remember the coordinates we told it, not the * ones it actually moved it to. This allows us to move the window back to * the same coordinates later and get the same result. Without this check, * windows can "walk" across the screen under some conditions. * * 2. Don't update wmPtr->x and wmPtr->y unless wrapperPtr->changes.x or * wrapperPtr->changes.y has changed (otherwise a size change can spoof us * into thinking that the position changed too and defeat the intent of * (1) above. * * (As of 9/96 the above 2 comments appear to be stale. They're being left * in place as a reminder of what was once true (and perhaps should still * be true?)). * * 3. Ignore size changes coming from the window system if we're about to * change the size ourselves but haven't seen the event for it yet: our * size change is supposed to take priority. */ if (!(wmPtr->flags & WM_MOVE_PENDING) && ((wrapperPtr->changes.x != (x + wmPtr->xInParent)) || (wrapperPtr->changes.y != (y + wmPtr->yInParent)))) { wmPtr->x = x; if (wmPtr->flags & WM_NEGATIVE_X) { wmPtr->x = wmPtr->vRootWidth - (wmPtr->x + wmPtr->parentWidth); } wmPtr->y = y; if (wmPtr->flags & WM_NEGATIVE_Y) { wmPtr->y = wmPtr->vRootHeight - (wmPtr->y + wmPtr->parentHeight); } } wrapperPtr->changes.x = x + wmPtr->xInParent; wrapperPtr->changes.y = y + wmPtr->yInParent; if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("wrapperPtr %p coords %d,%d\n", wrapperPtr, wrapperPtr->changes.x, wrapperPtr->changes.y); printf(" wmPtr %p coords %d,%d, offsets %d %d\n", wmPtr, wmPtr->x, wmPtr->y, wmPtr->xInParent, wmPtr->yInParent); } return 1; } /* *---------------------------------------------------------------------- * * PropertyEvent -- * * Handle PropertyNotify events on wrapper windows. The following * properties are of interest: * * _NET_WM_STATE: * Used to keep wmPtr->attributes up to date. * *---------------------------------------------------------------------- */ static void PropertyEvent( WmInfo *wmPtr, /* Information about toplevel window. */ XPropertyEvent *eventPtr) /* PropertyNotify event structure */ { TkWindow *wrapperPtr = wmPtr->wrapperPtr; Atom _NET_WM_STATE = Tk_InternAtom((Tk_Window) wmPtr->winPtr, "_NET_WM_STATE"); if (eventPtr->atom == _NET_WM_STATE) { Atom actualType; int actualFormat; unsigned long numItems, bytesAfter; unsigned char *propertyValue = 0; long maxLength = 1024; if (XGetWindowProperty( wrapperPtr->display, wrapperPtr->window, _NET_WM_STATE, 0l, maxLength, False, XA_ATOM, &actualType, &actualFormat, &numItems, &bytesAfter, &propertyValue) == Success) { CheckNetWmState(wmPtr, (Atom *) propertyValue, (int) numItems); XFree(propertyValue); } } } /* *---------------------------------------------------------------------- * * WrapperEventProc -- * * This function is invoked by the event loop when a wrapper window is * restructured. * * Results: * None. * * Side effects: * Tk's internal data structures for the window get modified to reflect * the structural change. * *---------------------------------------------------------------------- */ static const unsigned int WrapperEventMask = (StructureNotifyMask | PropertyChangeMask); static void WrapperEventProc( ClientData clientData, /* Information about toplevel window. */ XEvent *eventPtr) /* Event that just happened. */ { WmInfo *wmPtr = (WmInfo *) clientData; XEvent mapEvent; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; wmPtr->flags |= WM_VROOT_OFFSET_STALE; if (eventPtr->type == DestroyNotify) { Tk_ErrorHandler handler; if (!(wmPtr->wrapperPtr->flags & TK_ALREADY_DEAD)) { /* * A top-level window was deleted externally (e.g., by the window * manager). This is probably not a good thing, but cleanup as * best we can. The error handler is needed because * Tk_DestroyWindow will try to destroy the window, but of course * it's already gone. */ handler = Tk_CreateErrorHandler(wmPtr->winPtr->display, -1, -1, -1, NULL, NULL); Tk_DestroyWindow((Tk_Window) wmPtr->winPtr); Tk_DeleteErrorHandler(handler); } if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("TopLevelEventProc: %s deleted\n", wmPtr->winPtr->pathName); } } else if (eventPtr->type == ConfigureNotify) { /* * Ignore the event if the window has never been mapped yet. Such an * event occurs only in weird cases like changing the internal border * width of a top-level window, which results in a synthetic Configure * event. These events are not relevant to us, and if we process them * confusion may result (e.g. we may conclude erroneously that the * user repositioned or resized the window). */ if (!(wmPtr->flags & WM_NEVER_MAPPED)) { ConfigureEvent(wmPtr, &eventPtr->xconfigure); } } else if (eventPtr->type == MapNotify) { wmPtr->wrapperPtr->flags |= TK_MAPPED; wmPtr->winPtr->flags |= TK_MAPPED; XMapWindow(wmPtr->winPtr->display, wmPtr->winPtr->window); goto doMapEvent; } else if (eventPtr->type == UnmapNotify) { wmPtr->wrapperPtr->flags &= ~TK_MAPPED; wmPtr->winPtr->flags &= ~TK_MAPPED; XUnmapWindow(wmPtr->winPtr->display, wmPtr->winPtr->window); goto doMapEvent; } else if (eventPtr->type == ReparentNotify) { ReparentEvent(wmPtr, &eventPtr->xreparent); } else if (eventPtr->type == PropertyNotify) { PropertyEvent(wmPtr, &eventPtr->xproperty); } return; doMapEvent: mapEvent = *eventPtr; mapEvent.xmap.event = wmPtr->winPtr->window; mapEvent.xmap.window = wmPtr->winPtr->window; Tk_HandleEvent(&mapEvent); } /* *---------------------------------------------------------------------- * * TopLevelReqProc -- * * This function is invoked by the geometry manager whenever the * requested size for a top-level window is changed. * * Results: * None. * * Side effects: * Arrange for the window to be resized to satisfy the request (this * happens as a when-idle action). * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void TopLevelReqProc( ClientData dummy, /* Not used. */ Tk_Window tkwin) /* Information about window. */ { TkWindow *winPtr = (TkWindow *) tkwin; WmInfo *wmPtr; if ((wmPtr = winPtr->wmInfoPtr) == NULL) return; if ((wmPtr->width >= 0) && (wmPtr->height >= 0)) { /* * Explicit dimensions have been set for this window, so we should * ignore the geometry request. It's actually important to ignore the * geometry request because, due to quirks in window managers, * invoking UpdateGeometryInfo may cause the window to move. For * example, if "wm geometry -10-20" was invoked, the window may be * positioned incorrectly the first time it appears (because we didn't * know the proper width of the window manager borders); if we invoke * UpdateGeometryInfo again, the window will be positioned correctly, * which may cause it to jump on the screen. */ return; } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } /* * If the window isn't being positioned by its upper left corner then we * have to move it as well. */ if (wmPtr->flags & (WM_NEGATIVE_X | WM_NEGATIVE_Y)) { wmPtr->flags |= WM_MOVE_PENDING; } } /* *---------------------------------------------------------------------- * * UpdateGeometryInfo -- * * This function is invoked when a top-level window is first mapped, and * also as a when-idle function, to bring the geometry and/or position of * a top-level window back into line with what has been requested by the * user and/or widgets. This function doesn't return until the window * manager has responded to the geometry change. * * Results: * None. * * Side effects: * The size and location of both the toplevel window and its wrapper may * change, unless the WM prevents that from happening. * *---------------------------------------------------------------------- */ static void UpdateGeometryInfo( ClientData clientData) /* Pointer to the window's record. */ { register TkWindow *winPtr = (TkWindow *) clientData; register WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y, width, height, min, max; unsigned long serial; wmPtr->flags &= ~WM_UPDATE_PENDING; /* * Compute the new size for the top-level window. See the user * documentation for details on this, but the size requested depends on * (a) the size requested internally by the window's widgets, (b) the size * requested by the user in a "wm geometry" command or via wm-based * interactive resizing (if any), (c) whether or not the window is * gridded, and (d) the current min or max size for the toplevel. Don't * permit sizes <= 0 because this upsets the X server. */ if (wmPtr->width == -1) { width = winPtr->reqWidth; } else if (wmPtr->gridWin != NULL) { width = winPtr->reqWidth + (wmPtr->width - wmPtr->reqGridWidth)*wmPtr->widthInc; } else { width = wmPtr->width; } if (width <= 0) { width = 1; } /* * Account for window max/min width */ if (wmPtr->gridWin != NULL) { min = winPtr->reqWidth + (wmPtr->minWidth - wmPtr->reqGridWidth)*wmPtr->widthInc; if (wmPtr->maxWidth > 0) { max = winPtr->reqWidth + (wmPtr->maxWidth - wmPtr->reqGridWidth)*wmPtr->widthInc; } else { max = 0; } } else { min = wmPtr->minWidth; max = wmPtr->maxWidth; } if (width < min) { width = min; } else if ((max > 0) && (width > max)) { width = max; } if (wmPtr->height == -1) { height = winPtr->reqHeight; } else if (wmPtr->gridWin != NULL) { height = winPtr->reqHeight + (wmPtr->height - wmPtr->reqGridHeight)*wmPtr->heightInc; } else { height = wmPtr->height; } if (height <= 0) { height = 1; } /* * Account for window max/min height */ if (wmPtr->gridWin != NULL) { min = winPtr->reqHeight + (wmPtr->minHeight - wmPtr->reqGridHeight)*wmPtr->heightInc; if (wmPtr->maxHeight > 0) { max = winPtr->reqHeight + (wmPtr->maxHeight - wmPtr->reqGridHeight)*wmPtr->heightInc; } else { max = 0; } } else { min = wmPtr->minHeight; max = wmPtr->maxHeight; } if (height < min) { height = min; } else if ((max > 0) && (height > max)) { height = max; } /* * Compute the new position for the upper-left pixel of the window's * decorative frame. This is tricky, because we need to include the border * widths supplied by a reparented parent in this calculation, but can't * use the parent's current overall size since that may change as a result * of this code. */ if (wmPtr->flags & WM_NEGATIVE_X) { x = wmPtr->vRootWidth - wmPtr->x - (width + (wmPtr->parentWidth - winPtr->changes.width)); } else { x = wmPtr->x; } if (wmPtr->flags & WM_NEGATIVE_Y) { y = wmPtr->vRootHeight - wmPtr->y - (height + (wmPtr->parentHeight - winPtr->changes.height)); } else { y = wmPtr->y; } /* * If the window's size is going to change and the window is supposed to * not be resizable by the user, then we have to update the size hints. * There may also be a size-hint-update request pending from somewhere * else, too. */ if (((width != winPtr->changes.width) || (height != winPtr->changes.height)) && (wmPtr->gridWin == NULL) && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) { wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) { UpdateSizeHints(winPtr, width, height); } /* * Reconfigure the wrapper if it isn't already configured correctly. A few * tricky points: * * 1. If the window is embeddedand the container is also in this process, * don't actually reconfigure the window; just pass the desired size on * to the container. Also, zero out any position information, since * embedded windows are not allowed to move. * 2. Sometimes the window manager will give us a different size than we * asked for (e.g. mwm has a minimum size for windows), so base the * size check on what we *asked for* last time, not what we got. * 3. Can't just reconfigure always, because we may not get a * ConfigureNotify event back if nothing changed, so * WaitForConfigureNotify will hang a long time. * 4. Don't move window unless a new position has been requested for it. * This is because of "features" in some window managers (e.g. twm, as * of 4/24/91) where they don't interpret coordinates according to * ICCCM. Moving a window to its current location may cause it to shift * position on the screen. */ if ((winPtr->flags & (TK_EMBEDDED|TK_BOTH_HALVES)) == (TK_EMBEDDED|TK_BOTH_HALVES)) { TkWindow *childPtr = TkpGetOtherWindow(winPtr); /* * This window is embedded and the container is also in this process, * so we don't need to do anything special about the geometry, except * to make sure that the desired size is known by the container. Also, * zero out any position information, since embedded windows are not * allowed to move. */ wmPtr->x = wmPtr->y = 0; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); height += wmPtr->menuHeight; if (childPtr != NULL) { Tk_GeometryRequest((Tk_Window) childPtr, width, height); } return; } serial = NextRequest(winPtr->display); height += wmPtr->menuHeight; if (wmPtr->flags & WM_MOVE_PENDING) { if ((x + wmPtr->xInParent == winPtr->changes.x) && (y + wmPtr->yInParent + wmPtr->menuHeight == winPtr->changes.y) && (width == wmPtr->wrapperPtr->changes.width) && (height == wmPtr->wrapperPtr->changes.height)) { /* * The window already has the correct geometry, so don't bother to * configure it; the X server appears to ignore these requests, so * we won't get back a ConfigureNotify and the * WaitForConfigureNotify call below will hang for a while. */ wmPtr->flags &= ~WM_MOVE_PENDING; return; } wmPtr->configWidth = width; wmPtr->configHeight = height; if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("UpdateGeometryInfo moving to %d %d, resizing to %dx%d,\n", x, y, width, height); } XMoveResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, x, y, (unsigned) width, (unsigned) height); } else if ((width != wmPtr->configWidth) || (height != wmPtr->configHeight)) { if ((width == wmPtr->wrapperPtr->changes.width) && (height == wmPtr->wrapperPtr->changes.height)) { /* * The window is already just the size we want, so don't bother to * configure it; the X server appears to ignore these requests, so * we won't get back a ConfigureNotify and the * WaitForConfigureNotify call below will hang for a while. */ return; } wmPtr->configWidth = width; wmPtr->configHeight = height; if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("UpdateGeometryInfo resizing %p to %d x %d\n", (void *) wmPtr->wrapperPtr->window, width, height); } XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, (unsigned) width, (unsigned) height); } else if ((wmPtr->menubar != NULL) && ((Tk_Width(wmPtr->menubar) != wmPtr->wrapperPtr->changes.width) || (Tk_Height(wmPtr->menubar) != wmPtr->menuHeight))) { /* * It is possible that the window's overall size has not changed but * the menu size has. */ Tk_MoveResizeWindow(wmPtr->menubar, 0, 0, wmPtr->wrapperPtr->changes.width, wmPtr->menuHeight); XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, (unsigned) width, (unsigned) height); } else { return; } /* * Wait for the configure operation to complete. Don't need to do this, * however, if the window is about to be mapped: it will be taken care of * elsewhere. */ if (!(wmPtr->flags & WM_ABOUT_TO_MAP)) { WaitForConfigureNotify(winPtr, serial); } } /* *-------------------------------------------------------------- * * UpdateSizeHints -- * * This function is called to update the window manager's size hints * information from the information in a WmInfo structure. * * Results: * None. * * Side effects: * Properties get changed for winPtr. * *-------------------------------------------------------------- */ static void UpdateSizeHints( TkWindow *winPtr, int newWidth, int newHeight) { register WmInfo *wmPtr = winPtr->wmInfoPtr; XSizeHints *hintsPtr; int maxWidth, maxHeight; wmPtr->flags &= ~WM_UPDATE_SIZE_HINTS; hintsPtr = XAllocSizeHints(); if (hintsPtr == NULL) { return; } /* * Compute the pixel-based sizes for the various fields in the size hints * structure, based on the grid-based sizes in our structure. */ GetMaxSize(wmPtr, &maxWidth, &maxHeight); if (wmPtr->gridWin != NULL) { hintsPtr->base_width = winPtr->reqWidth - (wmPtr->reqGridWidth * wmPtr->widthInc); if (hintsPtr->base_width < 0) { hintsPtr->base_width = 0; } hintsPtr->base_height = winPtr->reqHeight + wmPtr->menuHeight - (wmPtr->reqGridHeight * wmPtr->heightInc); if (hintsPtr->base_height < 0) { hintsPtr->base_height = 0; } hintsPtr->min_width = hintsPtr->base_width + (wmPtr->minWidth * wmPtr->widthInc); hintsPtr->min_height = hintsPtr->base_height + (wmPtr->minHeight * wmPtr->heightInc); hintsPtr->max_width = hintsPtr->base_width + (maxWidth * wmPtr->widthInc); hintsPtr->max_height = hintsPtr->base_height + (maxHeight * wmPtr->heightInc); } else { hintsPtr->min_width = wmPtr->minWidth; hintsPtr->min_height = wmPtr->minHeight; hintsPtr->max_width = maxWidth; hintsPtr->max_height = maxHeight; hintsPtr->base_width = 0; hintsPtr->base_height = 0; } hintsPtr->width_inc = wmPtr->widthInc; hintsPtr->height_inc = wmPtr->heightInc; hintsPtr->min_aspect.x = wmPtr->minAspect.x; hintsPtr->min_aspect.y = wmPtr->minAspect.y; hintsPtr->max_aspect.x = wmPtr->maxAspect.x; hintsPtr->max_aspect.y = wmPtr->maxAspect.y; hintsPtr->win_gravity = wmPtr->gravity; hintsPtr->flags = wmPtr->sizeHintsFlags | PMinSize; /* * If the window isn't supposed to be resizable, then set the minimum and * maximum dimensions to be the same. */ if (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) { hintsPtr->max_width = hintsPtr->min_width = newWidth; hintsPtr->flags |= PMaxSize; } if (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) { hintsPtr->max_height = hintsPtr->min_height = newHeight + wmPtr->menuHeight; hintsPtr->flags |= PMaxSize; } XSetWMNormalHints(winPtr->display, wmPtr->wrapperPtr->window, hintsPtr); XFree((char *) hintsPtr); } /* *-------------------------------------------------------------- * * UpdateTitle -- * * This function is called to update the window title and icon name. It * sets the ICCCM-defined properties WM_NAME and WM_ICON_NAME for older * window managers, and the freedesktop.org-defined _NET_WM_NAME and * _NET_WM_ICON_NAME properties for newer ones. The ICCCM properties are * stored in the system encoding, the newer properties are stored in * UTF-8. * * NOTE: the ICCCM specifies that WM_NAME and WM_ICON_NAME are stored in * ISO-Latin-1. Tk has historically used the default system encoding * (since 8.1). It's not clear whether this is correct or not. * * Side effects: * Properties get changed for winPtr. * *-------------------------------------------------------------- */ static void UpdateTitle( TkWindow *winPtr) { WmInfo *wmPtr = winPtr->wmInfoPtr; Atom XA_UTF8_STRING = Tk_InternAtom((Tk_Window) winPtr, "UTF8_STRING"); const char *string; Tcl_DString ds; /* * Set window title: */ string = (wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid; Tcl_UtfToExternalDString(NULL, string, -1, &ds); XStoreName(winPtr->display, wmPtr->wrapperPtr->window, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_NAME"), XA_UTF8_STRING, 8, PropModeReplace, (const unsigned char *) string, (signed int) strlen(string)); /* * Set icon name: */ if (wmPtr->iconName != NULL) { Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds); XSetIconName(winPtr->display, wmPtr->wrapperPtr->window, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_ICON_NAME"), XA_UTF8_STRING, 8, PropModeReplace, (const unsigned char *) wmPtr->iconName, (signed int) strlen(wmPtr->iconName)); } } /* *-------------------------------------------------------------- * * UpdatePhotoIcon -- * * This function is called to update the window photo icon. It sets the * EWMH-defined properties _NET_WM_ICON. * * Side effects: * Properties get changed for winPtr. * *-------------------------------------------------------------- */ static void UpdatePhotoIcon( TkWindow *winPtr) { WmInfo *wmPtr = winPtr->wmInfoPtr; unsigned char *data = wmPtr->iconDataPtr; int size = wmPtr->iconDataSize; if (data == NULL) { data = winPtr->dispPtr->iconDataPtr; size = winPtr->dispPtr->iconDataSize; } if (data != NULL) { /* * Set icon: */ XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_ICON"), XA_CARDINAL, 32, PropModeReplace, (unsigned char *) data, size); } } /* *---------------------------------------------------------------------- * * SetNetWmState -- * * Sets the specified state property by sending a _NET_WM_STATE * ClientMessage to the root window. * * Preconditions: * Wrapper window must be created. * * See also: * UpdateNetWmState; EWMH spec, section _NET_WM_STATE. * *---------------------------------------------------------------------- */ #define _NET_WM_STATE_REMOVE 0l #define _NET_WM_STATE_ADD 1l #define _NET_WM_STATE_TOGGLE 2l static void SetNetWmState( TkWindow *winPtr, const char *atomName, int on) { Tk_Window tkwin = (Tk_Window) winPtr; Atom messageType = Tk_InternAtom(tkwin, "_NET_WM_STATE"); Atom action = on ? _NET_WM_STATE_ADD : _NET_WM_STATE_REMOVE; Atom property = Tk_InternAtom(tkwin, atomName); XEvent e; if (!winPtr->wmInfoPtr->wrapperPtr) { return; } e.xany.type = ClientMessage; e.xany.window = winPtr->wmInfoPtr->wrapperPtr->window; e.xclient.message_type = messageType; e.xclient.format = 32; e.xclient.data.l[0] = action; e.xclient.data.l[1] = property; e.xclient.data.l[2] = e.xclient.data.l[3] = e.xclient.data.l[4] = 0l; XSendEvent(winPtr->display, RootWindow(winPtr->display, winPtr->screenNum), 0, SubstructureNotifyMask|SubstructureRedirectMask, &e); } /* *---------------------------------------------------------------------- * * CheckNetWmState -- * * Updates the window attributes whenever the _NET_WM_STATE property * changes. * * Notes: * * Tk uses a single -zoomed state, while the EWMH spec supports separate * vertical and horizontal maximization. We consider the window to be * "zoomed" if _NET_WM_STATE_MAXIMIZED_VERT and * _NET_WM_STATE_MAXIMIZED_HORZ are both set. * *---------------------------------------------------------------------- */ static void CheckNetWmState( WmInfo *wmPtr, Atom *atoms, int numAtoms) { Tk_Window tkwin = (Tk_Window) wmPtr->wrapperPtr; int i; Atom _NET_WM_STATE_ABOVE = Tk_InternAtom(tkwin, "_NET_WM_STATE_ABOVE"), _NET_WM_STATE_MAXIMIZED_VERT = Tk_InternAtom(tkwin, "_NET_WM_STATE_MAXIMIZED_VERT"), _NET_WM_STATE_MAXIMIZED_HORZ = Tk_InternAtom(tkwin, "_NET_WM_STATE_MAXIMIZED_HORZ"), _NET_WM_STATE_FULLSCREEN = Tk_InternAtom(tkwin, "_NET_WM_STATE_FULLSCREEN"); wmPtr->attributes.topmost = 0; wmPtr->attributes.zoomed = 0; wmPtr->attributes.fullscreen = 0; for (i = 0; i < numAtoms; ++i) { if (atoms[i] == _NET_WM_STATE_ABOVE) { wmPtr->attributes.topmost = 1; } else if (atoms[i] == _NET_WM_STATE_MAXIMIZED_VERT) { wmPtr->attributes.zoomed |= 1; } else if (atoms[i] == _NET_WM_STATE_MAXIMIZED_HORZ) { wmPtr->attributes.zoomed |= 2; } else if (atoms[i] == _NET_WM_STATE_FULLSCREEN) { wmPtr->attributes.fullscreen = 1; } } wmPtr->attributes.zoomed = (wmPtr->attributes.zoomed == 3); return; } /* *---------------------------------------------------------------------- * * UpdateNetWmState -- * * Sets the _NET_WM_STATE property to match the requested attribute state * just prior to mapping a withdrawn window. * *---------------------------------------------------------------------- */ #define NET_WM_STATE_MAX_ATOMS 4 static void UpdateNetWmState( WmInfo *wmPtr) { Tk_Window tkwin = (Tk_Window) wmPtr->wrapperPtr; Atom atoms[NET_WM_STATE_MAX_ATOMS]; long numAtoms = 0; if (wmPtr->reqState.topmost) { atoms[numAtoms++] = Tk_InternAtom(tkwin,"_NET_WM_STATE_ABOVE"); } if (wmPtr->reqState.zoomed) { atoms[numAtoms++] = Tk_InternAtom(tkwin,"_NET_WM_STATE_MAXIMIZED_VERT"); atoms[numAtoms++] = Tk_InternAtom(tkwin,"_NET_WM_STATE_MAXIMIZED_HORZ"); } if (wmPtr->reqState.fullscreen) { atoms[numAtoms++] = Tk_InternAtom(tkwin, "_NET_WM_STATE_FULLSCREEN"); } XChangeProperty(Tk_Display(tkwin), wmPtr->wrapperPtr->window, Tk_InternAtom(tkwin, "_NET_WM_STATE"), XA_ATOM, 32, PropModeReplace, (unsigned char *) atoms, numAtoms); } /* *---------------------------------------------------------------------- * * WaitForConfigureNotify -- * * This function is invoked in order to synchronize with the window * manager. It waits for a ConfigureNotify event to arrive, signalling * that the window manager has seen an attempt on our part to move or * resize a top-level window. * * Results: * None. * * Side effects: * Delays the execution of the process until a ConfigureNotify event * arrives with serial number at least as great as serial. This is useful * for two reasons: * * 1. It's important to distinguish ConfigureNotify events that are * coming in response to a request we've made from those generated * spontaneously by the user. The reason for this is that if the user * resizes the window we take that as an order to ignore geometry * requests coming from inside the window hierarchy. If we * accidentally interpret a response to our request as a user- * initiated action, the window will stop responding to new geometry * requests. To make this distinction, (a) this function sets a flag * for TopLevelEventProc to indicate that we're waiting to sync with * the wm, and (b) all changes to the size of a top-level window are * followed by calls to this function. * 2. Races and confusion can come about if there are multiple operations * outstanding at a time (e.g. two different resizes of the top-level * window: it's hard to tell which of the ConfigureNotify events * coming back is for which request). * While waiting, some events covered by StructureNotifyMask are * processed (ConfigureNotify, MapNotify, and UnmapNotify) and all others * are deferred. * *---------------------------------------------------------------------- */ static void WaitForConfigureNotify( TkWindow *winPtr, /* Top-level window for which we want to see a * ConfigureNotify. */ unsigned long serial) /* Serial number of resize request. Want to be * sure wm has seen this. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; XEvent event; int diff, code; int gotConfig = 0; /* * One more tricky detail about this function. In some cases the window * manager will decide to ignore a configure request (e.g. because it * thinks the window is already in the right place). To avoid hanging in * this situation, only wait for a few seconds, then give up. */ while (!gotConfig) { wmPtr->flags |= WM_SYNC_PENDING; code = WaitForEvent(winPtr->display, wmPtr, ConfigureNotify, &event); wmPtr->flags &= ~WM_SYNC_PENDING; if (code != TCL_OK) { if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("WaitForConfigureNotify giving up on %s\n", winPtr->pathName); } break; } diff = event.xconfigure.serial - serial; if (diff >= 0) { gotConfig = 1; } } wmPtr->flags &= ~WM_MOVE_PENDING; if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("WaitForConfigureNotify finished with %s, serial %ld\n", winPtr->pathName, serial); } } /* *---------------------------------------------------------------------- * * WaitForEvent -- * * This function is used by WaitForConfigureNotify and WaitForMapNotify * to wait for an event of a certain type to arrive. * * Results: * Under normal conditions, TCL_OK is returned and an event for display * and window that matches "mask" is stored in *eventPtr. This event has * already been processed by Tk before this function returns. If a long * time goes by with no event of the right type arriving, or if an error * occurs while waiting for the event to arrive, then TCL_ERROR is * returned. * * Side effects: * While waiting for the desired event to occur, Configurenotify, * MapNotify, and UnmapNotify events for window are processed, as are all * ReparentNotify events. * *---------------------------------------------------------------------- */ static int WaitForEvent( Display *display, /* Display event is coming from. */ WmInfo *wmInfoPtr, /* Window for which event is desired. */ int type, /* Type of event that is wanted. */ XEvent *eventPtr) /* Place to store event. */ { WaitRestrictInfo info; Tk_RestrictProc *oldRestrictProc; ClientData oldRestrictData; Tcl_Time timeout; /* * Set up an event filter to select just the events we want, and a timer * handler, then wait for events until we get the event we want or a * timeout happens. */ info.display = display; info.wmInfoPtr = wmInfoPtr; info.type = type; info.eventPtr = eventPtr; info.foundEvent = 0; oldRestrictProc = Tk_RestrictEvents(WaitRestrictProc, (ClientData) &info, &oldRestrictData); Tcl_GetTime(&timeout); timeout.sec += 2; while (!info.foundEvent) { if (!TkUnixDoOneXEvent(&timeout)) { break; } } (void) Tk_RestrictEvents(oldRestrictProc, oldRestrictData, &oldRestrictData); if (info.foundEvent) { return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * WaitRestrictProc -- * * This function is a Tk_RestrictProc that is used to filter events while * WaitForEvent is active. * * Results: * Returns TK_PROCESS_EVENT if the right event is found. Also returns * TK_PROCESS_EVENT if any ReparentNotify event is found or if the event * is a ConfigureNotify, MapNotify, or UnmapNotify for window. Otherwise * returns TK_DEFER_EVENT. * * Side effects: * An event may get stored in the area indicated by the caller of * WaitForEvent. * *---------------------------------------------------------------------- */ static Tk_RestrictAction WaitRestrictProc( ClientData clientData, /* Pointer to WaitRestrictInfo structure. */ XEvent *eventPtr) /* Event that is about to be handled. */ { WaitRestrictInfo *infoPtr = (WaitRestrictInfo *) clientData; if (eventPtr->type == ReparentNotify) { return TK_PROCESS_EVENT; } if (((eventPtr->xany.window != infoPtr->wmInfoPtr->wrapperPtr->window) && (eventPtr->xany.window != infoPtr->wmInfoPtr->reparent)) || (eventPtr->xany.display != infoPtr->display)) { return TK_DEFER_EVENT; } if (eventPtr->type == infoPtr->type) { *infoPtr->eventPtr = *eventPtr; infoPtr->foundEvent = 1; return TK_PROCESS_EVENT; } if (eventPtr->type == ConfigureNotify || eventPtr->type == MapNotify || eventPtr->type == UnmapNotify) { return TK_PROCESS_EVENT; } return TK_DEFER_EVENT; } /* *---------------------------------------------------------------------- * * WaitForMapNotify -- * * This function is invoked in order to synchronize with the window * manager. It waits for the window's mapped state to reach the value * given by mapped. * * Results: * None. * * Side effects: * Delays the execution of the process until winPtr becomes mapped or * unmapped, depending on the "mapped" argument. This allows us to * synchronize with the window manager, and allows us to identify changes * in window size that come about when the window manager first starts * managing the window (as opposed to those requested interactively by * the user later). See the comments for WaitForConfigureNotify and * WM_SYNC_PENDING. While waiting, some events covered by * StructureNotifyMask are processed and all others are deferred. * *---------------------------------------------------------------------- */ static void WaitForMapNotify( TkWindow *winPtr, /* Top-level window for which we want to see a * particular mapping state. */ int mapped) /* If non-zero, wait for window to become * mapped, otherwise wait for it to become * unmapped. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; XEvent event; int code; while (1) { if (mapped) { if (winPtr->flags & TK_MAPPED) { break; } } else if (!(winPtr->flags & TK_MAPPED)) { break; } wmPtr->flags |= WM_SYNC_PENDING; code = WaitForEvent(winPtr->display, wmPtr, mapped ? MapNotify : UnmapNotify, &event); wmPtr->flags &= ~WM_SYNC_PENDING; if (code != TCL_OK) { /* * There are some bizarre situations in which the window manager * can't respond or chooses not to (e.g. if we've got a grab set * it can't respond). If this happens then just quit. */ if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("WaitForMapNotify giving up on %s\n", winPtr->pathName); } break; } } wmPtr->flags &= ~WM_MOVE_PENDING; if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("WaitForMapNotify finished with %s (winPtr %p, wmPtr %p)\n", winPtr->pathName, winPtr, wmPtr); } } /* *-------------------------------------------------------------- * * UpdateHints -- * * This function is called to update the window manager's hints * information from the information in a WmInfo structure. * * Results: * None. * * Side effects: * Properties get changed for winPtr. * *-------------------------------------------------------------- */ static void UpdateHints( TkWindow *winPtr) { WmInfo *wmPtr = winPtr->wmInfoPtr; if (wmPtr->flags & WM_NEVER_MAPPED) { return; } XSetWMHints(winPtr->display, wmPtr->wrapperPtr->window, &wmPtr->hints); } /* *---------------------------------------------------------------------- * * SetNetWmType -- * * Set the extended window manager hints for a toplevel window * to the types provided. The specification states that this * may be a list of window types in preferred order. To permit * for future type definitions, the set of names is unconstrained * and names are converted to upper-case and appended to * "_NET_WM_WINDOW_TYPE_" before being converted to an Atom. * *---------------------------------------------------------------------- */ static int SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) { Atom typeAtom, *atoms = NULL; WmInfo *wmPtr; TkWindow *wrapperPtr; Tcl_Obj **objv; int objc, n; Tk_Window tkwin = (Tk_Window)winPtr; Tcl_Interp *interp = Tk_Interp(tkwin); if (TCL_OK != Tcl_ListObjGetElements(interp, typePtr, &objc, &objv)) { return TCL_ERROR; } if (!Tk_HasWrapper(tkwin)) { return TCL_OK; /* error?? */ } if (objc > 0) { atoms = (Atom *)ckalloc(sizeof(Atom) * objc); } for (n = 0; n < objc; ++n) { Tcl_DString ds, dsName; int len; char *name = Tcl_GetStringFromObj(objv[n], &len); Tcl_UtfToUpper(name); Tcl_UtfToExternalDString(NULL, name, len, &dsName); Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, "_NET_WM_WINDOW_TYPE_", 20); Tcl_DStringAppend(&ds, Tcl_DStringValue(&dsName), Tcl_DStringLength(&dsName)); Tcl_DStringFree(&dsName); atoms[n] = Tk_InternAtom(tkwin, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } wmPtr = winPtr->wmInfoPtr; if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } wrapperPtr = wmPtr->wrapperPtr; typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE"); XChangeProperty(Tk_Display(tkwin), wrapperPtr->window, typeAtom, XA_ATOM, 32, PropModeReplace, (unsigned char *) atoms, objc); ckfree((char *)atoms); return TCL_OK; } /* *---------------------------------------------------------------------- * * GetNetWmType -- * * Read the extended window manager type hint from a window * and return as a list of names suitable for use with * SetNetWmType. * *---------------------------------------------------------------------- */ static Tcl_Obj * GetNetWmType(TkWindow *winPtr) { Atom typeAtom, actualType, *atoms; int actualFormat; unsigned long n, count, bytesAfter; unsigned char *propertyValue = NULL; long maxLength = 1024; Tk_Window tkwin = (Tk_Window)winPtr; TkWindow *wrapperPtr; Tcl_Obj *typePtr; Tcl_Interp *interp; Tcl_DString ds; interp = Tk_Interp(tkwin); typePtr = Tcl_NewListObj(0, NULL); if (winPtr->wmInfoPtr->wrapperPtr == NULL) { CreateWrapper(winPtr->wmInfoPtr); } wrapperPtr = winPtr->wmInfoPtr->wrapperPtr; typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE"); if (Success == XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, typeAtom, 0L, maxLength, False, XA_ATOM, &actualType, &actualFormat, &count, &bytesAfter, &propertyValue)) { atoms = (Atom *)propertyValue; for (n = 0; n < count; ++n) { const char *name = Tk_GetAtomName(tkwin, atoms[n]); if (strncmp("_NET_WM_WINDOW_TYPE_", name, 20) == 0) { Tcl_ExternalToUtfDString(NULL, name+20, -1, &ds); Tcl_UtfToLower(Tcl_DStringValue(&ds)); Tcl_ListObjAppendElement(interp, typePtr, Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); } } XFree(propertyValue); } return typePtr; } /* *-------------------------------------------------------------- * * ParseGeometry -- * * This function parses a geometry string and updates information used to * control the geometry of a top-level window. * * Results: * A standard Tcl return value, plus an error message in the interp's * result if an error occurs. * * Side effects: * The size and/or location of winPtr may change. * *-------------------------------------------------------------- */ static int ParseGeometry( Tcl_Interp *interp, /* Used for error reporting. */ char *string, /* String containing new geometry. Has the * standard form "=wxh+x+y". */ TkWindow *winPtr) /* Pointer to top-level window whose geometry * is to be changed. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y, width, height, flags; char *end; register char *p = string; /* * The leading "=" is optional. */ if (*p == '=') { p++; } /* * Parse the width and height, if they are present. Don't actually update * any of the fields of wmPtr until we've successfully parsed the entire * geometry string. */ width = wmPtr->width; height = wmPtr->height; x = wmPtr->x; y = wmPtr->y; flags = wmPtr->flags; if (isdigit(UCHAR(*p))) { width = strtoul(p, &end, 10); p = end; if (*p != 'x') { goto error; } p++; if (!isdigit(UCHAR(*p))) { goto error; } height = strtoul(p, &end, 10); p = end; } /* * Parse the X and Y coordinates, if they are present. */ if (*p != '\0') { flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y); if (*p == '-') { flags |= WM_NEGATIVE_X; } else if (*p != '+') { goto error; } p++; if (!isdigit(UCHAR(*p)) && (*p != '-')) { goto error; } x = strtol(p, &end, 10); p = end; if (*p == '-') { flags |= WM_NEGATIVE_Y; } else if (*p != '+') { goto error; } p++; if (!isdigit(UCHAR(*p)) && (*p != '-')) { goto error; } y = strtol(p, &end, 10); if (*end != '\0') { goto error; } /* * Assume that the geometry information came from the user, unless an * explicit source has been specified. Otherwise most window managers * assume that the size hints were program-specified and they ignore * them. */ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { wmPtr->sizeHintsFlags |= USPosition; flags |= WM_UPDATE_SIZE_HINTS; } } /* * Everything was parsed OK. Update the fields of *wmPtr and arrange for * the appropriate information to be percolated out to the window manager * at the next idle moment. */ wmPtr->width = width; wmPtr->height = height; wmPtr->x = x; wmPtr->y = y; flags |= WM_MOVE_PENDING; wmPtr->flags = flags; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } return TCL_OK; error: Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tk_GetRootCoords -- * * Given a token for a window, this function traces through the window's * lineage to find the (virtual) root-window coordinates corresponding to * point (0,0) in the window. * * Results: * The locations pointed to by xPtr and yPtr are filled in with the root * coordinates of the (0,0) point in tkwin. If a virtual root window is * in effect for the window, then the coordinates in the virtual root are * returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tk_GetRootCoords( Tk_Window tkwin, /* Token for window. */ int *xPtr, /* Where to store x-displacement of (0,0). */ int *yPtr) /* Where to store y-displacement of (0,0). */ { int x, y; register TkWindow *winPtr = (TkWindow *) tkwin; /* * Search back through this window's parents all the way to a top-level * window, combining the offsets of each window within its parent. */ x = y = 0; while (1) { x += winPtr->changes.x + winPtr->changes.border_width; y += winPtr->changes.y + winPtr->changes.border_width; if ((winPtr->wmInfoPtr != NULL) && (winPtr->wmInfoPtr->menubar == (Tk_Window) winPtr)) { /* * This window is a special menubar; switch over to its associated * toplevel, compensate for their differences in y coordinates, * then continue with the toplevel (in case it's embedded). */ y -= winPtr->wmInfoPtr->menuHeight; winPtr = winPtr->wmInfoPtr->winPtr; continue; } if (winPtr->flags & TK_TOP_LEVEL) { TkWindow *otherPtr; if (!(winPtr->flags & TK_EMBEDDED)) { break; } otherPtr = TkpGetOtherWindow(winPtr); if (otherPtr == NULL) { /* * The container window is not in the same application. Query * the X server. */ Window root, dummyChild; int rootX, rootY; root = winPtr->wmInfoPtr->vRoot; if (root == None) { root = RootWindowOfScreen(Tk_Screen((Tk_Window) winPtr)); } XTranslateCoordinates(winPtr->display, winPtr->window, root, 0, 0, &rootX, &rootY, &dummyChild); x += rootX; y += rootY; break; } else { /* * The container window is in the same application. Let's * query its coordinates. */ winPtr = otherPtr; continue; } } winPtr = winPtr->parentPtr; if (winPtr == NULL) { break; } } *xPtr = x; *yPtr = y; } /* *---------------------------------------------------------------------- * * Tk_CoordsToWindow -- * * Given the (virtual) root coordinates of a point, this function returns * the token for the top-most window covering that point, if there exists * such a window in this application. * * Results: * The return result is either a token for the window corresponding to * rootX and rootY, or else NULL to indicate that there is no such * window. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tk_Window Tk_CoordsToWindow( int rootX, int rootY, /* Coordinates of point in root window. If a * virtual-root window manager is in use, * these coordinates refer to the virtual * root, not the real root. */ Tk_Window tkwin) /* Token for any window in application; used * to identify the display. */ { Window window, parent, child; int x, y, childX, childY, tmpx, tmpy, bd; WmInfo *wmPtr; TkWindow *winPtr, *childPtr, *nextPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; Tk_ErrorHandler handler = NULL; /* * Step 1: scan the list of toplevel windows to see if there is a virtual * root for the screen we're interested in. If so, we have to translate * the coordinates from virtual root to root coordinates. */ parent = window = RootWindowOfScreen(Tk_Screen(tkwin)); x = rootX; y = rootY; for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { if (Tk_Screen(wmPtr->winPtr) != Tk_Screen(tkwin)) { continue; } if (wmPtr->vRoot == None) { continue; } UpdateVRootGeometry(wmPtr); parent = wmPtr->vRoot; break; } /* * Step 2: work down through the window hierarchy starting at the root. * For each window, find the child that contains the given point and then * see if this child is either a wrapper for one of our toplevel windows * or a window manager decoration window for one of our toplevels. This * approach handles several tricky cases: * * 1. There may be a virtual root window between the root and one of our * toplevels. * 2. If a toplevel is embedded, we may have to search through the * windows of the container application(s) before getting to the * toplevel. */ handler = Tk_CreateErrorHandler(Tk_Display(tkwin), -1, -1, -1, NULL, NULL); while (1) { if (XTranslateCoordinates(Tk_Display(tkwin), parent, window, x, y, &childX, &childY, &child) == False) { /* * We can end up here when the window is in the middle of being * deleted */ Tk_DeleteErrorHandler(handler); return NULL; } if (child == None) { Tk_DeleteErrorHandler(handler); return NULL; } for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { if (wmPtr->reparent == child) { goto gotToplevel; } if (wmPtr->wrapperPtr != NULL) { if (child == wmPtr->wrapperPtr->window) { goto gotToplevel; } } else if (child == wmPtr->winPtr->window) { goto gotToplevel; } } x = childX; y = childY; parent = window; window = child; } gotToplevel: if (handler) { /* * Check value of handler, because we can reach this label from above * or below */ Tk_DeleteErrorHandler(handler); handler = NULL; } winPtr = wmPtr->winPtr; if (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr) { return NULL; } /* * Step 3: at this point winPtr and wmPtr refer to the toplevel that * contains the given coordinates, and childX and childY give the * translated coordinates in the *parent* of the toplevel. Now decide * whether the coordinates are in the menubar or the actual toplevel, and * translate the coordinates into the coordinate system of that window. */ x = childX - winPtr->changes.x; y = childY - winPtr->changes.y; if ((x < 0) || (x >= winPtr->changes.width) || (y >= winPtr->changes.height)) { return NULL; } if (y < 0) { winPtr = (TkWindow *) wmPtr->menubar; if (winPtr == NULL) { return NULL; } y += wmPtr->menuHeight; if (y < 0) { return NULL; } } /* * Step 4: work down through the hierarchy underneath the current window. * At each level, scan through all the children to find the highest one in * the stacking order that contains the point. Then repeat the whole * process on that child. */ while (1) { nextPtr = NULL; for (childPtr = winPtr->childList; childPtr != NULL; childPtr = childPtr->nextPtr) { if (!Tk_IsMapped(childPtr) || (childPtr->flags & TK_TOP_HIERARCHY)) { continue; } if (childPtr->flags & TK_REPARENTED) { continue; } tmpx = x - childPtr->changes.x; tmpy = y - childPtr->changes.y; bd = childPtr->changes.border_width; if ((tmpx >= -bd) && (tmpy >= -bd) && (tmpx < (childPtr->changes.width + bd)) && (tmpy < (childPtr->changes.height + bd))) { nextPtr = childPtr; } } if (nextPtr == NULL) { break; } winPtr = nextPtr; x -= winPtr->changes.x; y -= winPtr->changes.y; if ((winPtr->flags & TK_CONTAINER) && (winPtr->flags & TK_BOTH_HALVES)) { /* * The window containing the point is a container, and the * embedded application is in this same process. Switch over to * the toplevel for the embedded application and start processing * that toplevel from scratch. */ winPtr = TkpGetOtherWindow(winPtr); if (winPtr == NULL) { return NULL; } wmPtr = winPtr->wmInfoPtr; childX = x; childY = y; goto gotToplevel; } } return (Tk_Window) winPtr; } /* *---------------------------------------------------------------------- * * UpdateVRootGeometry -- * * This function is called to update all the virtual root geometry * information in wmPtr. * * Results: * None. * * Side effects: * The vRootX, vRootY, vRootWidth, and vRootHeight fields in wmPtr are * filled with the most up-to-date information. * *---------------------------------------------------------------------- */ static void UpdateVRootGeometry( WmInfo *wmPtr) /* Window manager information to be updated. * The wmPtr->vRoot field must be valid. */ { TkWindow *winPtr = wmPtr->winPtr; int bd; unsigned int dummy; Window dummy2; Status status; Tk_ErrorHandler handler; /* * If this isn't a virtual-root window manager, just return information * about the screen. */ wmPtr->flags &= ~WM_VROOT_OFFSET_STALE; if (wmPtr->vRoot == None) { noVRoot: wmPtr->vRootX = wmPtr->vRootY = 0; wmPtr->vRootWidth = DisplayWidth(winPtr->display, winPtr->screenNum); wmPtr->vRootHeight = DisplayHeight(winPtr->display, winPtr->screenNum); return; } /* * Refresh the virtual root information if it's out of date. */ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, NULL, NULL); status = XGetGeometry(winPtr->display, wmPtr->vRoot, &dummy2, &wmPtr->vRootX, &wmPtr->vRootY, (unsigned int *) &wmPtr->vRootWidth, (unsigned int *) &wmPtr->vRootHeight, (unsigned int *) &bd, &dummy); if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("UpdateVRootGeometry: x = %d, y = %d, width = %d, ", wmPtr->vRootX, wmPtr->vRootY, wmPtr->vRootWidth); printf("height = %d, status = %d\n", wmPtr->vRootHeight, status); } Tk_DeleteErrorHandler(handler); if (status == 0) { /* * The virtual root is gone! Pretend that it never existed. */ wmPtr->vRoot = None; goto noVRoot; } } /* *---------------------------------------------------------------------- * * Tk_GetVRootGeometry -- * * This function returns information about the virtual root window * corresponding to a particular Tk window. * * Results: * The values at xPtr, yPtr, widthPtr, and heightPtr are set with the * offset and dimensions of the root window corresponding to tkwin. If * tkwin is being managed by a virtual root window manager these values * correspond to the virtual root window being used for tkwin; otherwise * the offsets will be 0 and the dimensions will be those of the screen. * * Side effects: * Vroot window information is refreshed if it is out of date. * *---------------------------------------------------------------------- */ void Tk_GetVRootGeometry( Tk_Window tkwin, /* Window whose virtual root is to be * queried. */ int *xPtr, int *yPtr, /* Store x and y offsets of virtual root * here. */ int *widthPtr, int *heightPtr) /* Store dimensions of virtual root here. */ { WmInfo *wmPtr; TkWindow *winPtr = (TkWindow *) tkwin; /* * Find the top-level window for tkwin, and locate the window manager * information for that window. */ while (!(winPtr->flags & TK_TOP_HIERARCHY) && (winPtr->parentPtr != NULL)) { winPtr = winPtr->parentPtr; } wmPtr = winPtr->wmInfoPtr; if (wmPtr == NULL) { /* Punt. */ *xPtr = 0; *yPtr = 0; *widthPtr = 0; *heightPtr = 0; } /* * Make sure that the geometry information is up-to-date, then copy it out * to the caller. */ if (wmPtr->flags & WM_VROOT_OFFSET_STALE) { UpdateVRootGeometry(wmPtr); } *xPtr = wmPtr->vRootX; *yPtr = wmPtr->vRootY; *widthPtr = wmPtr->vRootWidth; *heightPtr = wmPtr->vRootHeight; } /* *---------------------------------------------------------------------- * * Tk_MoveToplevelWindow -- * * This function is called instead of Tk_MoveWindow to adjust the x-y * location of a top-level window. It delays the actual move to a later * time and keeps window-manager information up-to-date with the move * * Results: * None. * * Side effects: * The window is eventually moved so that its upper-left corner * (actually, the upper-left corner of the window's decorative frame, if * there is one) is at (x,y). * *---------------------------------------------------------------------- */ void Tk_MoveToplevelWindow( Tk_Window tkwin, /* Window to move. */ int x, int y) /* New location for window (within parent). */ { TkWindow *winPtr = (TkWindow *) tkwin; register WmInfo *wmPtr = winPtr->wmInfoPtr; if (!(winPtr->flags & TK_TOP_LEVEL)) { Tcl_Panic("Tk_MoveToplevelWindow called with non-toplevel window"); } wmPtr->x = x; wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { wmPtr->sizeHintsFlags |= USPosition; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } /* * If the window has already been mapped, must bring its geometry * up-to-date immediately, otherwise an event might arrive from the server * that would overwrite wmPtr->x and wmPtr->y and lose the new position. */ if (!(wmPtr->flags & WM_NEVER_MAPPED)) { if (wmPtr->flags & WM_UPDATE_PENDING) { Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); } UpdateGeometryInfo((ClientData) winPtr); } } /* *---------------------------------------------------------------------- * * UpdateWmProtocols -- * * This function transfers the most up-to-date information about window * manager protocols from the WmInfo structure to the actual property on * the top-level window. * * Results: * None. * * Side effects: * The WM_PROTOCOLS property gets changed for wmPtr's window. * *---------------------------------------------------------------------- */ static void UpdateWmProtocols( register WmInfo *wmPtr) /* Information about top-level window. */ { register ProtocolHandler *protPtr; Atom deleteWindowAtom, pingAtom; int count; Atom *arrayPtr, *atomPtr; /* * There are only two tricky parts here. First, there could be any number * of atoms for the window, so count them and malloc an array to hold all * of their atoms. Second, we *always* want to respond to the * WM_DELETE_WINDOW and _NET_WM_PING protocols, even if no-one's * officially asked. */ for (protPtr = wmPtr->protPtr, count = 2; protPtr != NULL; protPtr = protPtr->nextPtr, count++) { /* Empty loop body; we're just counting the handlers. */ } arrayPtr = (Atom *) ckalloc((unsigned) count * sizeof(Atom)); deleteWindowAtom = Tk_InternAtom((Tk_Window) wmPtr->winPtr, "WM_DELETE_WINDOW"); pingAtom = Tk_InternAtom((Tk_Window) wmPtr->winPtr, "_NET_WM_PING"); arrayPtr[0] = deleteWindowAtom; arrayPtr[1] = pingAtom; for (protPtr = wmPtr->protPtr, atomPtr = &arrayPtr[1]; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol != deleteWindowAtom && protPtr->protocol != pingAtom) { *(atomPtr++) = protPtr->protocol; } } XChangeProperty(wmPtr->winPtr->display, wmPtr->wrapperPtr->window, Tk_InternAtom((Tk_Window) wmPtr->winPtr, "WM_PROTOCOLS"), XA_ATOM, 32, PropModeReplace, (unsigned char *) arrayPtr, atomPtr-arrayPtr); ckfree((char *) arrayPtr); } /* *---------------------------------------------------------------------- * * TkWmProtocolEventProc -- * * This function is called by the Tk_HandleEvent whenever a ClientMessage * event arrives whose type is "WM_PROTOCOLS". This function handles the * message from the window manager in an appropriate fashion. * * Results: * None. * * Side effects: * Depends on what sort of handler, if any, was set up for the protocol. * *---------------------------------------------------------------------- */ void TkWmProtocolEventProc( TkWindow *winPtr, /* Window to which the event was sent. */ XEvent *eventPtr) /* X event. */ { WmInfo *wmPtr; register ProtocolHandler *protPtr; Atom protocol; int result; CONST char *protocolName; Tcl_Interp *interp; protocol = (Atom) eventPtr->xclient.data.l[0]; /* * If this is a _NET_WM_PING message, send it back to the root window * immediately. We do that here because scripts *cannot* respond correctly * to this protocol. */ if (protocol == Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_PING")) { Window root = XRootWindow(winPtr->display, winPtr->screenNum); eventPtr->xclient.window = root; (void) XSendEvent(winPtr->display, root, False, (SubstructureNotifyMask|SubstructureRedirectMask), eventPtr); return; } wmPtr = winPtr->wmInfoPtr; if (wmPtr == NULL) { return; } /* * Note: it's very important to retrieve the protocol name now, before * invoking the command, even though the name won't be used until after * the command returns. This is because the command could delete winPtr, * making it impossible for us to use it later in the call to * Tk_GetAtomName. */ protocolName = Tk_GetAtomName((Tk_Window) winPtr, protocol); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protocol == protPtr->protocol) { Tcl_Preserve((ClientData) protPtr); interp = protPtr->interp; Tcl_Preserve((ClientData) interp); result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command for \""); Tcl_AddErrorInfo(interp, protocolName); Tcl_AddErrorInfo(interp, "\" window manager protocol)"); Tcl_BackgroundError(interp); } Tcl_Release((ClientData) interp); Tcl_Release((ClientData) protPtr); return; } } /* * No handler was present for this protocol. If this is a WM_DELETE_WINDOW * message then just destroy the window. */ if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) { Tk_DestroyWindow((Tk_Window) wmPtr->winPtr); } } /* *---------------------------------------------------------------------- * * TkWmStackorderToplevelWrapperMap -- * * This function will create a table that maps the reparent wrapper X id * for a toplevel to the TkWindow structure that is wraps. Tk keeps track * of a mapping from the window X id to the TkWindow structure but that * does us no good here since we only get the X id of the wrapper window. * Only those toplevel windows that are mapped have a position in the * stacking order. * * Results: * None. * * Side effects: * Adds entries to the passed hashtable. * *---------------------------------------------------------------------- */ static void TkWmStackorderToplevelWrapperMap( TkWindow *winPtr, /* TkWindow to recurse on */ Display *display, /* X display of parent window */ Tcl_HashTable *table) /* Maps X id to TkWindow */ { TkWindow *childPtr; if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) && !Tk_IsEmbedded(winPtr) && (winPtr->display == display)) { Window wrapper = (winPtr->wmInfoPtr->reparent != None) ? winPtr->wmInfoPtr->reparent : winPtr->wmInfoPtr->wrapperPtr->window; Tcl_HashEntry *hPtr; int newEntry; hPtr = Tcl_CreateHashEntry(table, (char *) wrapper, &newEntry); Tcl_SetHashValue(hPtr, winPtr); } for (childPtr = winPtr->childList; childPtr != NULL; childPtr = childPtr->nextPtr) { TkWmStackorderToplevelWrapperMap(childPtr, display, table); } } /* *---------------------------------------------------------------------- * * TkWmStackorderToplevel -- * * This function returns the stack order of toplevel windows. * * Results: * An array of pointers to tk window objects in stacking order or else * NULL if there was an error. * * Side effects: * None. * *---------------------------------------------------------------------- */ TkWindow ** TkWmStackorderToplevel( TkWindow *parentPtr) /* Parent toplevel window. */ { Window dummy1, dummy2, vRoot; Window *children; unsigned int numChildren, i; TkWindow *childWinPtr, **windows, **window_ptr; Tcl_HashTable table; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * Map X Window ids to a TkWindow of the wrapped toplevel. */ Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS); TkWmStackorderToplevelWrapperMap(parentPtr, parentPtr->display, &table); window_ptr = windows = (TkWindow **) ckalloc((table.numEntries+1) * sizeof(TkWindow *)); /* * Special cases: If zero or one toplevels were mapped there is no need to * call XQueryTree. */ switch (table.numEntries) { case 0: windows[0] = NULL; goto done; case 1: hPtr = Tcl_FirstHashEntry(&table, &search); windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr); windows[1] = NULL; goto done; } vRoot = parentPtr->wmInfoPtr->vRoot; if (vRoot == None) { vRoot = RootWindowOfScreen(Tk_Screen((Tk_Window) parentPtr)); } if (XQueryTree(parentPtr->display, vRoot, &dummy1, &dummy2, &children, &numChildren) == 0) { ckfree((char *) windows); windows = NULL; } else { for (i = 0; i < numChildren; i++) { hPtr = Tcl_FindHashEntry(&table, (char *) children[i]); if (hPtr != NULL) { childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr); *window_ptr++ = childWinPtr; } } /* ASSERT: window_ptr - windows == table.numEntries * (#matched toplevel windows == #children) [Bug 1789819] */ *window_ptr = NULL; if (numChildren) { XFree((char *) children); } } done: Tcl_DeleteHashTable(&table); return windows; } /* *---------------------------------------------------------------------- * * TkWmRestackToplevel -- * * This function restacks a top-level window. * * Results: * None. * * Side effects: * WinPtr gets restacked as specified by aboveBelow and otherPtr. * *---------------------------------------------------------------------- */ void TkWmRestackToplevel( TkWindow *winPtr, /* Window to restack. */ int aboveBelow, /* Gives relative position for restacking; * must be Above or Below. */ TkWindow *otherPtr) /* Window relative to which to restack; if * NULL, then winPtr gets restacked above or * below *all* siblings. */ { XWindowChanges changes; unsigned int mask; TkWindow *wrapperPtr; memset(&changes, 0, sizeof(XWindowChanges)); changes.stack_mode = aboveBelow; mask = CWStackMode; /* * Make sure that winPtr and its wrapper window have been created. */ if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) { TkWmMapWindow(winPtr); } wrapperPtr = winPtr->wmInfoPtr->wrapperPtr; if (otherPtr != NULL) { /* * The window is to be restacked with respect to another toplevel. * Make sure it has been created as well. */ if (otherPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) { TkWmMapWindow(otherPtr); } changes.sibling = otherPtr->wmInfoPtr->wrapperPtr->window; mask |= CWSibling; } /* * Reconfigure the window. Note that we use XReconfigureWMWindow instead * of XConfigureWindow, in order to handle the case where the window is to * be restacked with respect to another toplevel. See [ICCCM] 4.1.5 * "Configuring the Window" and XReconfigureWMWindow(3) for details. */ XReconfigureWMWindow(winPtr->display, wrapperPtr->window, Tk_ScreenNumber((Tk_Window) winPtr), mask, &changes); } /* *---------------------------------------------------------------------- * * TkWmAddToColormapWindows -- * * This function is called to add a given window to the * WM_COLORMAP_WINDOWS property for its top-level, if it isn't already * there. It is invoked by the Tk code that creates a new colormap, in * order to make sure that colormap information is propagated to the * window manager by default. * * Results: * None. * * Side effects: * WinPtr's window gets added to the WM_COLORMAP_WINDOWS property of its * nearest top-level ancestor, unless the colormaps have been set * explicitly with the "wm colormapwindows" command. * *---------------------------------------------------------------------- */ void TkWmAddToColormapWindows( TkWindow *winPtr) /* Window with a non-default colormap. Should * not be a top-level window. */ { TkWindow *wrapperPtr; TkWindow *topPtr; Window *oldPtr, *newPtr; int count, i; if (winPtr->window == None) { return; } for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) { if (topPtr == NULL) { /* * Window is being deleted. Skip the whole operation. */ return; } if (topPtr->flags & TK_TOP_HIERARCHY) { break; } } if (topPtr->wmInfoPtr == NULL) { return; } if (topPtr->wmInfoPtr->flags & WM_COLORMAPS_EXPLICIT) { return; } if (topPtr->wmInfoPtr->wrapperPtr == NULL) { CreateWrapper(topPtr->wmInfoPtr); } wrapperPtr = topPtr->wmInfoPtr->wrapperPtr; /* * Fetch the old value of the property. */ if (XGetWMColormapWindows(topPtr->display, wrapperPtr->window, &oldPtr, &count) == 0) { oldPtr = NULL; count = 0; } /* * Make sure that the window isn't already in the list. */ for (i = 0; i < count; i++) { if (oldPtr[i] == winPtr->window) { return; } } /* * Make a new bigger array and use it to reset the property. Automatically * add the toplevel itself as the last element of the list. */ newPtr = (Window *) ckalloc((unsigned) (count+2) * sizeof(Window)); for (i = 0; i < count; i++) { newPtr[i] = oldPtr[i]; } if (count == 0) { count++; } newPtr[count-1] = winPtr->window; newPtr[count] = topPtr->window; XSetWMColormapWindows(topPtr->display, wrapperPtr->window, newPtr, count+1); ckfree((char *) newPtr); if (oldPtr != NULL) { XFree((char *) oldPtr); } } /* *---------------------------------------------------------------------- * * TkWmRemoveFromColormapWindows -- * * This function is called to remove a given window from the * WM_COLORMAP_WINDOWS property for its top-level. It is invoked when * windows are deleted. * * Results: * None. * * Side effects: * WinPtr's window gets removed from the WM_COLORMAP_WINDOWS property of * its nearest top-level ancestor, unless the top-level itself is being * deleted too. * *---------------------------------------------------------------------- */ void TkWmRemoveFromColormapWindows( TkWindow *winPtr) /* Window that may be present in * WM_COLORMAP_WINDOWS property for its * top-level. Should not be a top-level * window. */ { TkWindow *wrapperPtr; TkWindow *topPtr; Window *oldPtr; int count, i, j; if (winPtr->window == None) { return; } for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) { if (topPtr == NULL) { /* * Ancestors have been deleted, so skip the whole operation. * Seems like this can't ever happen? */ return; } if (topPtr->flags & TK_TOP_HIERARCHY) { break; } } if (topPtr->flags & TK_ALREADY_DEAD) { /* * Top-level is being deleted, so there's no need to cleanup the * WM_COLORMAP_WINDOWS property. */ return; } if (topPtr->wmInfoPtr == NULL) { return; } if (topPtr->wmInfoPtr->wrapperPtr == NULL) { CreateWrapper(topPtr->wmInfoPtr); } wrapperPtr = topPtr->wmInfoPtr->wrapperPtr; if (wrapperPtr == NULL) { return; } /* * Fetch the old value of the property. */ if (XGetWMColormapWindows(topPtr->display, wrapperPtr->window, &oldPtr, &count) == 0) { return; } /* * Find the window and slide the following ones down to cover it up. */ for (i = 0; i < count; i++) { if (oldPtr[i] == winPtr->window) { for (j = i ; j < count-1; j++) { oldPtr[j] = oldPtr[j+1]; } XSetWMColormapWindows(topPtr->display, wrapperPtr->window, oldPtr, count-1); break; } } XFree((char *) oldPtr); } /* *---------------------------------------------------------------------- * * TkGetPointerCoords -- * * Fetch the position of the mouse pointer. * * Results: * *xPtr and *yPtr are filled in with the (virtual) root coordinates of * the mouse pointer for tkwin's display. If the pointer isn't on tkwin's * screen, then -1 values are returned for both coordinates. The argument * tkwin must be a toplevel window. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TkGetPointerCoords( Tk_Window tkwin, /* Toplevel window that identifies screen on * which lookup is to be done. */ int *xPtr, int *yPtr) /* Store pointer coordinates here. */ { TkWindow *winPtr = (TkWindow *) tkwin; WmInfo *wmPtr; Window w, root, child; int rootX, rootY; unsigned int mask; wmPtr = winPtr->wmInfoPtr; w = wmPtr->vRoot; if (w == None) { w = RootWindow(winPtr->display, winPtr->screenNum); } if (XQueryPointer(winPtr->display, w, &root, &child, &rootX, &rootY, xPtr, yPtr, &mask) != True) { *xPtr = -1; *yPtr = -1; } } /* *---------------------------------------------------------------------- * * GetMaxSize -- * * This function computes the current maxWidth and maxHeight values for a * window, taking into account the possibility that they may be * defaulted. * * Results: * The values at *maxWidthPtr and *maxHeightPtr are filled in with the * maximum allowable dimensions of wmPtr's window, in grid units. If no * maximum has been specified for the window, then this function computes * the largest sizes that will fit on the screen. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void GetMaxSize( WmInfo *wmPtr, /* Window manager information for the * window. */ int *maxWidthPtr, /* Where to store the current maximum width of * the window. */ int *maxHeightPtr) /* Where to store the current maximum height * of the window. */ { int tmp; if (wmPtr->maxWidth > 0) { *maxWidthPtr = wmPtr->maxWidth; } else { /* * Must compute a default width. Fill up the display, leaving a bit of * extra space for the window manager's borders. */ tmp = DisplayWidth(wmPtr->winPtr->display, wmPtr->winPtr->screenNum) - 15; if (wmPtr->gridWin != NULL) { /* * Gridding is turned on; convert from pixels to grid units. */ tmp = wmPtr->reqGridWidth + (tmp - wmPtr->winPtr->reqWidth)/wmPtr->widthInc; } *maxWidthPtr = tmp; } if (wmPtr->maxHeight > 0) { *maxHeightPtr = wmPtr->maxHeight; } else { tmp = DisplayHeight(wmPtr->winPtr->display, wmPtr->winPtr->screenNum) - 30; if (wmPtr->gridWin != NULL) { tmp = wmPtr->reqGridHeight + (tmp - wmPtr->winPtr->reqHeight)/wmPtr->heightInc; } *maxHeightPtr = tmp; } } /* *---------------------------------------------------------------------- * * TkSetTransientFor -- * * Set a Tk window to be transient with reference to a specified * parent or the toplevel ancestor if None is passed as parent. * *---------------------------------------------------------------------- */ static void TkSetTransientFor(Tk_Window tkwin, Tk_Window parent) { if (parent == None) { parent = Tk_Parent(tkwin); while (!Tk_IsTopLevel(parent)) parent = Tk_Parent(parent); } /* * Prevent crash due to incomplete initialization, or other problems. * [Bugs 3554026, 3561016] */ if (((TkWindow *)parent)->wmInfoPtr->wrapperPtr == NULL) { CreateWrapper(((TkWindow *)parent)->wmInfoPtr); } XSetTransientForHint(Tk_Display(tkwin), ((TkWindow *)tkwin)->wmInfoPtr->wrapperPtr->window, ((TkWindow *)parent)->wmInfoPtr->wrapperPtr->window); } /* *---------------------------------------------------------------------- * * TkpMakeMenuWindow -- * * Configure the window to be either a pull-down (or pop-up) menu, or as * a toplevel (torn-off) menu or palette. * * Results: * None. * * Side effects: * Changes the style bit used to create a new Mac toplevel. * *---------------------------------------------------------------------- */ void TkpMakeMenuWindow( Tk_Window tkwin, /* New window. */ int transient) /* 1 means menu is only posted briefly as a * popup or pulldown or cascade. 0 means menu * is always visible, e.g. as a torn-off menu. * Determines whether save_under and * override_redirect should be set. */ { WmInfo *wmPtr; XSetWindowAttributes atts; TkWindow *wrapperPtr; Tcl_Obj *typeObj; if (!Tk_HasWrapper(tkwin)) { return; } wmPtr = ((TkWindow *) tkwin)->wmInfoPtr; if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } wrapperPtr = wmPtr->wrapperPtr; if (transient) { atts.override_redirect = True; atts.save_under = True; typeObj = Tcl_NewStringObj("dropdown_menu", -1); } else { atts.override_redirect = False; atts.save_under = False; typeObj = Tcl_NewStringObj("menu", -1); TkSetTransientFor(tkwin, None); } SetNetWmType((TkWindow *)tkwin, typeObj); /* * The override-redirect and save-under bits must be set on the wrapper * window in order to have the desired effect. However, also set the * override-redirect bit on the window itself, so that the "wm * overrideredirect" command will see it. */ if ((atts.override_redirect!=Tk_Attributes(wrapperPtr)->override_redirect) || (atts.save_under != Tk_Attributes(wrapperPtr)->save_under)) { Tk_ChangeWindowAttributes((Tk_Window) wrapperPtr, CWOverrideRedirect|CWSaveUnder, &atts); } if (atts.override_redirect != Tk_Attributes(tkwin)->override_redirect) { Tk_ChangeWindowAttributes(tkwin, CWOverrideRedirect, &atts); } } /* *---------------------------------------------------------------------- * * CreateWrapper -- * * This function is invoked to create the wrapper window for a toplevel * window. It is called just before a toplevel is mapped for the first * time. * * Results: * None. * * Side effects: * The wrapper is created and the toplevel is reparented inside it. * *---------------------------------------------------------------------- */ static void CreateWrapper( WmInfo *wmPtr) /* Window manager information for the * window. */ { TkWindow *winPtr, *wrapperPtr; Window parent; Tcl_HashEntry *hPtr; int new; winPtr = wmPtr->winPtr; if (winPtr->window == None) { Tk_MakeWindowExist((Tk_Window) winPtr); } /* * The code below is copied from CreateTopLevelWindow, Tk_MakeWindowExist, * and TkpMakeWindow. The idea is to create an "official" Tk window (so * that we can get events on it), but to hide the window outside the * official Tk hierarchy so that it isn't visible to the application. See * the comments for the other functions if you have questions about this * code. */ wmPtr->wrapperPtr = wrapperPtr = TkAllocWindow(winPtr->dispPtr, Tk_ScreenNumber((Tk_Window) winPtr), winPtr); wrapperPtr->dirtyAtts |= CWBorderPixel; /* * Tk doesn't normally select for StructureNotifyMask events because the * events are synthesized internally. However, for wrapper windows we need * to know when the window manager modifies the window configuration. We * also need to select on focus change events; these are the only windows * for which we care about focus changes. */ wrapperPtr->flags |= TK_WRAPPER; wrapperPtr->atts.event_mask |= StructureNotifyMask|FocusChangeMask; wrapperPtr->atts.override_redirect = winPtr->atts.override_redirect; if (winPtr->flags & TK_EMBEDDED) { parent = TkUnixContainerId(winPtr); } else { parent = XRootWindow(wrapperPtr->display, wrapperPtr->screenNum); } wrapperPtr->window = XCreateWindow(wrapperPtr->display, parent, wrapperPtr->changes.x, wrapperPtr->changes.y, (unsigned) wrapperPtr->changes.width, (unsigned) wrapperPtr->changes.height, (unsigned) wrapperPtr->changes.border_width, wrapperPtr->depth, InputOutput, wrapperPtr->visual, wrapperPtr->dirtyAtts|CWOverrideRedirect, &wrapperPtr->atts); hPtr = Tcl_CreateHashEntry(&wrapperPtr->dispPtr->winTable, (char *) wrapperPtr->window, &new); Tcl_SetHashValue(hPtr, wrapperPtr); wrapperPtr->mainPtr = winPtr->mainPtr; wrapperPtr->mainPtr->refCount++; wrapperPtr->dirtyAtts = 0; wrapperPtr->dirtyChanges = 0; wrapperPtr->wmInfoPtr = wmPtr; /* * Reparent the toplevel window inside the wrapper. */ XReparentWindow(wrapperPtr->display, winPtr->window, wrapperPtr->window, 0, 0); /* * Tk must monitor structure events for wrapper windows in order to detect * changes made by window managers such as resizing, mapping, unmapping, * etc.. */ Tk_CreateEventHandler((Tk_Window) wmPtr->wrapperPtr, WrapperEventMask, WrapperEventProc, (ClientData) wmPtr); } /* *---------------------------------------------------------------------- * * TkWmFocusToplevel -- * * This is a utility function invoked by focus-management code. The focus * code responds to externally generated focus-related events on wrapper * windows but ignores those events for any other windows. This function * determines whether a given window is a wrapper window and, if so, * returns the toplevel window corresponding to the wrapper. * * Results: * If winPtr is a wrapper window, returns a pointer to the corresponding * toplevel window; otherwise returns NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ TkWindow * TkWmFocusToplevel( TkWindow *winPtr) /* Window that received a focus-related * event. */ { if (!(winPtr->flags & TK_WRAPPER)) { return NULL; } return winPtr->wmInfoPtr->winPtr; } /* *---------------------------------------------------------------------- * * TkUnixSetMenubar -- * * This function is invoked by menu management code to specify the window * to use as a menubar for a given toplevel window. * * Results: * None. * * Side effects: * The window given by menubar will be mapped and positioned inside the * wrapper for tkwin and above tkwin. Menubar will automatically be * resized to maintain the height specified by TkUnixSetMenuHeight the * same width as tkwin. Any previous menubar specified for tkwin will be * unmapped and ignored from now on. * *---------------------------------------------------------------------- */ void TkUnixSetMenubar( Tk_Window tkwin, /* Token for toplevel window. */ Tk_Window menubar) /* Token for window that is to serve as * menubar for tkwin. Must not be a toplevel * window. If NULL, any existing menubar is * canceled and the menu height is reset to * 0. */ { WmInfo *wmPtr = ((TkWindow *) tkwin)->wmInfoPtr; Tk_Window parent; TkWindow *menubarPtr = (TkWindow *) menubar; /* Could be a Frame (i.e. not a toplevel) */ if (wmPtr == NULL) return; if (wmPtr->menubar != NULL) { /* * There's already a menubar for this toplevel. If it isn't the same * as the new menubar, unmap it so that it is out of the way, and * reparent it back to its original parent. */ if (wmPtr->menubar == menubar) { return; } ((TkWindow *) wmPtr->menubar)->wmInfoPtr = NULL; ((TkWindow *) wmPtr->menubar)->flags &= ~TK_REPARENTED; Tk_UnmapWindow(wmPtr->menubar); parent = Tk_Parent(wmPtr->menubar); if (parent != NULL) { Tk_MakeWindowExist(parent); XReparentWindow(Tk_Display(wmPtr->menubar), Tk_WindowId(wmPtr->menubar), Tk_WindowId(parent), 0, 0); } Tk_DeleteEventHandler(wmPtr->menubar, StructureNotifyMask, MenubarDestroyProc, (ClientData) wmPtr->menubar); Tk_ManageGeometry(wmPtr->menubar, NULL, NULL); } wmPtr->menubar = menubar; if (menubar == NULL) { wmPtr->menuHeight = 0; } else { if ((menubarPtr->flags & TK_TOP_LEVEL) || (Tk_Screen(menubar) != Tk_Screen(tkwin))) { Tcl_Panic("TkUnixSetMenubar got bad menubar"); } wmPtr->menuHeight = Tk_ReqHeight(menubar); if (wmPtr->menuHeight == 0) { wmPtr->menuHeight = 1; } Tk_MakeWindowExist(tkwin); Tk_MakeWindowExist(menubar); if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } XReparentWindow(Tk_Display(menubar), Tk_WindowId(menubar), wmPtr->wrapperPtr->window, 0, 0); menubarPtr->wmInfoPtr = wmPtr; Tk_MoveResizeWindow(menubar, 0, 0, Tk_Width(tkwin), wmPtr->menuHeight); Tk_MapWindow(menubar); Tk_CreateEventHandler(menubar, StructureNotifyMask, MenubarDestroyProc, (ClientData) menubar); Tk_ManageGeometry(menubar, &menubarMgrType, (ClientData) wmPtr); menubarPtr->flags |= TK_REPARENTED; } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) tkwin); wmPtr->flags |= WM_UPDATE_PENDING; } } /* *---------------------------------------------------------------------- * * MenubarDestroyProc -- * * This function is invoked by the event dispatcher whenever a menubar * window is destroyed (it's also invoked for a few other kinds of * events, but we ignore those). * * Results: * None. * * Side effects: * The association between the window and its toplevel is broken, so that * the window is no longer considered to be a menubar. * *---------------------------------------------------------------------- */ static void MenubarDestroyProc( ClientData clientData, /* TkWindow pointer for menubar. */ XEvent *eventPtr) /* Describes what just happened. */ { WmInfo *wmPtr; if (eventPtr->type != DestroyNotify) { return; } wmPtr = ((TkWindow *) clientData)->wmInfoPtr; wmPtr->menubar = NULL; wmPtr->menuHeight = 0; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } /* *---------------------------------------------------------------------- * * MenubarReqProc -- * * This function is invoked by the Tk geometry management code whenever a * menubar calls Tk_GeometryRequest to request a new size. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void MenubarReqProc( ClientData clientData, /* Pointer to the window manager information * for tkwin's toplevel. */ Tk_Window tkwin) /* Handle for menubar window. */ { WmInfo *wmPtr = (WmInfo *) clientData; wmPtr->menuHeight = Tk_ReqHeight(tkwin); if (wmPtr->menuHeight <= 0) { wmPtr->menuHeight = 1; } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } /* *---------------------------------------------------------------------- * * TkpGetWrapperWindow -- * * Given a toplevel window return the hidden wrapper window for the * toplevel window if available. * * Results: * The wrapper window. NULL is we were not passed a toplevel window or * the wrapper has yet to be created. * * Side effects: * None. * *---------------------------------------------------------------------- */ TkWindow * TkpGetWrapperWindow( TkWindow *winPtr) /* A toplevel window pointer. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; if ((winPtr == NULL) || (wmPtr == NULL)) { return NULL; } return wmPtr->wrapperPtr; } /* *---------------------------------------------------------------------- * * UpdateCommand -- * * Update the WM_COMMAND property, taking care to translate the command * strings into the external encoding. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void UpdateCommand( TkWindow *winPtr) { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tcl_DString cmds, ds; int i, *offsets; char **cmdArgv; /* * Translate the argv strings into the external encoding. To avoid * allocating lots of memory, the strings are appended to a buffer with * nulls between each string. * * This code is tricky because we need to pass and array of pointers to * XSetCommand. However, we can't compute the pointers as we go because * the DString buffer space could get reallocated. So, store offsets for * each element as we go, then compute pointers from the offsets once the * entire DString is done. */ cmdArgv = (char **) ckalloc(sizeof(char *) * wmPtr->cmdArgc); offsets = (int *) ckalloc(sizeof(int) * wmPtr->cmdArgc); Tcl_DStringInit(&cmds); for (i = 0; i < wmPtr->cmdArgc; i++) { Tcl_UtfToExternalDString(NULL, wmPtr->cmdArgv[i], -1, &ds); offsets[i] = Tcl_DStringLength(&cmds); Tcl_DStringAppend(&cmds, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)+1); Tcl_DStringFree(&ds); } cmdArgv[0] = Tcl_DStringValue(&cmds); for (i = 1; i < wmPtr->cmdArgc; i++) { cmdArgv[i] = cmdArgv[0] + offsets[i]; } XSetCommand(winPtr->display, wmPtr->wrapperPtr->window, cmdArgv, wmPtr->cmdArgc); Tcl_DStringFree(&cmds); ckfree((char *) cmdArgv); ckfree((char *) offsets); } /* *---------------------------------------------------------------------- * * TkpWmSetState -- * * Sets the window manager state for the wrapper window of a given * toplevel window. * * Results: * 0 on error, 1 otherwise * * Side effects: * May minimize, restore, or withdraw a window. * *---------------------------------------------------------------------- */ int TkpWmSetState( TkWindow *winPtr, /* Toplevel window to operate on. */ int state) /* One of IconicState, NormalState, or * WithdrawnState. */ { WmInfo *wmPtr = winPtr->wmInfoPtr; if (state == WithdrawnState) { wmPtr->hints.initial_state = WithdrawnState; wmPtr->withdrawn = 1; if (wmPtr->flags & WM_NEVER_MAPPED) { return 1; } if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window, winPtr->screenNum) == 0) { return 0; } WaitForMapNotify(winPtr, 0); } else if (state == NormalState) { wmPtr->hints.initial_state = NormalState; wmPtr->withdrawn = 0; if (wmPtr->flags & WM_NEVER_MAPPED) { return 1; } UpdateHints(winPtr); Tk_MapWindow((Tk_Window) winPtr); } else if (state == IconicState) { wmPtr->hints.initial_state = IconicState; if (wmPtr->flags & WM_NEVER_MAPPED) { return 1; } if (wmPtr->withdrawn) { UpdateHints(winPtr); Tk_MapWindow((Tk_Window) winPtr); wmPtr->withdrawn = 0; } else { if (XIconifyWindow(winPtr->display, wmPtr->wrapperPtr->window, winPtr->screenNum) == 0) { return 0; } WaitForMapNotify(winPtr, 0); } } return 1; } /* *---------------------------------------------------------------------- * * RemapWindows * * Adjust parent/child relation ships of * the given window hierarchy. * * Results: * none * * Side effects: * keeps windowing system (X11) happy * *---------------------------------------------------------------------- */ static void RemapWindows(winPtr, parentPtr) TkWindow *winPtr; TkWindow *parentPtr; { XWindowAttributes win_attr; if (winPtr->window) { XGetWindowAttributes(winPtr->display, winPtr->window, &win_attr); if (parentPtr == NULL) { XReparentWindow(winPtr->display, winPtr->window, XRootWindow(winPtr->display, winPtr->screenNum), win_attr.x, win_attr.y); } else if (parentPtr->window) { XReparentWindow(parentPtr->display, winPtr->window, parentPtr->window, win_attr.x, win_attr.y); } } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkConfig.h.in0000644003604700454610000001501612656405252014071 0ustar dgp771div/* ../unix/tkConfig.h.in. Generated from configure.ac by autoheader. */ #ifndef _TKCONFIG #define _TKCONFIG /* Is pthread_attr_get_np() declared in ? */ #undef ATTRGETNP_NOT_DECLARED /* Is pthread_getattr_np declared in ? */ #undef GETATTRNP_NOT_DECLARED /* Define to 1 if you have the header file. */ #undef HAVE_AVAILABILITYMACROS_H /* Defined when compiler supports casting to union type. */ #undef HAVE_CAST_TO_UNION /* Do we have access to Darwin CoreFoundation.framework? */ #undef HAVE_COREFOUNDATION /* Do we have the intptr_t type? */ #undef HAVE_INTPTR_T /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the `Xft' library (-lXft). */ #undef HAVE_LIBXFT /* Do we have ? */ #undef HAVE_LIMITS_H /* Define to 1 if you have the `lseek64' function. */ #undef HAVE_LSEEK64 /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the `open64' function. */ #undef HAVE_OPEN64 /* Define to 1 if you have the `pthread_atfork' function. */ #undef HAVE_PTHREAD_ATFORK /* Do we want a BSD-like thread-attribute interface? */ #undef HAVE_PTHREAD_ATTR_GET_NP /* Define to 1 if you have the `pthread_attr_setstacksize' function. */ #undef HAVE_PTHREAD_ATTR_SETSTACKSIZE /* Do we want a Linux-like thread-attribute interface? */ #undef HAVE_PTHREAD_GETATTR_NP /* Define to 1 if you have the `pthread_get_stacksize_np' function. */ #undef HAVE_PTHREAD_GET_STACKSIZE_NP /* Does struct password have a pw_gecos field? */ #undef HAVE_PW_GECOS /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Is 'struct dirent64' in ? */ #undef HAVE_STRUCT_DIRENT64 /* Is 'struct stat64' in ? */ #undef HAVE_STRUCT_STAT64 /* Should we include ? */ #undef HAVE_SYS_SELECT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Is off64_t in ? */ #undef HAVE_TYPE_OFF64_T /* Do we have the uintptr_t type? */ #undef HAVE_UINTPTR_T /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Is weak import available? */ #undef HAVE_WEAK_IMPORT /* Have we turned on XFT (antialiased fonts)? */ #undef HAVE_XFT /* Do we have XkbKeycodeToKeysym? */ #undef HAVE_XKBKEYCODETOKEYSYM /* Is XScreenSaver available? */ #undef HAVE_XSS /* Is this a Mac I see before me? */ #undef MAC_OSX_TCL /* Are we building TkAqua? */ #undef MAC_OSX_TK /* Compiler support for module scope symbols */ #undef MODULE_SCOPE /* Is no debugging enabled? */ #undef NDEBUG /* Is Darwin CoreFoundation unavailable for 64-bit? */ #undef NO_COREFOUNDATION_64 /* Do we have fd_set? */ #undef NO_FD_SET /* Do we have ? */ #undef NO_LIMITS_H /* Do we have ? */ #undef NO_STDLIB_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* Is this a static build? */ #undef STATIC_BUILD /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Is this a 64-bit build? */ #undef TCL_CFG_DO64BIT /* Is this an optimized build? */ #undef TCL_CFG_OPTIMIZED /* Is bytecode debugging enabled? */ #undef TCL_COMPILE_DEBUG /* Are bytecode statistics enabled? */ #undef TCL_COMPILE_STATS /* Is memory debugging enabled? */ #undef TCL_MEM_DEBUG /* What is the default extension for shared libraries? */ #undef TCL_SHLIB_EXT /* Are we building with threads enabled? */ #undef TCL_THREADS /* Are wide integers to be implemented with C 'long's? */ #undef TCL_WIDE_INT_IS_LONG /* What type should be used to define wide integers? */ #undef TCL_WIDE_INT_TYPE /* Define to 1 if you can safely include both and . */ #undef TIME_WITH_SYS_TIME /* Is Tk built as a framework? */ #undef TK_FRAMEWORK /* Are TkAqua debug messages enabled? */ #undef TK_MAC_DEBUG /* Do we want to use the threaded memory allocator? */ #undef USE_THREAD_ALLOC /* Define to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel and VAX). */ #undef WORDS_BIGENDIAN /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE /* Add the _ISOC99_SOURCE flag when building */ #undef _ISOC99_SOURCE /* Add the _LARGEFILE64_SOURCE flag when building */ #undef _LARGEFILE64_SOURCE /* Add the _LARGEFILE_SOURCE64 flag when building */ #undef _LARGEFILE_SOURCE64 /* # needed in sys/socket.h Should OS/390 do the right thing with sockets? */ #undef _OE_SOCKETS /* Do we really want to follow the standard? Yes we do! */ #undef _POSIX_PTHREAD_SEMANTICS /* Do we want the reentrant OS API? */ #undef _REENTRANT /* Do we want the thread-safe OS API? */ #undef _THREAD_SAFE /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE_EXTENDED /* Define to 1 if type `char' is unsigned and you are not using gcc. */ #ifndef __CHAR_UNSIGNED__ # undef __CHAR_UNSIGNED__ #endif /* Define to `int' if doesn't define. */ #undef gid_t /* Signed integer type wide enough to hold a pointer. */ #undef intptr_t /* Define to `int' if does not define. */ #undef mode_t /* Define to `int' if does not define. */ #undef pid_t /* Define to `unsigned' if does not define. */ #undef size_t /* Do we want to use the strtod() in compat? */ #undef strtod /* Define to `int' if doesn't define. */ #undef uid_t /* Unsigned integer type wide enough to hold a pointer. */ #undef uintptr_t /* Undef unused package specific autoheader defines so that we can * include both tclConfig.h and tkConfig.h at the same time: */ /* override */ #undef PACKAGE_NAME /* override */ #undef PACKAGE_STRING /* override */ #undef PACKAGE_TARNAME #endif /* _TKCONFIG */ tk8.5.19/unix/tkUnixDialog.c0000644003604700454610000001203012612445655014311 0ustar dgp771div/* * tkUnixDialog.c -- * * Contains the Unix implementation of the common dialog boxes: * * Copyright (c) 1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" /* * The wrapper code for Unix is actually set up in library/tk.tcl these days; * the procedure names used here are probably wrong too... */ #ifdef TK_OBSOLETE_UNIX_DIALOG_WRAPPERS /* *---------------------------------------------------------------------- * * EvalObjv -- * * Invokes the Tcl procedure with the arguments. * * Results: * Returns the result of the evaluation of the command. * * Side effects: * The command may be autoloaded. * *---------------------------------------------------------------------- */ static int EvalObjv( Tcl_Interp *interp, /* Current interpreter. */ char *cmdName, /* Name of the TCL command to call */ int objc, /* Number of arguments. */ Tcl_Obj *CONST *objv) /* Arguments. */ { Tcl_Obj *cmdObj, **objs; int result; cmdObj = Tcl_NewStringObj(cmdName, -1); Tcl_IncrRefCount(cmdObj); objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * (unsigned)(objc+1)); objs[0] = cmdObj; memcpy(objs+1, objv, sizeof(Tcl_Obj *) * (unsigned)objc); result = Tcl_EvalObjv(interp, objc+1, objs, 0); Tcl_DecrRefCount(cmdObj); ckfree((char *) objs); return result; } /* *---------------------------------------------------------------------- * * Tk_ChooseColorObjCmd -- * * This procedure implements the color dialog box for the Unix platform. * See the user documentation for details on what it does. * * Results: * See user documentation. * * Side effects: * A dialog window is created the first time this procedure is called. * This window is not destroyed and will be reused the next time the * application invokes the "tk_chooseColor" command. * *---------------------------------------------------------------------- */ int Tk_ChooseColorObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST *objv) /* Arguments. */ { return EvalObjv(interp, "tk::ColorDialog", objc-1, objv+1); } /* *---------------------------------------------------------------------- * * Tk_GetOpenFileCmd -- * * This procedure implements the "open file" dialog box for the Unix * platform. See the user documentation for details on what it does. * * Results: * See user documentation. * * Side effects: * A dialog window is created the first this procedure is called. This * window is not destroyed and will be reused the next time the * application invokes the "tk_getOpenFile" or "tk_getSaveFile" command. * *---------------------------------------------------------------------- */ int Tk_GetOpenFileObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST *objv) /* Arguments. */ { Tk_Window tkwin = (Tk_Window)clientData; if (Tk_StrictMotif(tkwin)) { return EvalObjv(interp, "tk::MotifOpenFDialog", objc-1, objv+1); } else { return EvalObjv(interp, "tk::OpenFDialog", objc-1, objv+1); } } /* *---------------------------------------------------------------------- * * Tk_GetSaveFileCmd -- * * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box instead. * * Results: * Same as Tk_GetOpenFileCmd. * * Side effects: * Same as Tk_GetOpenFileCmd. * *---------------------------------------------------------------------- */ int Tk_GetSaveFileObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST *objv) /* Arguments. */ { Tk_Window tkwin = (Tk_Window)clientData; if (Tk_StrictMotif(tkwin)) { return EvalObjv(interp, "tk::MotifSaveFDialog", objc-1, objv+1); } else { return EvalObjv(interp, "tk::SaveFDialog", objc-1, objv+1); } } /* *---------------------------------------------------------------------- * * Tk_MessageBoxCmd -- * * This procedure implements the MessageBox window for the Unix * platform. See the user documentation for details on what it does. * * Results: * See user documentation. * * Side effects: * None. The MessageBox window will be destroy before this procedure * returns. * *---------------------------------------------------------------------- */ int Tk_MessageBoxCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST *objv) /* Arguments. */ { return EvalObjv(interp, "tk::MessageBox", objc-1, objv+1); } #endif /* TK_OBSOLETE_UNIX_DIALOG_WRAPPERS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixMenubu.c0000644003604700454610000003252612612445655014361 0ustar dgp771div/* * tkUnixMenubu.c -- * * This file implements the Unix specific portion of the menubutton * widget. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" #include "tkMenubutton.h" /* * The structure below defines menubutton class behavior by means of functions * that can be invoked from generic window code. */ Tk_ClassProcs tkpMenubuttonClass = { sizeof(Tk_ClassProcs), /* size */ TkMenuButtonWorldChanged, /* worldChangedProc */ NULL, NULL }; /* *---------------------------------------------------------------------- * * TkpCreateMenuButton -- * * Allocate a new TkMenuButton structure. * * Results: * Returns a newly allocated TkMenuButton structure. * * Side effects: * Registers an event handler for the widget. * *---------------------------------------------------------------------- */ TkMenuButton * TkpCreateMenuButton( Tk_Window tkwin) { return (TkMenuButton *)ckalloc(sizeof(TkMenuButton)); } /* *---------------------------------------------------------------------- * * TkpDisplayMenuButton -- * * This function is invoked to display a menubutton widget. * * Results: * None. * * Side effects: * Commands are output to X to display the menubutton in its current * mode. * *---------------------------------------------------------------------- */ void TkpDisplayMenuButton( ClientData clientData) /* Information about widget. */ { register TkMenuButton *mbPtr = (TkMenuButton *) clientData; GC gc; Tk_3DBorder border; Pixmap pixmap; int x = 0; /* Initialization needed only to stop compiler * warning. */ int y = 0; register Tk_Window tkwin = mbPtr->tkwin; int fullWidth, fullHeight; int textXOffset, textYOffset; int imageWidth, imageHeight; int imageXOffset, imageYOffset; int width = 0, height = 0; /* Image information that will be used to * restrict disabled pixmap as well */ int haveImage = 0, haveText = 0; mbPtr->flags &= ~REDRAW_PENDING; if ((mbPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { return; } if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) { gc = mbPtr->disabledGC; border = mbPtr->normalBorder; } else if ((mbPtr->state == STATE_ACTIVE) && !Tk_StrictMotif(mbPtr->tkwin)) { gc = mbPtr->activeTextGC; border = mbPtr->activeBorder; } else { gc = mbPtr->normalTextGC; 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; } imageWidth = width; imageHeight = height; haveText = (mbPtr->textWidth != 0 && mbPtr->textHeight != 0); /* * In order to avoid screen flashes, this function redraws the menu button * in a pixmap, then copies the pixmap to the screen in a single * operation. This means that there's no point in time where the on-sreen * image has been cleared. */ pixmap = Tk_GetPixmap(mbPtr->display, Tk_WindowId(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); Tk_Fill3DRectangle(tkwin, pixmap, 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); imageXOffset += x; imageYOffset += y; if (mbPtr->image != NULL) { Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } else if (mbPtr->bitmap != None) { XSetClipOrigin(mbPtr->display, gc, imageXOffset, imageYOffset); XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap, gc, 0, 0, (unsigned) width, (unsigned) height, imageXOffset, imageYOffset, 1); XSetClipOrigin(mbPtr->display, gc, 0, 0); } 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 if (haveImage) { TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0, width + mbPtr->indicatorWidth, height, &x, &y); imageXOffset += x; imageYOffset += y; if (mbPtr->image != NULL) { Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } else if (mbPtr->bitmap != None) { XSetClipOrigin(mbPtr->display, gc, x, y); XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap, gc, 0, 0, (unsigned) width, (unsigned) height, x, y, 1); XSetClipOrigin(mbPtr->display, gc, 0, 0); } } 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); } /* * If the menu button is disabled with a stipple rather than a special * foreground color, generate the stippled effect. */ if ((mbPtr->state == STATE_DISABLED) && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) { /* * Stipple the whole button if no disabledFg was specified, otherwise * restrict stippling only to displayed image */ if (mbPtr->disabledFg == NULL) { XFillRectangle(mbPtr->display, pixmap, mbPtr->stippleGC, mbPtr->inset, mbPtr->inset, (unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset), (unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset)); } else { XFillRectangle(mbPtr->display, pixmap, mbPtr->stippleGC, imageXOffset, imageYOffset, (unsigned) imageWidth, (unsigned) imageHeight); } } /* * Draw the cascade indicator for the menu button on the right side of the * window, if desired. */ if (mbPtr->indicatorOn) { int borderWidth; borderWidth = (mbPtr->indicatorHeight+1)/3; if (borderWidth < 1) { borderWidth = 1; } /*y += mbPtr->textHeight / 2;*/ Tk_Fill3DRectangle(tkwin, pixmap, border, Tk_Width(tkwin) - mbPtr->inset - mbPtr->indicatorWidth + mbPtr->indicatorHeight, ((int) (Tk_Height(tkwin) - mbPtr->indicatorHeight))/2, mbPtr->indicatorWidth - 2*mbPtr->indicatorHeight, mbPtr->indicatorHeight, borderWidth, TK_RELIEF_RAISED); } /* * Draw the border and traversal highlight last. This way, if the menu * button's contents overflow onto the border they'll be covered up by the * border. */ if (mbPtr->relief != TK_RELIEF_FLAT) { Tk_Draw3DRectangle(tkwin, pixmap, border, mbPtr->highlightWidth, mbPtr->highlightWidth, Tk_Width(tkwin) - 2*mbPtr->highlightWidth, Tk_Height(tkwin) - 2*mbPtr->highlightWidth, mbPtr->borderWidth, mbPtr->relief); } if (mbPtr->highlightWidth != 0) { GC gc; if (mbPtr->flags & GOT_FOCUS) { gc = Tk_GCForColor(mbPtr->highlightColorPtr, pixmap); } else { gc = Tk_GCForColor(mbPtr->highlightBgColorPtr, pixmap); } Tk_DrawFocusHighlight(tkwin, gc, mbPtr->highlightWidth, pixmap); } /* * Copy the information from the off-screen pixmap onto the screen, then * delete the pixmap. */ XCopyArea(mbPtr->display, pixmap, Tk_WindowId(tkwin), mbPtr->normalTextGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); Tk_FreePixmap(mbPtr->display, pixmap); } /* *---------------------------------------------------------------------- * * TkpDestroyMenuButton -- * * Free data structures associated with the menubutton control. * * Results: * None. * * Side effects: * Restores the default control state. * *---------------------------------------------------------------------- */ void TkpDestroyMenuButton( TkMenuButton *mbPtr) { } /* *---------------------------------------------------------------------- * * TkpComputeMenuButtonGeometry -- * * After changes in a menu button's text or bitmap, this function * recomputes the menu button's geometry and passes this information * along to the geometry manager for the window. * * Results: * None. * * Side effects: * The menu button's window may change size. * *---------------------------------------------------------------------- */ void TkpComputeMenuButtonGeometry( 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); haveImage = 1; } else if (mbPtr->bitmap != None) { Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height); 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); 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. */ 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; } } } 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; } else { mbPtr->indicatorHeight = 0; mbPtr->indicatorWidth = 0; } Tk_GeometryRequest(mbPtr->tkwin, (int) (width + 2*mbPtr->inset), (int) (height + 2*mbPtr->inset)); Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixConfig.c0000644003604700454610000000220612612445655014323 0ustar dgp771div/* * tkUnixConfig.c -- * * This module implements the Unix system defaults for the configuration * package. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" /* *---------------------------------------------------------------------- * * TkpGetSystemDefault -- * * Given a dbName and className for a configuration option, return a * string representation of the option. * * Results: * Returns a Tk_Uid that is the string identifier that identifies this * option. Returns NULL if there are no system defaults that match this * pair. * * Side effects: * None, once the package is initialized. * *---------------------------------------------------------------------- */ Tcl_Obj * TkpGetSystemDefault( Tk_Window tkwin, /* A window to use. */ CONST char *dbName, /* The option database name. */ CONST char *className) /* The name of the option class. */ { return NULL; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnix3d.c0000644003604700454610000003374212612445655013435 0ustar dgp771div/* * tkUnix3d.c -- * * This file contains the platform specific routines for drawing 3d * borders in the Motif style. * * Copyright (c) 1996 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" #include "tk3d.h" #if !(defined(__WIN32__) || defined(MAC_OSX_TK)) #include "tkUnixInt.h" #endif /* * This structure is used to keep track of the extra colors used by Unix 3D * borders. */ typedef struct { TkBorder info; GC solidGC; /* Used to draw solid relief. */ } UnixBorder; /* *---------------------------------------------------------------------- * * TkpGetBorder -- * * This function allocates a new TkBorder structure. * * Results: * Returns a newly allocated TkBorder. * * Side effects: * None. * *---------------------------------------------------------------------- */ TkBorder * TkpGetBorder(void) { UnixBorder *borderPtr = (UnixBorder *) ckalloc(sizeof(UnixBorder)); borderPtr->solidGC = None; return (TkBorder *) borderPtr; } /* *---------------------------------------------------------------------- * * TkpFreeBorder -- * * This function frees any colors allocated by the platform specific part * of this module. * * Results: * None. * * Side effects: * May deallocate some colors. * *---------------------------------------------------------------------- */ void TkpFreeBorder( TkBorder *borderPtr) { UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr; Display *display = DisplayOfScreen(borderPtr->screen); if (unixBorderPtr->solidGC != None) { Tk_FreeGC(display, unixBorderPtr->solidGC); } } /* *-------------------------------------------------------------- * * Tk_3DVerticalBevel -- * * This procedure draws a vertical bevel along one side of an object. The * bevel is always rectangular in shape: * ||| * ||| * ||| * ||| * ||| * ||| * An appropriate shadow color is chosen for the bevel based on the * leftBevel and relief arguments. Normally this procedure is called * first, then Tk_3DHorizontalBevel is called next to draw neat corners. * * Results: * None. * * Side effects: * Graphics are drawn in drawable. * *-------------------------------------------------------------- */ void Tk_3DVerticalBevel( Tk_Window tkwin, /* Window for which border was allocated. */ Drawable drawable, /* X window or pixmap in which to draw. */ Tk_3DBorder border, /* Token for border to draw. */ int x, int y, int width, int height, /* Area of vertical bevel. */ int leftBevel, /* Non-zero means this bevel forms the left * side of the object; 0 means it forms the * right side. */ int relief) /* Kind of bevel to draw. For example, * TK_RELIEF_RAISED means interior of object * should appear higher than exterior. */ { TkBorder *borderPtr = (TkBorder *) border; GC left, right; Display *display = Tk_Display(tkwin); if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT)) { TkpGetShadows(borderPtr, tkwin); } if (relief == TK_RELIEF_RAISED) { XFillRectangle(display, drawable, (leftBevel) ? borderPtr->lightGC : borderPtr->darkGC, x, y, (unsigned) width, (unsigned) height); } else if (relief == TK_RELIEF_SUNKEN) { XFillRectangle(display, drawable, (leftBevel) ? borderPtr->darkGC : borderPtr->lightGC, x, y, (unsigned) width, (unsigned) height); } else if (relief == TK_RELIEF_RIDGE) { int half; left = borderPtr->lightGC; right = borderPtr->darkGC; ridgeGroove: half = width/2; if (!leftBevel && (width & 1)) { half++; } XFillRectangle(display, drawable, left, x, y, (unsigned) half, (unsigned) height); XFillRectangle(display, drawable, right, x+half, y, (unsigned) (width-half), (unsigned) height); } else if (relief == TK_RELIEF_GROOVE) { left = borderPtr->darkGC; right = borderPtr->lightGC; goto ridgeGroove; } else if (relief == TK_RELIEF_FLAT) { XFillRectangle(display, drawable, borderPtr->bgGC, x, y, (unsigned) width, (unsigned) height); } else if (relief == TK_RELIEF_SOLID) { UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr; if (unixBorderPtr->solidGC == None) { XGCValues gcValues; gcValues.foreground = BlackPixelOfScreen(borderPtr->screen); unixBorderPtr->solidGC = Tk_GetGC(tkwin, GCForeground, &gcValues); } XFillRectangle(display, drawable, unixBorderPtr->solidGC, x, y, (unsigned) width, (unsigned) height); } } /* *-------------------------------------------------------------- * * Tk_3DHorizontalBevel -- * * This procedure draws a horizontal bevel along one side of an object. * The bevel has mitered corners (depending on leftIn and rightIn * arguments). * * Results: * None. * * Side effects: * None. * *-------------------------------------------------------------- */ void Tk_3DHorizontalBevel( Tk_Window tkwin, /* Window for which border was allocated. */ Drawable drawable, /* X window or pixmap in which to draw. */ Tk_3DBorder border, /* Token for border to draw. */ int x, int y, int width, int height, /* Bounding box of area of bevel. Height gives * width of border. */ int leftIn, int rightIn, /* Describes whether the left and right edges * of the bevel angle in or out as they go * down. For example, if "leftIn" is true, the * left side of the bevel looks like this: * ___________ * __________ * _________ * ________ */ int topBevel, /* Non-zero means this bevel forms the top * side of the object; 0 means it forms the * bottom side. */ int relief) /* Kind of bevel to draw. For example, * TK_RELIEF_RAISED means interior of object * should appear higher than exterior. */ { TkBorder *borderPtr = (TkBorder *) border; Display *display = Tk_Display(tkwin); int bottom, halfway, x1, x2, x1Delta, x2Delta; UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr; GC topGC = None, bottomGC = None; /* Initializations needed only to prevent * compiler warnings. */ if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT) && (relief != TK_RELIEF_SOLID)) { TkpGetShadows(borderPtr, tkwin); } /* * Compute a GC for the top half of the bevel and a GC for the bottom half * (they're the same in many cases). */ switch (relief) { case TK_RELIEF_FLAT: topGC = bottomGC = borderPtr->bgGC; break; case TK_RELIEF_GROOVE: topGC = borderPtr->darkGC; bottomGC = borderPtr->lightGC; break; case TK_RELIEF_RAISED: topGC = bottomGC = (topBevel? borderPtr->lightGC : borderPtr->darkGC); break; case TK_RELIEF_RIDGE: topGC = borderPtr->lightGC; bottomGC = borderPtr->darkGC; break; case TK_RELIEF_SOLID: if (unixBorderPtr->solidGC == None) { XGCValues gcValues; gcValues.foreground = BlackPixelOfScreen(borderPtr->screen); unixBorderPtr->solidGC = Tk_GetGC(tkwin, GCForeground, &gcValues); } XFillRectangle(display, drawable, unixBorderPtr->solidGC, x, y, (unsigned) width, (unsigned) height); return; case TK_RELIEF_SUNKEN: topGC = bottomGC = (topBevel? borderPtr->darkGC : borderPtr->lightGC); break; } /* * Compute various other geometry-related stuff. */ x1 = x; if (!leftIn) { x1 += height; } x2 = x+width; if (!rightIn) { x2 -= height; } x1Delta = (leftIn) ? 1 : -1; x2Delta = (rightIn) ? -1 : 1; halfway = y + height/2; if (!topBevel && (height & 1)) { halfway++; } bottom = y + height; /* * Draw one line for each y-coordinate covered by the bevel. */ for ( ; y < bottom; y++) { /* * X Dimensions are 16-bit, so avoid wraparound or display errors by * limiting these here. */ if (x1 < -32767) { x1 = -32767; } if (x2 > 32767) { x2 = 32767; } /* * In some weird cases (such as large border widths for skinny * rectangles) x1 can be >= x2. Don't draw the lines in these cases. */ if (x1 < x2) { XFillRectangle(display, drawable, (y < halfway) ? topGC : bottomGC, x1, y, (unsigned) (x2-x1), (unsigned) 1); } x1 += x1Delta; x2 += x2Delta; } } /* *---------------------------------------------------------------------- * * TkpGetShadows -- * * This procedure computes the shadow colors for a 3-D border and fills * in the corresponding fields of the Border structure. It's called * lazily, so that the colors aren't allocated until something is * actually drawn with them. That way, if a border is only used for flat * backgrounds the shadow colors will never be allocated. * * Results: * None. * * Side effects: * The lightGC and darkGC fields in borderPtr get filled in, if they * weren't already. * *---------------------------------------------------------------------- */ void TkpGetShadows( TkBorder *borderPtr, /* Information about border. */ Tk_Window tkwin) /* Window where border will be used for * drawing. */ { XColor lightColor, darkColor; int stressed, tmp1, tmp2; int r, g, b; XGCValues gcValues; if (borderPtr->lightGC != None) { return; } stressed = TkpCmapStressed(tkwin, borderPtr->colormap); /* * First, handle the case of a color display with lots of colors. The * shadow colors get computed using whichever formula results in the * greatest change in color: * 1. Lighter shadow is half-way to white, darker shadow is half way to * dark. * 2. Lighter shadow is 40% brighter than background, darker shadow is 40% * darker than background. */ if (!stressed && (Tk_Depth(tkwin) >= 6)) { /* * This is a color display with lots of colors. For the dark shadow, * cut 40% from each of the background color components. But if the * background is already very dark, make the dark color a little * lighter than the background by increasing each color component * 1/4th of the way to MAX_INTENSITY. * * For the light shadow, boost each component by 40% or half-way to * white, whichever is greater (the first approach works better for * unsaturated colors, the second for saturated ones). But if the * background is already very bright, instead choose a slightly darker * color for the light shadow by reducing each color component by 10%. * * Compute the colors using integers, not using lightColor.red etc.: * these are shorts and may have problems with integer overflow. */ /* * Compute the dark shadow color */ r = (int) borderPtr->bgColorPtr->red; g = (int) borderPtr->bgColorPtr->green; b = (int) borderPtr->bgColorPtr->blue; if (r*0.5*r + g*1.0*g + b*0.28*b < MAX_INTENSITY*0.05*MAX_INTENSITY) { darkColor.red = (MAX_INTENSITY + 3*r)/4; darkColor.green = (MAX_INTENSITY + 3*g)/4; darkColor.blue = (MAX_INTENSITY + 3*b)/4; } else { darkColor.red = (60 * r)/100; darkColor.green = (60 * g)/100; darkColor.blue = (60 * b)/100; } /* * Allocate the dark shadow color and its GC */ borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor); gcValues.foreground = borderPtr->darkColorPtr->pixel; borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues); /* * Compute the light shadow color */ if (g > MAX_INTENSITY*0.95) { lightColor.red = (90 * r)/100; lightColor.green = (90 * g)/100; lightColor.blue = (90 * b)/100; } else { tmp1 = (14 * r)/10; if (tmp1 > MAX_INTENSITY) { tmp1 = MAX_INTENSITY; } tmp2 = (MAX_INTENSITY + r)/2; lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2; tmp1 = (14 * g)/10; if (tmp1 > MAX_INTENSITY) { tmp1 = MAX_INTENSITY; } tmp2 = (MAX_INTENSITY + g)/2; lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2; tmp1 = (14 * b)/10; if (tmp1 > MAX_INTENSITY) { tmp1 = MAX_INTENSITY; } tmp2 = (MAX_INTENSITY + b)/2; lightColor.blue = (tmp1 > tmp2) ? tmp1 : tmp2; } /* * Allocate the light shadow color and its GC */ borderPtr->lightColorPtr = Tk_GetColorByValue(tkwin, &lightColor); gcValues.foreground = borderPtr->lightColorPtr->pixel; borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues); return; } if (borderPtr->shadow == None) { borderPtr->shadow = Tk_GetBitmap((Tcl_Interp *) NULL, tkwin, Tk_GetUid("gray50")); if (borderPtr->shadow == None) { Tcl_Panic("TkpGetShadows couldn't allocate bitmap for border"); } } if (borderPtr->visual->map_entries > 2) { /* * This isn't a monochrome display, but the colormap either ran out of * entries or didn't have very many to begin with. Generate the light * shadows with a white stipple and the dark shadows with a black * stipple. */ gcValues.foreground = borderPtr->bgColorPtr->pixel; gcValues.background = BlackPixelOfScreen(borderPtr->screen); gcValues.stipple = borderPtr->shadow; gcValues.fill_style = FillOpaqueStippled; borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues); gcValues.background = WhitePixelOfScreen(borderPtr->screen); borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues); return; } /* * This is just a measly monochrome display, hardly even worth its * existence on this earth. Make one shadow a 50% stipple and the other * the opposite of the background. */ gcValues.foreground = WhitePixelOfScreen(borderPtr->screen); gcValues.background = BlackPixelOfScreen(borderPtr->screen); gcValues.stipple = borderPtr->shadow; gcValues.fill_style = FillOpaqueStippled; borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues); if (borderPtr->bgColorPtr->pixel == WhitePixelOfScreen(borderPtr->screen)) { gcValues.foreground = BlackPixelOfScreen(borderPtr->screen); borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues); } else { borderPtr->darkGC = borderPtr->lightGC; borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tk.spec0000644003604700454610000000261312656405252013040 0ustar dgp771div# This file is the basis for a binary Tk Linux RPM. %{!?directory:%define directory /usr/local} Name: tk Summary: Tk graphical toolkit for the Tcl scripting language. Version: 8.5.19 Release: 2 License: BSD Group: Development/Languages Source: http://prdownloads.sourceforge.net/tcl/tk%{version}-src.tar.gz URL: http://www.tcl.tk/ Buildroot: /var/tmp/%{name}%{version} Buildrequires: XFree86-devel tcl >= 8.5.0 Requires: tcl >= 8.5.0 %description The Tcl (Tool Command Language) provides a powerful platform for creating integration applications that tie together diverse applications, protocols, devices, and frameworks. When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. %prep %setup -q -n %{name}%{version} %build cd unix CFLAGS="%optflags" ./configure \ --prefix=%{directory} \ --exec-prefix=%{directory} \ --libdir=%{directory}/%{_lib} make %install cd unix make INSTALL_ROOT=%buildroot install %clean rm -rf %buildroot %files -n tk %defattr(-,root,root) %if %{_lib} != lib %{directory}/%{_lib} %endif %{directory}/lib %{directory}/bin %{directory}/include %{directory}/man/man1 %{directory}/man/man3 %{directory}/man/mann tk8.5.19/unix/tkUnixCursor.c0000644003604700454610000004226312612445655014402 0ustar dgp771div/* * tkUnixCursor.c -- * * This file contains X specific cursor manipulation routines. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" /* * The following data structure is a superset of the TkCursor structure * defined in tkCursor.c. Each system specific cursor module will define a * different cursor structure. All of these structures must have the same * header consisting of the fields in TkCursor. */ typedef struct { TkCursor info; /* Generic cursor info used by tkCursor.c */ Display *display; /* Display for which cursor is valid. */ } TkUnixCursor; /* * The table below is used to map from the name of a cursor to its index in * the official cursor font: */ static struct CursorName { CONST char *name; unsigned int shape; } cursorNames[] = { {"X_cursor", XC_X_cursor}, {"arrow", XC_arrow}, {"based_arrow_down", XC_based_arrow_down}, {"based_arrow_up", XC_based_arrow_up}, {"boat", XC_boat}, {"bogosity", XC_bogosity}, {"bottom_left_corner", XC_bottom_left_corner}, {"bottom_right_corner", XC_bottom_right_corner}, {"bottom_side", XC_bottom_side}, {"bottom_tee", XC_bottom_tee}, {"box_spiral", XC_box_spiral}, {"center_ptr", XC_center_ptr}, {"circle", XC_circle}, {"clock", XC_clock}, {"coffee_mug", XC_coffee_mug}, {"cross", XC_cross}, {"cross_reverse", XC_cross_reverse}, {"crosshair", XC_crosshair}, {"diamond_cross", XC_diamond_cross}, {"dot", XC_dot}, {"dotbox", XC_dotbox}, {"double_arrow", XC_double_arrow}, {"draft_large", XC_draft_large}, {"draft_small", XC_draft_small}, {"draped_box", XC_draped_box}, {"exchange", XC_exchange}, {"fleur", XC_fleur}, {"gobbler", XC_gobbler}, {"gumby", XC_gumby}, {"hand1", XC_hand1}, {"hand2", XC_hand2}, {"heart", XC_heart}, {"icon", XC_icon}, {"iron_cross", XC_iron_cross}, {"left_ptr", XC_left_ptr}, {"left_side", XC_left_side}, {"left_tee", XC_left_tee}, {"leftbutton", XC_leftbutton}, {"ll_angle", XC_ll_angle}, {"lr_angle", XC_lr_angle}, {"man", XC_man}, {"middlebutton", XC_middlebutton}, {"mouse", XC_mouse}, {"pencil", XC_pencil}, {"pirate", XC_pirate}, {"plus", XC_plus}, {"question_arrow", XC_question_arrow}, {"right_ptr", XC_right_ptr}, {"right_side", XC_right_side}, {"right_tee", XC_right_tee}, {"rightbutton", XC_rightbutton}, {"rtl_logo", XC_rtl_logo}, {"sailboat", XC_sailboat}, {"sb_down_arrow", XC_sb_down_arrow}, {"sb_h_double_arrow", XC_sb_h_double_arrow}, {"sb_left_arrow", XC_sb_left_arrow}, {"sb_right_arrow", XC_sb_right_arrow}, {"sb_up_arrow", XC_sb_up_arrow}, {"sb_v_double_arrow", XC_sb_v_double_arrow}, {"shuttle", XC_shuttle}, {"sizing", XC_sizing}, {"spider", XC_spider}, {"spraycan", XC_spraycan}, {"star", XC_star}, {"target", XC_target}, {"tcross", XC_tcross}, {"top_left_arrow", XC_top_left_arrow}, {"top_left_corner", XC_top_left_corner}, {"top_right_corner", XC_top_right_corner}, {"top_side", XC_top_side}, {"top_tee", XC_top_tee}, {"trek", XC_trek}, {"ul_angle", XC_ul_angle}, {"umbrella", XC_umbrella}, {"ur_angle", XC_ur_angle}, {"watch", XC_watch}, {"xterm", XC_xterm}, {NULL, 0} }; /* * The table below is used to map from a cursor name to the data that defines * the cursor. This table is used for cursors defined by Tk that don't exist * in the X cursor table. */ #define CURSOR_NONE_DATA \ "#define none_width 1\n" \ "#define none_height 1\n" \ "#define none_x_hot 0\n" \ "#define none_y_hot 0\n" \ "static unsigned char none_bits[] = {\n" \ " 0x00};" /* * Define test cursor to check that mask fg and bg color settings are working. * * . configure -cursor {center_ptr green red} * . configure -cursor {@myarrow.xbm myarrow-mask.xbm green red} * . configure -cursor {myarrow green red} */ /*#define DEFINE_MYARROW_CURSOR*/ #ifdef DEFINE_MYARROW_CURSOR #define CURSOR_MYARROW_DATA \ "#define myarrow_width 16\n" \ "#define myarrow_height 16\n" \ "#define myarrow_x_hot 7\n" \ "#define myarrow_y_hot 0\n" \ "static unsigned char myarrow_bits[] = {\n" \ " 0x7f, 0xff, 0xbf, 0xfe, 0xdf, 0xfd, 0xef, 0xfb, 0xf7, 0xf7, 0xfb, 0xef,\n" \ " 0xfd, 0xdf, 0xfe, 0xbf, 0x80, 0x00, 0xbf, 0xfe, 0xbf, 0xfe, 0xbf, 0xfe,\n" \ " 0xbf, 0xfe, 0xbf, 0xfe, 0xbf, 0xfe, 0x3f, 0xfe};" #define CURSOR_MYARROW_MASK \ "#define myarrow-mask_width 16\n" \ "#define myarrow-mask_height 16\n" \ "#define myarrow-mask_x_hot 7\n" \ "#define myarrow-mask_y_hot 0\n" \ "static unsigned char myarrow-mask_bits[] = {\n" \ " 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,\n" \ " 0xfe, 0x3f, 0xff, 0x7f, 0xff, 0xff, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,\n" \ " 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01};" #endif /* DEFINE_MYARROW_CURSOR */ static struct TkCursorName { char *name; char *data; char *mask; } tkCursorNames[] = { {"none", CURSOR_NONE_DATA, NULL}, #ifdef DEFINE_MYARROW_CURSOR {"myarrow", CURSOR_MYARROW_DATA, CURSOR_MYARROW_MASK}, #endif /* DEFINE_MYARROW_CURSOR */ {NULL, NULL, NULL} }; /* * Font to use for cursors: */ #ifndef CURSORFONT #define CURSORFONT "cursor" #endif static Cursor CreateCursorFromTableOrFile(Tcl_Interp *interp, Tk_Window tkwin, int argc, CONST char **argv, struct TkCursorName *tkCursorPtr); /* *---------------------------------------------------------------------- * * TkGetCursorByName -- * * Retrieve a cursor by name. Parse the cursor name into fields and * create a cursor, either from the standard cursor font or from bitmap * files. * * Results: * Returns a new cursor, or NULL on errors. * * Side effects: * Allocates a new cursor. * *---------------------------------------------------------------------- */ TkCursor * TkGetCursorByName( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window in which cursor will be used. */ Tk_Uid string) /* Description of cursor. See manual entry for * details on legal syntax. */ { TkUnixCursor *cursorPtr = NULL; Cursor cursor = None; int argc; CONST char **argv = NULL; Display *display = Tk_Display(tkwin); int inTkTable = 0; struct TkCursorName* tkCursorPtr = NULL; if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) { return NULL; } if (argc == 0) { goto badString; } /* * Check Tk specific table of cursor names. The cursor names don't overlap * with cursors defined in the X table so search order does not matter. */ if (argv[0][0] != '@') { for (tkCursorPtr = tkCursorNames; ; tkCursorPtr++) { if (tkCursorPtr->name == NULL) { tkCursorPtr = NULL; break; } if ((tkCursorPtr->name[0] == argv[0][0]) && (strcmp(tkCursorPtr->name, argv[0]) == 0)) { inTkTable = 1; break; } } } if ((argv[0][0] != '@') && !inTkTable) { XColor fg, bg; unsigned int maskIndex; register struct CursorName *namePtr; TkDisplay *dispPtr; /* * The cursor is to come from the standard cursor font. If one arg, it * is cursor name (use black and white for fg and bg). If two args, * they are name and fg color (ignore mask). If three args, they are * name, fg, bg. Some of the code below is stolen from the * XCreateFontCursor Xlib function. */ if (argc > 3) { goto badString; } for (namePtr = cursorNames; ; namePtr++) { if (namePtr->name == NULL) { goto badString; } if ((namePtr->name[0] == argv[0][0]) && (strcmp(namePtr->name, argv[0]) == 0)) { break; } } maskIndex = namePtr->shape + 1; if (argc == 1) { fg.red = fg.green = fg.blue = 0; bg.red = bg.green = bg.blue = 65535; } else { if (TkParseColor(display, Tk_Colormap(tkwin), argv[1], &fg) == 0) { Tcl_AppendResult(interp, "invalid color name \"", argv[1], "\"", NULL); goto cleanup; } if (argc == 2) { bg.red = bg.green = bg.blue = 0; maskIndex = namePtr->shape; } else if (TkParseColor(display, Tk_Colormap(tkwin), argv[2], &bg) == 0) { Tcl_AppendResult(interp, "invalid color name \"", argv[2], "\"", NULL); goto cleanup; } } dispPtr = ((TkWindow *) tkwin)->dispPtr; if (dispPtr->cursorFont == None) { dispPtr->cursorFont = XLoadFont(display, CURSORFONT); if (dispPtr->cursorFont == None) { Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC); goto cleanup; } } cursor = XCreateGlyphCursor(display, dispPtr->cursorFont, dispPtr->cursorFont, namePtr->shape, maskIndex, &fg, &bg); } else { /* * Prevent file system access in safe interpreters. */ if (!inTkTable && Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't get cursor from a file in", " a safe interpreter", NULL); cursorPtr = NULL; goto cleanup; } /* * If the cursor is to be created from bitmap files, then there should * be either two elements in the list (source, color) or four (source * mask fg bg). A cursor defined in the Tk table accepts the same * arguments as an X cursor. */ if (inTkTable && (argc != 1) && (argc != 2) && (argc != 3)) { goto badString; } if (!inTkTable && (argc != 2) && (argc != 4)) { goto badString; } cursor = CreateCursorFromTableOrFile(interp, tkwin, argc, argv, tkCursorPtr); } if (cursor != None) { cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor)); cursorPtr->info.cursor = (Tk_Cursor) cursor; cursorPtr->display = display; } cleanup: if (argv != NULL) { ckfree((char *) argv); } return (TkCursor *) cursorPtr; badString: if (argv) { ckfree((char *) argv); } Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); return NULL; } /* *---------------------------------------------------------------------- * * CreateCursorFromTableOrFile -- * * Create a cursor defined in a file or the Tk static cursor table. A * cursor defined in a file starts with the '@' character. This method * assumes that the number of arguments in argv has been validated * already. * * Results: * Returns a new cursor, or None on error. * * Side effects: * Allocates a new X cursor. * *---------------------------------------------------------------------- */ static Cursor CreateCursorFromTableOrFile( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window in which cursor will be used. */ int argc, CONST char **argv, /* Cursor spec parsed into elements. */ struct TkCursorName *tkCursorPtr) /* Non-NULL when cursor is defined in Tk * table. */ { Cursor cursor = None; int width, height, maskWidth, maskHeight; int xHot = -1, yHot = -1; int dummy1, dummy2; XColor fg, bg; CONST char *fgColor; CONST char *bgColor; int inTkTable = (tkCursorPtr != NULL); Display *display = Tk_Display(tkwin); Drawable drawable = RootWindowOfScreen(Tk_Screen(tkwin)); Pixmap source = None; Pixmap mask = None; /* * A cursor defined in a file accepts either 2 or 4 arguments. * * {srcfile fg} * {srcfile maskfile fg bg} * * A cursor defined in the Tk table accepts 1, 2, or 3 arguments. * * {tkcursorname} * {tkcursorname fg} * {tkcursorname fg bg} */ if (inTkTable) { /* * This logic is like TkReadBitmapFile(). */ char *data; data = TkGetBitmapData(NULL, tkCursorPtr->data, NULL, &width, &height, &xHot, &yHot); if (data == NULL) { Tcl_AppendResult(interp, "error reading bitmap data for \"", argv[0], "\"", NULL); goto cleanup; } source = XCreateBitmapFromData(display, drawable, data, width,height); ckfree(data); } else { if (TkReadBitmapFile(display, drawable, &argv[0][1], (unsigned int *) &width, (unsigned int *) &height, &source, &xHot, &yHot) != BitmapSuccess) { Tcl_AppendResult(interp, "cleanup reading bitmap file \"", &argv[0][1], "\"", NULL); goto cleanup; } } if ((xHot < 0) || (yHot < 0) || (xHot >= width) || (yHot >= height)) { if (inTkTable) { Tcl_AppendResult(interp, "bad hot spot in bitmap data for \"", argv[0], "\"", NULL); } else { Tcl_AppendResult(interp, "bad hot spot in bitmap file \"", &argv[0][1], "\"", NULL); } goto cleanup; } /* * Parse color names from optional fg and bg arguments */ if (argc == 1) { fg.red = fg.green = fg.blue = 0; bg.red = bg.green = bg.blue = 65535; } else if (argc == 2) { fgColor = argv[1]; if (TkParseColor(display, Tk_Colormap(tkwin), fgColor, &fg) == 0) { Tcl_AppendResult(interp, "invalid color name \"", fgColor, "\"", NULL); goto cleanup; } if (inTkTable) { bg.red = bg.green = bg.blue = 0; } else { bg = fg; } } else { /* 3 or 4 arguments */ if (inTkTable) { fgColor = argv[1]; bgColor = argv[2]; } else { fgColor = argv[2]; bgColor = argv[3]; } if (TkParseColor(display, Tk_Colormap(tkwin), fgColor, &fg) == 0) { Tcl_AppendResult(interp, "invalid color name \"", fgColor, "\"", NULL); goto cleanup; } if (TkParseColor(display, Tk_Colormap(tkwin), bgColor, &bg) == 0) { Tcl_AppendResult(interp, "invalid color name \"", bgColor, "\"", NULL); goto cleanup; } } /* * If there is no mask data, then create the cursor now. */ if ((!inTkTable && (argc == 2)) || (inTkTable && tkCursorPtr->mask == NULL)) { cursor = XCreatePixmapCursor(display, source, source, &fg, &fg, (unsigned) xHot, (unsigned) yHot); goto cleanup; } /* * Parse bitmap mask data and create cursor with fg and bg colors. */ if (inTkTable) { /* * This logic is like TkReadBitmapFile(). */ char *data; data = TkGetBitmapData(NULL, tkCursorPtr->mask, NULL, &maskWidth, &maskHeight, &dummy1, &dummy2); if (data == NULL) { Tcl_AppendResult(interp, "error reading bitmap mask data for \"", argv[0], "\"", NULL); goto cleanup; } mask = XCreateBitmapFromData(display, drawable, data, maskWidth, maskHeight); ckfree(data); } else { if (TkReadBitmapFile(display, drawable, argv[1], (unsigned int *) &maskWidth, (unsigned int *) &maskHeight, &mask, &dummy1, &dummy2) != BitmapSuccess) { Tcl_AppendResult(interp, "cleanup reading bitmap file \"", argv[1], "\"", NULL); goto cleanup; } } if ((maskWidth != width) || (maskHeight != height)) { Tcl_SetResult(interp, "source and mask bitmaps have different sizes", TCL_STATIC); goto cleanup; } cursor = XCreatePixmapCursor(display, source, mask, &fg, &bg, (unsigned) xHot, (unsigned) yHot); cleanup: if (source != None) { Tk_FreePixmap(display, source); } if (mask != None) { Tk_FreePixmap(display, mask); } return cursor; } /* *---------------------------------------------------------------------- * * TkCreateCursorFromData -- * * Creates a cursor from the source and mask bits. * * Results: * Returns a new cursor, or NULL on errors. * * Side effects: * Allocates a new cursor. * *---------------------------------------------------------------------- */ TkCursor * TkCreateCursorFromData( Tk_Window tkwin, /* Window in which cursor will be used. */ CONST char *source, /* Bitmap data for cursor shape. */ CONST char *mask, /* Bitmap data for cursor mask. */ int width, int height, /* Dimensions of cursor. */ int xHot, int yHot, /* Location of hot-spot in cursor. */ XColor fgColor, /* Foreground color for cursor. */ XColor bgColor) /* Background color for cursor. */ { Cursor cursor; Pixmap sourcePixmap, maskPixmap; TkUnixCursor *cursorPtr = NULL; Display *display = Tk_Display(tkwin); sourcePixmap = XCreateBitmapFromData(display, RootWindowOfScreen(Tk_Screen(tkwin)), source, (unsigned) width, (unsigned) height); maskPixmap = XCreateBitmapFromData(display, RootWindowOfScreen(Tk_Screen(tkwin)), mask, (unsigned) width, (unsigned) height); cursor = XCreatePixmapCursor(display, sourcePixmap, maskPixmap, &fgColor, &bgColor, (unsigned) xHot, (unsigned) yHot); Tk_FreePixmap(display, sourcePixmap); Tk_FreePixmap(display, maskPixmap); if (cursor != None) { cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor)); cursorPtr->info.cursor = (Tk_Cursor) cursor; cursorPtr->display = display; } return (TkCursor *) cursorPtr; } /* *---------------------------------------------------------------------- * * TkpFreeCursor -- * * This function is called to release a cursor allocated by * TkGetCursorByName. * * Results: * None. * * Side effects: * The cursor data structure is deallocated. * *---------------------------------------------------------------------- */ void TkpFreeCursor( TkCursor *cursorPtr) { TkUnixCursor *unixCursorPtr = (TkUnixCursor *) cursorPtr; XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor); Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixFont.c0000644003604700454610000025562012612445655014036 0ustar dgp771div/* * tkUnixFont.c -- * * Contains the Unix implementation of the platform-independent font * package interface. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" #include "tkFont.h" #include /* for htons() prototype */ #include /* inet_ntoa() */ /* * The preferred font encodings. */ static CONST char *encodingList[] = { "iso8859-1", "jis0208", "jis0212", NULL }; /* * The following structure represents a font family. It is assumed that all * screen fonts constructed from the same "font family" share certain * properties; all screen fonts with the same "font family" point to a shared * instance of this structure. The most important shared property is the * character existence metrics, used to determine if a screen font can display * a given Unicode character. * * Under Unix, there are three attributes that uniquely identify a "font * family": the foundry, face name, and charset. */ #define FONTMAP_SHIFT 10 #define FONTMAP_PAGES (1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT)) #define FONTMAP_BITSPERPAGE (1 << FONTMAP_SHIFT) typedef struct FontFamily { struct FontFamily *nextPtr; /* Next in list of all known font families. */ int refCount; /* How many SubFonts are referring to this * FontFamily. When the refCount drops to * zero, this FontFamily may be freed. */ /* * Key. */ Tk_Uid foundry; /* Foundry key for this FontFamily. */ Tk_Uid faceName; /* Face name key for this FontFamily. */ Tcl_Encoding encoding; /* Encoding key for this FontFamily. */ /* * Derived properties. */ int isTwoByteFont; /* 1 if this is a double-byte font, 0 * otherwise. */ char *fontMap[FONTMAP_PAGES]; /* Two-level sparse table used to determine * quickly if the specified character exists. * As characters are encountered, more pages * in this table are dynamically alloced. The * contents of each page is a bitmask * consisting of FONTMAP_BITSPERPAGE bits, * representing whether this font can be used * to display the given character at the * corresponding bit position. The high bits * of the character are used to pick which * page of the table is used. */ } FontFamily; /* * The following structure encapsulates an individual screen font. A font * object is made up of however many SubFonts are necessary to display a * stream of multilingual characters. */ typedef struct SubFont { char **fontMap; /* Pointer to font map from the FontFamily, * cached here to save a dereference. */ XFontStruct *fontStructPtr; /* The specific screen font that will be used * when displaying/measuring chars belonging * to the FontFamily. */ FontFamily *familyPtr; /* The FontFamily for this SubFont. */ } SubFont; /* * The following structure represents Unix's implementation of a font object. */ #define SUBFONT_SPACE 3 #define BASE_CHARS 256 typedef struct UnixFont { TkFont font; /* Stuff used by generic font package. Must be * first in structure. */ SubFont staticSubFonts[SUBFONT_SPACE]; /* Builtin space for a limited number of * SubFonts. */ int numSubFonts; /* Length of following array. */ SubFont *subFontArray; /* Array of SubFonts that have been loaded in * order to draw/measure all the characters * encountered by this font so far. All fonts * start off with one SubFont initialized by * AllocFont() from the original set of font * attributes. Usually points to * staticSubFonts, but may point to malloced * space if there are lots of SubFonts. */ SubFont controlSubFont; /* Font to use to display control-character * expansions. */ Display *display; /* Display that owns font. */ int pixelSize; /* Original pixel size used when font was * constructed. */ TkXLFDAttributes xa; /* Additional attributes that specify the * preferred foundry and encoding to use when * constructing additional SubFonts. */ int widths[BASE_CHARS]; /* Widths of first 256 chars in the base font, * for handling common case. */ int underlinePos; /* Offset from baseline to origin of underline * bar (used when drawing underlined font) * (pixels). */ int barHeight; /* Height of underline or overstrike bar (used * when drawing underlined or strikeout font) * (pixels). */ } UnixFont; /* * The following structure and definition is used to keep track of the * alternative names for various encodings. Asking for an encoding that * matches one of the alias patterns will result in actually getting the * encoding by its real name. */ typedef struct EncodingAlias { char *realName; /* The real name of the encoding to load if * the provided name matched the pattern. */ char *aliasPattern; /* Pattern for encoding name, of the form that * is acceptable to Tcl_StringMatch. */ } EncodingAlias; /* * Just some utility structures used for passing around values in helper * functions. */ typedef struct FontAttributes { TkFontAttributes fa; TkXLFDAttributes xa; } FontAttributes; typedef struct ThreadSpecificData { FontFamily *fontFamilyList; /* The list of font families that are * currently loaded. As screen fonts are * loaded, this list grows to hold information * about what characters exist in each font * family. */ FontFamily controlFamily; /* FontFamily used to handle control character * expansions. The encoding of this FontFamily * converts UTF-8 to backslashed escape * sequences. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The set of builtin encoding alises to convert the XLFD names for the * encodings into the names expected by the Tcl encoding package. */ static EncodingAlias encodingAliases[] = { {"gb2312-raw", "gb2312*"}, {"big5", "big5*"}, {"cns11643-1", "cns11643*-1"}, {"cns11643-1", "cns11643*.1-0"}, {"cns11643-2", "cns11643*-2"}, {"cns11643-2", "cns11643*.2-0"}, {"jis0201", "jisx0201*"}, {"jis0201", "jisx0202*"}, {"jis0208", "jisc6226*"}, {"jis0208", "jisx0208*"}, {"jis0212", "jisx0212*"}, {"tis620", "tis620*"}, {"ksc5601", "ksc5601*"}, {"dingbats", "*dingbats"}, #ifdef WORDS_BIGENDIAN {"unicode", "iso10646-1"}, #else /* * ucs-2be is needed if native order isn't BE. */ {"ucs-2be", "iso10646-1"}, #endif {NULL, NULL} }; /* * Functions used only in this file. */ static void FontPkgCleanup(ClientData clientData); static FontFamily * AllocFontFamily(Display *display, XFontStruct *fontStructPtr, int base); static SubFont * CanUseFallback(UnixFont *fontPtr, CONST char *fallbackName, int ch, SubFont **fixSubFontPtrPtr); static SubFont * CanUseFallbackWithAliases(UnixFont *fontPtr, char *fallbackName, int ch, Tcl_DString *nameTriedPtr, SubFont **fixSubFontPtrPtr); static int ControlUtfProc(ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState*statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static XFontStruct * CreateClosestFont(Tk_Window tkwin, CONST TkFontAttributes *faPtr, CONST TkXLFDAttributes *xaPtr); static SubFont * FindSubFontForChar(UnixFont *fontPtr, int ch, SubFont **fixSubFontPtrPtr); static void FontMapInsert(SubFont *subFontPtr, int ch); static void FontMapLoadPage(SubFont *subFontPtr, int row); static int FontMapLookup(SubFont *subFontPtr, int ch); static void FreeFontFamily(FontFamily *afPtr); static CONST char * GetEncodingAlias(CONST char *name); static int GetFontAttributes(Display *display, XFontStruct *fontStructPtr, FontAttributes *faPtr); static XFontStruct * GetScreenFont(Display *display, FontAttributes *wantPtr, char **nameList, int bestIdx[], unsigned int bestScore[]); static XFontStruct * GetSystemFont(Display *display); static int IdentifySymbolEncodings(FontAttributes *faPtr); static void InitFont(Tk_Window tkwin, XFontStruct *fontStructPtr, UnixFont *fontPtr); static void InitSubFont(Display *display, XFontStruct *fontStructPtr, int base, SubFont *subFontPtr); static char ** ListFonts(Display *display, CONST char *faceName, int *numNamesPtr); static char ** ListFontOrAlias(Display *display, CONST char*faceName, int *numNamesPtr); static unsigned int RankAttributes(FontAttributes *wantPtr, FontAttributes *gotPtr); static void ReleaseFont(UnixFont *fontPtr); static void ReleaseSubFont(Display *display, SubFont *subFontPtr); static int SeenName(CONST char *name, Tcl_DString *dsPtr); #ifndef WORDS_BIGENDIAN static int Ucs2beToUtfProc(ClientData clientData, CONST char*src, int srcLen, int flags, Tcl_EncodingState*statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int UtfToUcs2beProc(ClientData clientData, CONST char*src, int srcLen, int flags, Tcl_EncodingState*statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); #endif /* *------------------------------------------------------------------------- * * FontPkgCleanup -- * * This function is called when an application is created. It initializes * all the structures that are used by the platform-dependent code on a * per application basis. * * Results: * None. * * Side effects: * Releases thread-specific resources used by font pkg. * *------------------------------------------------------------------------- */ static void FontPkgCleanup( ClientData clientData) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->controlFamily.encoding != NULL) { FontFamily *familyPtr = &tsdPtr->controlFamily; int i; Tcl_FreeEncoding(familyPtr->encoding); for (i = 0; i < FONTMAP_PAGES; i++) { if (familyPtr->fontMap[i] != NULL) { ckfree(familyPtr->fontMap[i]); } } tsdPtr->controlFamily.encoding = NULL; } } /* *------------------------------------------------------------------------- * * TkpFontPkgInit -- * * This function is called when an application is created. It initializes * all the structures that are used by the platform-dependent code on a * per application basis. * * Results: * None. * * Side effects: * None. * *------------------------------------------------------------------------- */ void TkpFontPkgInit( TkMainInfo *mainPtr) /* The application being created. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_EncodingType type; SubFont dummy; int i; if (tsdPtr->controlFamily.encoding == NULL) { type.encodingName = "X11ControlChars"; type.toUtfProc = ControlUtfProc; type.fromUtfProc = ControlUtfProc; type.freeProc = NULL; type.clientData = NULL; type.nullSize = 0; tsdPtr->controlFamily.refCount = 2; tsdPtr->controlFamily.encoding = Tcl_CreateEncoding(&type); tsdPtr->controlFamily.isTwoByteFont = 0; dummy.familyPtr = &tsdPtr->controlFamily; dummy.fontMap = tsdPtr->controlFamily.fontMap; for (i = 0x00; i < 0x20; i++) { FontMapInsert(&dummy, i); FontMapInsert(&dummy, i + 0x80); } #ifndef WORDS_BIGENDIAN /* * UCS-2BE is unicode (UCS-2) in big-endian format. Define this if * native order isn't BE. 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); #endif Tcl_CreateThreadExitHandler(FontPkgCleanup, NULL); } } /* *------------------------------------------------------------------------- * * ControlUtfProc -- * * Convert from UTF-8 into the ASCII expansion of a control character. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int ControlUtfProc( ClientData clientData, /* Not used. */ CONST char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source * characters. */ int *dstWrotePtr, /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { CONST char *srcStart, *srcEnd; char *dstStart, *dstEnd; Tcl_UniChar ch; int result; static char hexChars[] = "0123456789abcdef"; static char mapChars[] = { 0, 0, 0, 0, 0, 0, 0, 'a', 'b', 't', 'n', 'v', 'f', 'r' }; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; dstStart = dst; dstEnd = dst + dstLen - 6; for ( ; src < srcEnd; ) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } src += Tcl_UtfToUniChar(src, &ch); dst[0] = '\\'; if ((ch < sizeof(mapChars)) && (mapChars[ch] != 0)) { dst[1] = mapChars[ch]; dst += 2; } else if (ch < 256) { dst[1] = 'x'; dst[2] = hexChars[(ch >> 4) & 0xf]; dst[3] = hexChars[ch & 0xf]; dst += 4; } else { dst[1] = 'u'; dst[2] = hexChars[(ch >> 12) & 0xf]; dst[3] = hexChars[(ch >> 8) & 0xf]; dst[4] = hexChars[(ch >> 4) & 0xf]; dst[5] = hexChars[ch & 0xf]; dst += 6; } } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = dst - dstStart; return result; } #ifndef WORDS_BIGENDIAN /* *------------------------------------------------------------------------- * * Ucs2beToUtfProc -- * * Convert from UCS-2BE (big-endian 16-bit Unicode) to UTF-8. * This is only defined on LE machines. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int Ucs2beToUtfProc( 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 char *srcStart, *srcEnd; char *dstEnd, *dstStart; int result, numChars; result = TCL_OK; /* check alignment with ucs-2 (2 == sizeof(UCS-2)) */ if ((srcLen % 2) != 0) { result = TCL_CONVERT_MULTIBYTE; srcLen--; } srcStart = src; srcEnd = src + srcLen; dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; for (numChars = 0; src < srcEnd; numChars++) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } /* * Need to swap byte-order on little-endian machines (x86) for * UCS-2BE. We know this is an LE->BE swap. */ dst += Tcl_UniCharToUtf(htons(*((short *)src)), dst); src += 2 /* sizeof(UCS-2) */; } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } /* *------------------------------------------------------------------------- * * UtfToUcs2beProc -- * * Convert from UTF-8 to UCS-2BE (fixed 2-byte encoding). * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfToUcs2beProc( 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, *dstStart, *dstEnd; int result, numChars; Tcl_UniChar ch; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } dstStart = dst; dstEnd = dst + dstLen - 2 /* sizeof(UCS-2) */; 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 (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } src += Tcl_UtfToUniChar(src, &ch); /* * Ensure big-endianness (store big bits first). * XXX: This hard-codes the assumed size of Tcl_UniChar as 2. Make * sure to work in char* for Tcl_UtfToUniChar alignment. [Bug 1122671] */ *dst++ = (ch >> 8); *dst++ = (ch & 0xFF); } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } #endif /* WORDS_BIGENDIAN */ /* *--------------------------------------------------------------------------- * * TkpGetNativeFont -- * * Map a platform-specific native font name to a TkFont. * * Results: * The return value is a pointer to a TkFont that represents the native * font. If a native font by the given name could not be found, the * return value is NULL. * * Every call to this function returns a new TkFont structure, even if * the name has already been seen before. The caller should call * TkpDeleteFont() when the font is no longer needed. * * The caller is responsible for initializing the memory associated with * the generic TkFont when this function returns and releasing the * contents of the generic TkFont before calling TkpDeleteFont(). * * Side effects: * Memory allocated. * *--------------------------------------------------------------------------- */ TkFont * TkpGetNativeFont( Tk_Window tkwin, /* For display where font will be used. */ CONST char *name) /* Platform-specific font name. */ { UnixFont *fontPtr; XFontStruct *fontStructPtr; FontAttributes fa; CONST char *p; int hasSpace, dashes, hasWild; /* * The behavior of X when given a name that isn't an XLFD is unspecified. * For example, Exceed 6 returns a valid font for any random string. This * is awkward since system names have higher priority than the other Tk * font syntaxes. So, we need to perform a quick sanity check on the name * and fail if it looks suspicious. We fail if the name: * - contains a space immediately before a dash * - contains a space, but no '*' characters and fewer than 14 dashes */ hasSpace = dashes = hasWild = 0; for (p = name; *p != '\0'; p++) { if (*p == ' ') { if (p[1] == '-') { return NULL; } hasSpace = 1; } else if (*p == '-') { dashes++; } else if (*p == '*') { hasWild = 1; } } if ((dashes < 14) && !hasWild && hasSpace) { return NULL; } fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name); if (fontStructPtr == NULL) { /* * Handle all names that look like XLFDs here. Otherwise, when * TkpGetFontFromAttributes is called from generic code, any foundry * or encoding information specified in the XLFD will have been parsed * out and lost. But make sure we don't have an "-option value" string * since TkFontParseXLFD would return a false success when attempting * to parse it. */ if (name[0] == '-') { if (name[1] != '*') { char *dash; dash = strchr(name + 1, '-'); if ((dash == NULL) || (isspace(UCHAR(dash[-1])))) { return NULL; } } } else if (name[0] != '*') { return NULL; } if (TkFontParseXLFD(name, &fa.fa, &fa.xa) != TCL_OK) { return NULL; } fontStructPtr = CreateClosestFont(tkwin, &fa.fa, &fa.xa); } fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont)); InitFont(tkwin, fontStructPtr, fontPtr); return (TkFont *) fontPtr; } /* *--------------------------------------------------------------------------- * * TkpGetFontFromAttributes -- * * Given a desired set of attributes for a font, find a font with the * closest matching attributes. * * Results: * The return value is a pointer to a TkFont that represents the font * with the desired attributes. If a font with the desired attributes * could not be constructed, some other font will be substituted * automatically. * * Every call to this function returns a new TkFont structure, even if * the specified attributes have already been seen before. The caller * should call TkpDeleteFont() to free the platform- specific data when * the font is no longer needed. * * The caller is responsible for initializing the memory associated with * the generic TkFont when this function returns and releasing the * contents of the generic TkFont before calling TkpDeleteFont(). * * Side effects: * Memory allocated. * *--------------------------------------------------------------------------- */ TkFont * TkpGetFontFromAttributes( TkFont *tkFontPtr, /* If non-NULL, store the information in this * existing TkFont structure, rather than * allocating a new structure to hold the * font; the existing contents of the font * will be released. If NULL, a new TkFont * structure is allocated. */ Tk_Window tkwin, /* For display where font will be used. */ CONST TkFontAttributes *faPtr) /* Set of attributes to match. */ { UnixFont *fontPtr; TkXLFDAttributes xa; XFontStruct *fontStructPtr; TkInitXLFDAttributes(&xa); fontStructPtr = CreateClosestFont(tkwin, faPtr, &xa); fontPtr = (UnixFont *) tkFontPtr; if (fontPtr == NULL) { fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont)); } else { ReleaseFont(fontPtr); } InitFont(tkwin, fontStructPtr, fontPtr); fontPtr->font.fa.underline = faPtr->underline; fontPtr->font.fa.overstrike = faPtr->overstrike; return (TkFont *) fontPtr; } /* *--------------------------------------------------------------------------- * * TkpDeleteFont -- * * Called to release a font allocated by TkpGetNativeFont() or * TkpGetFontFromAttributes(). The caller should have already released * the fields of the TkFont that are used exclusively by the generic * TkFont code. * * Results: * None. * * Side effects: * TkFont is deallocated. * *--------------------------------------------------------------------------- */ void TkpDeleteFont( TkFont *tkFontPtr) /* Token of font to be deleted. */ { UnixFont *fontPtr = (UnixFont *) tkFontPtr; ReleaseFont(fontPtr); } /* *--------------------------------------------------------------------------- * * TkpGetFontFamilies -- * * Return information about the font families that are available on the * display of the given window. * * Results: * Modifies interp's result object to hold a list of all the available * font families. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TkpGetFontFamilies( Tcl_Interp *interp, /* Interp to hold result. */ Tk_Window tkwin) /* For display to query. */ { int i, new, numNames; char *family, **nameList; Tcl_HashTable familyTable; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *resultPtr, *strPtr; resultPtr = Tcl_GetObjResult(interp); Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS); nameList = ListFonts(Tk_Display(tkwin), "*", &numNames); for (i = 0; i < numNames; i++) { char *familyEnd; family = strchr(nameList[i] + 1, '-'); if (family == NULL) { /* * Apparently, sometimes ListFonts() can return a font name with * zero or one '-' character in it. This is probably indicative of * a server misconfiguration, but crashing because of it is a very * bad idea anyway. [Bug 1475865] */ continue; } family++; /* Advance to char after '-'. */ familyEnd = strchr(family, '-'); if (familyEnd == NULL) { continue; /* See comment above. */ } *familyEnd = '\0'; Tcl_CreateHashEntry(&familyTable, family, &new); } XFreeFontNames(nameList); hPtr = Tcl_FirstHashEntry(&familyTable, &search); while (hPtr != NULL) { strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1); Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&familyTable); } /* *------------------------------------------------------------------------- * * TkpGetSubFonts -- * * A function used by the testing package for querying the actual screen * fonts that make up a font object. * * Results: * Modifies interp's result object to hold a list containing the names of * the screen fonts that make up the given font object. * * Side effects: * None. * *------------------------------------------------------------------------- */ void TkpGetSubFonts( Tcl_Interp *interp, Tk_Font tkfont) { int i; Tcl_Obj *objv[3], *resultPtr, *listPtr; UnixFont *fontPtr; FontFamily *familyPtr; resultPtr = Tcl_GetObjResult(interp); fontPtr = (UnixFont *) tkfont; for (i = 0; i < fontPtr->numSubFonts; i++) { familyPtr = fontPtr->subFontArray[i].familyPtr; objv[0] = Tcl_NewStringObj(familyPtr->faceName, -1); objv[1] = Tcl_NewStringObj(familyPtr->foundry, -1); objv[2] = Tcl_NewStringObj( Tcl_GetEncodingName(familyPtr->encoding), -1); listPtr = Tcl_NewListObj(3, objv); Tcl_ListObjAppendElement(NULL, resultPtr, listPtr); } } /* *---------------------------------------------------------------------- * * TkpGetFontAttrsForChar -- * * Retrieve the font attributes of the actual font used to render a given * character. * * Results: * None. * * Side effects: * The font attributes are stored in *faPtr. * *---------------------------------------------------------------------- */ void TkpGetFontAttrsForChar( Tk_Window tkwin, /* Window on the font's display */ Tk_Font tkfont, /* Font to query */ Tcl_UniChar c, /* Character of interest */ TkFontAttributes *faPtr) /* Output: Font attributes */ { FontAttributes atts; UnixFont *fontPtr = (UnixFont *) tkfont; /* Structure describing the logical font */ SubFont *lastSubFontPtr = &fontPtr->subFontArray[0]; /* Pointer to subfont array in case * FindSubFontForChar needs to fix up the * memory allocation */ SubFont *thisSubFontPtr = FindSubFontForChar(fontPtr, c, &lastSubFontPtr); /* Pointer to the subfont to use for the given * character */ GetFontAttributes(Tk_Display(tkwin), thisSubFontPtr->fontStructPtr, &atts); *faPtr = atts.fa; } /* *--------------------------------------------------------------------------- * * Tk_MeasureChars -- * * Determine the number of characters from the string that will fit in * the given horizontal span. The measurement is done under the * assumption that Tk_DrawChars() will be used to actually display the * characters. * * Results: * The return value is the number of bytes from source that fit into the * span that extends from 0 to maxLength. *lengthPtr is filled with the * x-coordinate of the right edge of the last character that did fit. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tk_MeasureChars( Tk_Font tkfont, /* Font in which characters will be drawn. */ CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string. */ int maxLength, /* If >= 0, maxLength specifies the longest * permissible line length in pixels; don't * consider any character that would cross * this x-position. If < 0, then line length * is unbounded and the flags argument is * ignored. */ int flags, /* Various flag bits OR-ed together: * TK_PARTIAL_OK means include the last char * which only partially fit on this line. * TK_WHOLE_WORDS means stop on a word * boundary, if possible. TK_AT_LEAST_ONE * means return at least one character even if * no characters fit. */ int *lengthPtr) /* Filled with x-location just after the * terminating character. */ { UnixFont *fontPtr; SubFont *lastSubFontPtr; int curX, curByte; /* * Unix does not use kerning or fractional character widths when * displaying text on the screen. So that means we can safely measure * individual characters or spans of characters and add up the widths w/o * any "off-by-one-pixel" errors. */ fontPtr = (UnixFont *) tkfont; lastSubFontPtr = &fontPtr->subFontArray[0]; if (numBytes == 0) { curX = 0; curByte = 0; } else if (maxLength < 0) { CONST char *p, *end, *next; Tcl_UniChar ch; SubFont *thisSubFontPtr; FontFamily *familyPtr; Tcl_DString runString; /* * A three step process: * 1. Find a contiguous range of characters that can all be * represented by a single screen font. * 2. Convert those chars to the encoding of that font. * 3. Measure converted chars. */ curX = 0; end = source + numBytes; for (p = source; p < end; ) { next = p + Tcl_UtfToUniChar(p, &ch); thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr); if (thisSubFontPtr != lastSubFontPtr) { familyPtr = lastSubFontPtr->familyPtr; Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, &runString); if (familyPtr->isTwoByteFont) { curX += XTextWidth16(lastSubFontPtr->fontStructPtr, (XChar2b *) Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) / 2); } else { curX += XTextWidth(lastSubFontPtr->fontStructPtr, Tcl_DStringValue(&runString), Tcl_DStringLength(&runString)); } Tcl_DStringFree(&runString); lastSubFontPtr = thisSubFontPtr; source = p; } p = next; } familyPtr = lastSubFontPtr->familyPtr; Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, &runString); if (familyPtr->isTwoByteFont) { curX += XTextWidth16(lastSubFontPtr->fontStructPtr, (XChar2b *) Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) >> 1); } else { curX += XTextWidth(lastSubFontPtr->fontStructPtr, Tcl_DStringValue(&runString), Tcl_DStringLength(&runString)); } Tcl_DStringFree(&runString); curByte = numBytes; } else { CONST char *p, *end, *next, *term; int newX, termX, sawNonSpace, dstWrote; Tcl_UniChar ch; FontFamily *familyPtr; char buf[16]; /* * How many chars will fit in the space allotted? This first version * may be inefficient because it measures every character * individually. */ next = source + Tcl_UtfToUniChar(source, &ch); newX = curX = termX = 0; term = source; end = source + numBytes; sawNonSpace = (ch > 255) || !isspace(ch); familyPtr = lastSubFontPtr->familyPtr; for (p = source; ; ) { if ((ch < BASE_CHARS) && (fontPtr->widths[ch] != 0)) { newX += fontPtr->widths[ch]; } else { lastSubFontPtr = FindSubFontForChar(fontPtr, ch, NULL); familyPtr = lastSubFontPtr->familyPtr; Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p, 0, NULL, buf, sizeof(buf), NULL, &dstWrote, NULL); if (familyPtr->isTwoByteFont) { newX += XTextWidth16(lastSubFontPtr->fontStructPtr, (XChar2b *) buf, dstWrote >> 1); } else { newX += XTextWidth(lastSubFontPtr->fontStructPtr, buf, dstWrote); } } if (newX > maxLength) { break; } curX = newX; p = next; if (p >= end) { term = end; termX = curX; break; } next += Tcl_UtfToUniChar(next, &ch); if ((ch < 256) && isspace(ch)) { if (sawNonSpace) { term = p; termX = curX; sawNonSpace = 0; } } else { sawNonSpace = 1; } } /* * P points to the first character that doesn't fit in the desired * span. Use the flags to figure out what to return. */ if ((flags & TK_PARTIAL_OK) && (p < end) && (curX < maxLength)) { /* * Include the first character that didn't quite fit in the * desired span. The width returned will include the width of that * extra character. */ curX = newX; p += Tcl_UtfToUniChar(p, &ch); } if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) { term = p; termX = curX; if (term == source) { term += Tcl_UtfToUniChar(term, &ch); termX = newX; } } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) { term = p; termX = curX; } curX = termX; curByte = term - source; } *lengthPtr = curX; return curByte; } /* *--------------------------------------------------------------------------- * * TkpMeasureCharsInContext -- * * Determine the number of bytes from the string that will fit in the * given horizontal span. The measurement is done under the assumption * that TkpDrawCharsInContext() will be used to actually display the * characters. * * This one is almost the same as Tk_MeasureChars(), but with access to * all the characters on the line for context. On X11 this context isn't * consulted, so we just call Tk_MeasureChars(). * * Results: * The return value is the number of bytes from source that fit into the * span that extends from 0 to maxLength. *lengthPtr is filled with the * x-coordinate of the right edge of the last character that did fit. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TkpMeasureCharsInContext( Tk_Font tkfont, /* Font in which characters will be drawn. */ CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string in all. */ int rangeStart, /* Index of first byte to measure. */ int rangeLength, /* Length of range to measure in bytes. */ int maxLength, /* If >= 0, maxLength specifies the longest * permissible line length; don't consider any * character that would cross this x-position. * If < 0, then line length is unbounded and * the flags argument is ignored. */ int flags, /* Various flag bits OR-ed together: * TK_PARTIAL_OK means include the last char * which only partially fit on this line. * TK_WHOLE_WORDS means stop on a word * boundary, if possible. TK_AT_LEAST_ONE * means return at least one character even if * no characters fit. TK_ISOLATE_END means * that the last character should not be * considered in context with the rest of the * string (used for breaking lines). */ int *lengthPtr) /* Filled with x-location just after the * terminating character. */ { (void) numBytes; /*unused*/ return Tk_MeasureChars(tkfont, source + rangeStart, rangeLength, maxLength, flags, lengthPtr); } /* *--------------------------------------------------------------------------- * * Tk_DrawChars -- * * Draw a string of characters on the screen. Tk_DrawChars() expands * control characters that occur in the string to \xNN sequences. * * Results: * None. * * Side effects: * Information gets drawn on the screen. * *--------------------------------------------------------------------------- */ void Tk_DrawChars( Display *display, /* Display on which to draw. */ Drawable drawable, /* Window or pixmap in which to draw. */ GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that * is passed to this function. If they are not * stripped out, they will be displayed as * regular printing characters. */ int numBytes, /* Number of bytes in string. */ int x, int y) /* Coordinates at which to place origin of * string when drawing. */ { UnixFont *fontPtr; SubFont *thisSubFontPtr, *lastSubFontPtr; Tcl_DString runString; CONST char *p, *end, *next; int xStart, needWidth, window_width, do_width; Tcl_UniChar ch; FontFamily *familyPtr; #ifdef TK_DRAW_CHAR_XWINDOW_CHECK int rx, ry; unsigned int width, height, border_width, depth; Drawable root; #endif fontPtr = (UnixFont *) tkfont; lastSubFontPtr = &fontPtr->subFontArray[0]; xStart = x; #ifdef TK_DRAW_CHAR_XWINDOW_CHECK /* * Get the window width so we can abort drawing outside of the window */ if (XGetGeometry(display, drawable, &root, &rx, &ry, &width, &height, &border_width, &depth) == False) { window_width = INT_MAX; } else { window_width = width; } #else /* * This is used by default until we find a solution that doesn't do a * round-trip to the X server (needed to get Tk cached window width). */ window_width = 32768; #endif end = source + numBytes; needWidth = fontPtr->font.fa.underline + fontPtr->font.fa.overstrike; for (p = source; p <= end; ) { if (p < end) { next = p + Tcl_UtfToUniChar(p, &ch); thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr); } else { next = p + 1; thisSubFontPtr = lastSubFontPtr; } if ((thisSubFontPtr != lastSubFontPtr) || (p == end) || (p-source > 200)) { if (p > source) { do_width = (needWidth || (p != end)) ? 1 : 0; familyPtr = lastSubFontPtr->familyPtr; Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, &runString); if (familyPtr->isTwoByteFont) { XDrawString16(display, drawable, gc, x, y, (XChar2b *) Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) / 2); if (do_width) { x += XTextWidth16(lastSubFontPtr->fontStructPtr, (XChar2b *) Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) / 2); } } else { XDrawString(display, drawable, gc, x, y, Tcl_DStringValue(&runString), Tcl_DStringLength(&runString)); if (do_width) { x += XTextWidth(lastSubFontPtr->fontStructPtr, Tcl_DStringValue(&runString), Tcl_DStringLength(&runString)); } } Tcl_DStringFree(&runString); } lastSubFontPtr = thisSubFontPtr; source = p; XSetFont(display, gc, lastSubFontPtr->fontStructPtr->fid); if (x > window_width) { break; } } p = next; } if (lastSubFontPtr != &fontPtr->subFontArray[0]) { XSetFont(display, gc, fontPtr->subFontArray[0].fontStructPtr->fid); } if (fontPtr->font.fa.underline != 0) { XFillRectangle(display, drawable, gc, xStart, y + fontPtr->underlinePos, (unsigned) (x - xStart), (unsigned) fontPtr->barHeight); } if (fontPtr->font.fa.overstrike != 0) { y -= fontPtr->font.fm.descent + (fontPtr->font.fm.ascent) / 10; XFillRectangle(display, drawable, gc, xStart, y, (unsigned) (x - xStart), (unsigned) fontPtr->barHeight); } } /* *--------------------------------------------------------------------------- * * TkpDrawCharsInContext -- * * Draw a string of characters on the screen like Tk_DrawChars(), but * with access to all the characters on the line for context. On X11 this * context isn't consulted, so we just call Tk_DrawChars(). * * Results: * None. * * Side effects: * Information gets drawn on the screen. * *--------------------------------------------------------------------------- */ void TkpDrawCharsInContext( Display *display, /* Display on which to draw. */ Drawable drawable, /* Window or pixmap in which to draw. */ GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that * is passed to this function. If they are not * stripped out, they will be displayed as * regular printing characters. */ int numBytes, /* Number of bytes in string. */ int rangeStart, /* Index of first byte to draw. */ int rangeLength, /* Length of range to draw in bytes. */ int x, int y) /* Coordinates at which to place origin of the * whole (not just the range) string when * drawing. */ { (void) numBytes; /*unused*/ Tk_DrawChars(display, drawable, gc, tkfont, source + rangeStart, rangeLength, x, y); } /* *------------------------------------------------------------------------- * * CreateClosestFont -- * * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). Given a * set of font attributes, construct a close XFontStruct. If requested * face name is not available, automatically substitutes an alias for * requested face name. If encoding is not specified (or the requested * one is not available), automatically chooses another encoding from the * list of preferred encodings. If the foundry is not specified (or is * not available) automatically prefers "adobe" foundry. For all other * attributes, if the requested value was not available, the appropriate * "close" value will be used. * * Results: * Return value is the XFontStruct that best matched the requested * attributes. The return value is never NULL; some font will always be * returned. * * Side effects: * None. * *------------------------------------------------------------------------- */ static XFontStruct * CreateClosestFont( Tk_Window tkwin, /* For display where font will be used. */ CONST TkFontAttributes *faPtr, /* Set of generic attributes to match. */ CONST TkXLFDAttributes *xaPtr) /* Set of X-specific attributes to match. */ { FontAttributes want; char **nameList; int numNames, nameIdx, bestIdx[2]; Display *display; XFontStruct *fontStructPtr; unsigned int bestScore[2]; want.fa = *faPtr; want.xa = *xaPtr; if (want.xa.foundry == NULL) { want.xa.foundry = Tk_GetUid("adobe"); } if (want.fa.family == NULL) { want.fa.family = Tk_GetUid("fixed"); } want.fa.size = -TkFontGetPixels(tkwin, faPtr->size); if (want.xa.charset == NULL || *want.xa.charset == '\0') { want.xa.charset = Tk_GetUid("iso8859-1"); /* locale. */ } display = Tk_Display(tkwin); /* * Algorithm to get the closest font to the name requested. * * try fontname * try all aliases for fontname * foreach fallback for fontname * try the fallback * try all aliases for the fallback */ nameList = ListFontOrAlias(display, want.fa.family, &numNames); if (numNames == 0) { char ***fontFallbacks; int i, j; char *fallback; fontFallbacks = TkFontGetFallbacks(); for (i = 0; fontFallbacks[i] != NULL; i++) { for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { if (strcasecmp(want.fa.family, fallback) == 0) { break; } } if (fallback != NULL) { for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { nameList = ListFontOrAlias(display, fallback, &numNames); if (numNames != 0) { goto found; } } } } nameList = ListFonts(display, "fixed", &numNames); if (numNames == 0) { nameList = ListFonts(display, "*", &numNames); } if (numNames == 0) { return GetSystemFont(display); } } found: bestIdx[0] = -1; bestIdx[1] = -1; bestScore[0] = (unsigned int) -1; bestScore[1] = (unsigned int) -1; for (nameIdx = 0; nameIdx < numNames; nameIdx++) { FontAttributes got; int scalable; unsigned int score; if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) { continue; } IdentifySymbolEncodings(&got); scalable = (got.fa.size == 0); score = RankAttributes(&want, &got); if (score < bestScore[scalable]) { bestIdx[scalable] = nameIdx; bestScore[scalable] = score; } if (score == 0) { break; } } fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore); XFreeFontNames(nameList); if (fontStructPtr == NULL) { return GetSystemFont(display); } return fontStructPtr; } /* *--------------------------------------------------------------------------- * * InitFont -- * * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes(). * Initializes the memory for a new UnixFont that wraps the * platform-specific data. * * The caller is responsible for initializing the fields of the TkFont * that are used exclusively by the generic TkFont code, and for * releasing those fields before calling TkpDeleteFont(). * * Results: * Fills the WinFont structure. * * Side effects: * Memory allocated. * *--------------------------------------------------------------------------- */ static void InitFont( Tk_Window tkwin, /* For screen where font will be used. */ XFontStruct *fontStructPtr, /* X information about font. */ UnixFont *fontPtr) /* Filled with information constructed from * the above arguments. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); unsigned long value; int minHi, maxHi, minLo, maxLo, fixed, width, limit, i, n; FontAttributes fa; TkFontAttributes *faPtr; TkFontMetrics *fmPtr; SubFont *controlPtr, *subFontPtr; char *pageMap; Display *display; /* * Get all font attributes and metrics. */ display = Tk_Display(tkwin); GetFontAttributes(display, fontStructPtr, &fa); minHi = fontStructPtr->min_byte1; maxHi = fontStructPtr->max_byte1; minLo = fontStructPtr->min_char_or_byte2; maxLo = fontStructPtr->max_char_or_byte2; fixed = 1; if (fontStructPtr->per_char != NULL) { width = 0; limit = (maxHi - minHi + 1) * (maxLo - minLo + 1); for (i = 0; i < limit; i++) { n = fontStructPtr->per_char[i].width; if (n != 0) { if (width == 0) { width = n; } else if (width != n) { fixed = 0; break; } } } } fontPtr->font.fid = fontStructPtr->fid; faPtr = &fontPtr->font.fa; faPtr->family = fa.fa.family; faPtr->size = TkFontGetPoints(tkwin, fa.fa.size); faPtr->weight = fa.fa.weight; faPtr->slant = fa.fa.slant; faPtr->underline = 0; faPtr->overstrike = 0; fmPtr = &fontPtr->font.fm; fmPtr->ascent = fontStructPtr->ascent; fmPtr->descent = fontStructPtr->descent; fmPtr->maxWidth = fontStructPtr->max_bounds.width; fmPtr->fixed = fixed; fontPtr->display = display; fontPtr->pixelSize = TkFontGetPixels(tkwin, fa.fa.size); fontPtr->xa = fa.xa; fontPtr->numSubFonts = 1; fontPtr->subFontArray = fontPtr->staticSubFonts; InitSubFont(display, fontStructPtr, 1, &fontPtr->subFontArray[0]); fontPtr->controlSubFont = fontPtr->subFontArray[0]; subFontPtr = FindSubFontForChar(fontPtr, '0', NULL); controlPtr = &fontPtr->controlSubFont; controlPtr->fontStructPtr = subFontPtr->fontStructPtr; controlPtr->familyPtr = &tsdPtr->controlFamily; controlPtr->fontMap = tsdPtr->controlFamily.fontMap; pageMap = fontPtr->subFontArray[0].fontMap[0]; for (i = 0; i < 256; i++) { if ((minHi > 0) || (i < minLo) || (i > maxLo) || (((pageMap[i>>3] >> (i&7)) & 1) == 0)) { n = 0; } else if (fontStructPtr->per_char == NULL) { n = fontStructPtr->max_bounds.width; } else { n = fontStructPtr->per_char[i - minLo].width; } fontPtr->widths[i] = n; } if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_POSITION, &value)) { fontPtr->underlinePos = value; } else { /* * If the XA_UNDERLINE_POSITION property does not exist, the X manual * recommends using the following value: */ fontPtr->underlinePos = fontStructPtr->descent / 2; } fontPtr->barHeight = 0; if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_THICKNESS, &value)) { fontPtr->barHeight = value; } if (fontPtr->barHeight == 0) { /* * If the XA_UNDERLINE_THICKNESS property does not exist, the X manual * recommends using the width of the stem on a capital letter. I don't * know of a way to get the stem width of a letter, so guess and use * 1/3 the width of a capital I. */ fontPtr->barHeight = fontPtr->widths['I'] / 3; if (fontPtr->barHeight == 0) { fontPtr->barHeight = 1; } } if (fontPtr->underlinePos + fontPtr->barHeight > fontStructPtr->descent) { /* * If this set of cobbled together values would cause the bottom of * the underline bar to stick below the descent of the font, jack the * underline up a bit higher. */ fontPtr->barHeight = fontStructPtr->descent - fontPtr->underlinePos; if (fontPtr->barHeight == 0) { fontPtr->underlinePos--; fontPtr->barHeight = 1; } } } /* *------------------------------------------------------------------------- * * ReleaseFont -- * * Called to release the unix-specific contents of a TkFont. The caller * is responsible for freeing the memory used by the font itself. * * Results: * None. * * Side effects: * Memory is freed. * *--------------------------------------------------------------------------- */ static void ReleaseFont( UnixFont *fontPtr) /* The font to delete. */ { int i; for (i = 0; i < fontPtr->numSubFonts; i++) { ReleaseSubFont(fontPtr->display, &fontPtr->subFontArray[i]); } if (fontPtr->subFontArray != fontPtr->staticSubFonts) { ckfree((char *) fontPtr->subFontArray); } } /* *------------------------------------------------------------------------- * * InitSubFont -- * * Wrap a screen font and load the FontFamily that represents it. Used to * prepare a SubFont so that characters can be mapped from UTF-8 to the * charset of the font. * * Results: * The subFontPtr is filled with information about the font. * * Side effects: * None. * *------------------------------------------------------------------------- */ static void InitSubFont( Display *display, /* Display in which font will be used. */ XFontStruct *fontStructPtr, /* The screen font. */ int base, /* Non-zero if this SubFont is being used as * the base font for a font object. */ SubFont *subFontPtr) /* Filled with SubFont constructed from above * attributes. */ { subFontPtr->fontStructPtr = fontStructPtr; subFontPtr->familyPtr = AllocFontFamily(display, fontStructPtr, base); subFontPtr->fontMap = subFontPtr->familyPtr->fontMap; } /* *------------------------------------------------------------------------- * * ReleaseSubFont -- * * Called to release the contents of a SubFont. The caller is responsible * for freeing the memory used by the SubFont itself. * * Results: * None. * * Side effects: * Memory and resources are freed. * *--------------------------------------------------------------------------- */ static void ReleaseSubFont( Display *display, /* Display which owns screen font. */ SubFont *subFontPtr) /* The SubFont to delete. */ { XFreeFont(display, subFontPtr->fontStructPtr); FreeFontFamily(subFontPtr->familyPtr); } /* *------------------------------------------------------------------------- * * AllocFontFamily -- * * Find the FontFamily structure associated with the given font name. * The information should be stored by the caller in a SubFont and used * when determining if that SubFont supports a character. * * Cannot use the string name used to construct the font as the key, * because the capitalization may not be canonical. Therefore use the * face name actually retrieved from the font metrics as the key. * * Results: * A pointer to a FontFamily. The reference count in the FontFamily is * automatically incremented. When the SubFont is released, the reference * count is decremented. When no SubFont is using this FontFamily, it may * be deleted. * * Side effects: * A new FontFamily structure will be allocated if this font family has * not been seen. TrueType character existence metrics are loaded into * the FontFamily structure. * *------------------------------------------------------------------------- */ static FontFamily * AllocFontFamily( Display *display, /* Display in which font will be used. */ XFontStruct *fontStructPtr, /* Screen font whose FontFamily is to be * returned. */ int base) /* Non-zero if this font family is to be used * in the base font of a font object. */ { FontFamily *familyPtr; FontAttributes fa; Tcl_Encoding encoding; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); GetFontAttributes(display, fontStructPtr, &fa); encoding = Tcl_GetEncoding(NULL, GetEncodingAlias(fa.xa.charset)); familyPtr = tsdPtr->fontFamilyList; for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) { if ((familyPtr->faceName == fa.fa.family) && (familyPtr->foundry == fa.xa.foundry) && (familyPtr->encoding == encoding)) { Tcl_FreeEncoding(encoding); familyPtr->refCount++; return familyPtr; } } familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily)); memset(familyPtr, 0, sizeof(FontFamily)); familyPtr->nextPtr = tsdPtr->fontFamilyList; tsdPtr->fontFamilyList = familyPtr; /* * Set key for this FontFamily. */ familyPtr->foundry = fa.xa.foundry; familyPtr->faceName = fa.fa.family; familyPtr->encoding = encoding; /* * An initial refCount of 2 means that FontFamily information will persist * even when the SubFont that loaded the FontFamily is released. Change it * to 1 to cause FontFamilies to be unloaded when not in use. */ familyPtr->refCount = 2; /* * 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; } /* *------------------------------------------------------------------------- * * FreeFontFamily -- * * Called to free an FontFamily when the SubFont is finished using it. * Frees the contents of the FontFamily and the memory used by the * FontFamily itself. * * Results: * None. * * Side effects: * None. * *------------------------------------------------------------------------- */ static void FreeFontFamily( FontFamily *familyPtr) /* The FontFamily to delete. */ { FontFamily **familyPtrPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); int i; if (familyPtr == NULL) { return; } familyPtr->refCount--; if (familyPtr->refCount > 0) { return; } Tcl_FreeEncoding(familyPtr->encoding); for (i = 0; i < FONTMAP_PAGES; i++) { if (familyPtr->fontMap[i] != NULL) { ckfree(familyPtr->fontMap[i]); } } /* * Delete from list. */ for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) { if (*familyPtrPtr == familyPtr) { *familyPtrPtr = familyPtr->nextPtr; break; } familyPtrPtr = &(*familyPtrPtr)->nextPtr; } ckfree((char *) familyPtr); } /* *------------------------------------------------------------------------- * * FindSubFontForChar -- * * Determine which screen font is necessary to use to display the given * character. If the font object does not have a screen font that can * display the character, another screen font may be loaded into the font * object, following a set of preferred fallback rules. * * Results: * The return value is the SubFont to use to display the given character. * * Side effects: * The contents of fontPtr are modified to cache the results of the * lookup and remember any SubFonts that were dynamically loaded. The * table of SubFonts might be extended, and if a non-NULL reference to a * subfont pointer is available, it is updated if it previously pointed * into the old subfont table. * *------------------------------------------------------------------------- */ static SubFont * FindSubFontForChar( UnixFont *fontPtr, /* The font object with which the character * will be displayed. */ int ch, /* The Unicode character to be displayed. */ SubFont **fixSubFontPtrPtr) /* Subfont reference to fix up if we * reallocate our subfont table. */ { int i, j, k, numNames; Tk_Uid faceName; char *fallback, **aliases, **nameList, **anyFallbacks, ***fontFallbacks; SubFont *subFontPtr; Tcl_DString ds; if (FontMapLookup(&fontPtr->subFontArray[0], ch)) { return &fontPtr->subFontArray[0]; } for (i = 1; i < fontPtr->numSubFonts; i++) { if (FontMapLookup(&fontPtr->subFontArray[i], ch)) { return &fontPtr->subFontArray[i]; } } if (FontMapLookup(&fontPtr->controlSubFont, ch)) { return &fontPtr->controlSubFont; } /* * Keep track of all face names that we check, so we don't check some name * multiple times if it can be reached by multiple paths. */ Tcl_DStringInit(&ds); /* * Are there any other fonts with the same face name as the base font that * could display this character, e.g., if the base font is * adobe:fixed:iso8859-1, we could might be able to use * misc:fixed:iso8859-8 or sony:fixed:jisx0208.1983-0 */ faceName = fontPtr->font.fa.family; if (SeenName(faceName, &ds) == 0) { subFontPtr = CanUseFallback(fontPtr, faceName, ch, fixSubFontPtrPtr); if (subFontPtr != NULL) { goto end; } } aliases = TkFontGetAliasList(faceName); subFontPtr = NULL; fontFallbacks = TkFontGetFallbacks(); for (i = 0; fontFallbacks[i] != NULL; i++) { for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { if (strcasecmp(fallback, faceName) == 0) { /* * If the base font has a fallback... */ goto tryfallbacks; } else if (aliases != NULL) { /* * Or if an alias for the base font has a fallback... */ for (k = 0; aliases[k] != NULL; k++) { if (strcasecmp(fallback, aliases[k]) == 0) { goto tryfallbacks; } } } } continue; tryfallbacks: /* * ...then see if we can use one of the fallbacks, or an alias for one * of the fallbacks. */ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) { subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds, fixSubFontPtrPtr); if (subFontPtr != NULL) { goto end; } } } /* * See if we can use something from the global fallback list. */ anyFallbacks = TkFontGetGlobalClass(); for (i = 0; (fallback = anyFallbacks[i]) != NULL; i++) { subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds, fixSubFontPtrPtr); if (subFontPtr != NULL) { goto end; } } /* * Try all face names available in the whole system until we find one that * can be used. */ nameList = ListFonts(fontPtr->display, "*", &numNames); for (i = 0; i < numNames; i++) { fallback = strchr(nameList[i] + 1, '-') + 1; strchr(fallback, '-')[0] = '\0'; if (SeenName(fallback, &ds) == 0) { subFontPtr = CanUseFallback(fontPtr, fallback, ch, fixSubFontPtrPtr); if (subFontPtr != NULL) { XFreeFontNames(nameList); goto end; } } } XFreeFontNames(nameList); end: Tcl_DStringFree(&ds); if (subFontPtr == NULL) { /* * No font can display this character, so it will be displayed as a * control character expansion. */ subFontPtr = &fontPtr->controlSubFont; FontMapInsert(subFontPtr, ch); } return subFontPtr; } /* *------------------------------------------------------------------------- * * FontMapLookup -- * * See if the screen font can display the given character. * * Results: * The return value is 0 if the screen font cannot display the character, * non-zero otherwise. * * Side effects: * New pages are added to the font mapping cache whenever the character * belongs to a page that hasn't been seen before. When a page is loaded, * information about all the characters on that page is stored, not just * for the single character in question. * *------------------------------------------------------------------------- */ static int FontMapLookup( SubFont *subFontPtr, /* Contains font mapping cache to be queried * and possibly updated. */ int ch) /* Character to be tested. */ { int row, bitOffset; row = ch >> FONTMAP_SHIFT; if (subFontPtr->fontMap[row] == NULL) { FontMapLoadPage(subFontPtr, row); } bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1; } /* *------------------------------------------------------------------------- * * FontMapInsert -- * * Tell the font mapping cache that the given screen font should be used * to display the specified character. This is called when no font on the * system can be be found that can display that character; we lie to the * font and tell it that it can display the character, otherwise we would * end up re-searching the entire fallback hierarchy every time that * character was seen. * * Results: * None. * * Side effects: * New pages are added to the font mapping cache whenever the character * belongs to a page that hasn't been seen before. When a page is loaded, * information about all the characters on that page is stored, not just * for the single character in question. * *------------------------------------------------------------------------- */ static void FontMapInsert( SubFont *subFontPtr, /* Contains font mapping cache to be * updated. */ int ch) /* Character to be added to cache. */ { int row, bitOffset; row = ch >> FONTMAP_SHIFT; if (subFontPtr->fontMap[row] == NULL) { FontMapLoadPage(subFontPtr, row); } bitOffset = ch & (FONTMAP_BITSPERPAGE - 1); subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); } /* *------------------------------------------------------------------------- * * FontMapLoadPage -- * * Load information about all the characters on a given page. This * information consists of one bit per character that indicates whether * the associated screen font can (1) or cannot (0) display the * characters on the page. * * Results: * None. * * Side effects: * Memory allocated. * *------------------------------------------------------------------------- */ static void FontMapLoadPage( SubFont *subFontPtr, /* Contains font mapping cache to be * updated. */ int row) /* Index of the page to be loaded into the * cache. */ { char buf[16], src[TCL_UTF_MAX]; int minHi, maxHi, minLo, maxLo, scale, checkLo; int i, end, bitOffset, isTwoByteFont, n; Tcl_Encoding encoding; XFontStruct *fontStructPtr; XCharStruct *widths; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8); memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8); if (subFontPtr->familyPtr == &tsdPtr->controlFamily) { return; } fontStructPtr = subFontPtr->fontStructPtr; encoding = subFontPtr->familyPtr->encoding; isTwoByteFont = subFontPtr->familyPtr->isTwoByteFont; widths = fontStructPtr->per_char; minHi = fontStructPtr->min_byte1; maxHi = fontStructPtr->max_byte1; minLo = fontStructPtr->min_char_or_byte2; maxLo = fontStructPtr->max_char_or_byte2; scale = maxLo - minLo + 1; checkLo = minLo; if (! isTwoByteFont) { if (minLo < 32) { checkLo = 32; } } end = (row + 1) << FONTMAP_SHIFT; for (i = row << FONTMAP_SHIFT; i < end; i++) { int hi, lo; if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src), TCL_ENCODING_STOPONERROR, NULL, buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK) { continue; } if (isTwoByteFont) { hi = ((unsigned char *) buf)[0]; lo = ((unsigned char *) buf)[1]; } else { hi = 0; lo = ((unsigned char *) buf)[0]; } if ((hi < minHi) || (hi > maxHi) || (lo < checkLo) || (lo > maxLo)) { continue; } n = (hi - minHi) * scale + lo - minLo; if ((widths == NULL) || (widths[n].width + widths[n].rbearing != 0)) { bitOffset = i & (FONTMAP_BITSPERPAGE - 1); subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); } } } /* *--------------------------------------------------------------------------- * * CanUseFallbackWithAliases -- * * Helper function for FindSubFontForChar. Determine if the specified * face name (or an alias of the specified face name) can be used to * construct a screen font that can display the given character. * * Results: * See CanUseFallback(). * * Side effects: * If the name and/or one of its aliases was rejected, the rejected * string is recorded in nameTriedPtr so that it won't be tried again. * The table of SubFonts might be extended, and if a non-NULL reference * to a subfont pointer is available, it is updated if it previously * pointed into the old subfont table. * *--------------------------------------------------------------------------- */ static SubFont * CanUseFallbackWithAliases( UnixFont *fontPtr, /* The font object that will own the new * screen font. */ char *faceName, /* Desired face name for new screen font. */ int ch, /* The Unicode character that the new screen * font must be able to display. */ Tcl_DString *nameTriedPtr, /* Records face names that have already been * tried. It is possible for the same face * name to be queried multiple times when * trying to find a suitable screen font. */ SubFont **fixSubFontPtrPtr) /* Subfont reference to fix up if we * reallocate our subfont table. */ { SubFont *subFontPtr; char **aliases; int i; if (SeenName(faceName, nameTriedPtr) == 0) { subFontPtr = CanUseFallback(fontPtr, faceName, ch, fixSubFontPtrPtr); if (subFontPtr != NULL) { return subFontPtr; } } aliases = TkFontGetAliasList(faceName); if (aliases != NULL) { for (i = 0; aliases[i] != NULL; i++) { if (SeenName(aliases[i], nameTriedPtr) == 0) { subFontPtr = CanUseFallback(fontPtr, aliases[i], ch, fixSubFontPtrPtr); if (subFontPtr != NULL) { return subFontPtr; } } } } return NULL; } /* *--------------------------------------------------------------------------- * * SeenName -- * * Used to determine we have already tried and rejected the given face * name when looking for a screen font that can support some Unicode * character. * * Results: * The return value is 0 if this face name has not already been seen, * non-zero otherwise. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int SeenName( CONST char *name, /* The name to check. */ Tcl_DString *dsPtr) /* Contains names that have already been * seen. */ { CONST char *seen, *end; seen = Tcl_DStringValue(dsPtr); end = seen + Tcl_DStringLength(dsPtr); while (seen < end) { if (strcasecmp(seen, name) == 0) { return 1; } seen += strlen(seen) + 1; } Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1)); return 0; } /* *------------------------------------------------------------------------- * * CanUseFallback -- * * If the specified screen font has not already been loaded into the font * object, determine if the specified screen font can display the given * character. * * Results: * The return value is a pointer to a newly allocated SubFont, owned by * the font object. This SubFont can be used to display the given * character. The SubFont represents the screen font with the base set of * font attributes from the font object, but using the specified face * name. NULL is returned if the font object already holds a reference to * the specified font or if the specified font doesn't exist or cannot * display the given character. * * Side effects: * The font object's subFontArray is updated to contain a reference to * the newly allocated SubFont. The table of SubFonts might be extended, * and if a non-NULL reference to a subfont pointer is available, it is * updated if it previously pointed into the old subfont table. * *------------------------------------------------------------------------- */ static SubFont * CanUseFallback( UnixFont *fontPtr, /* The font object that will own the new * screen font. */ CONST char *faceName, /* Desired face name for new screen font. */ int ch, /* The Unicode character that the new screen * font must be able to display. */ SubFont **fixSubFontPtrPtr) /* Subfont reference to fix up if we * reallocate our subfont table. */ { int i, nameIdx, numNames, srcLen, numEncodings, bestIdx[2]; Tk_Uid hateFoundry; CONST char *charset, *hateCharset; unsigned int bestScore[2]; char **nameList, **nameListOrig, src[TCL_UTF_MAX]; FontAttributes want, got; Display *display; SubFont subFont; XFontStruct *fontStructPtr; Tcl_DString dsEncodings; Tcl_Encoding *encodingCachePtr; /* * Assume: the face name is times. * Assume: adobe:times:iso8859-1 has already been used. * * Are there any versions of times that can display this character (e.g., * perhaps linotype:times:iso8859-2)? * a. Get list of all times fonts. * b1. Cross out all names whose encodings we've already used. * b2. Cross out all names whose foundry & encoding we've already seen. * c. Cross out all names whose encoding cannot handle the character. * d. Rank each name and pick the best match. * e. If that font cannot actually display the character, cross out all * names with the same foundry and encoding and go back to (c). */ display = fontPtr->display; nameList = ListFonts(display, faceName, &numNames); if (numNames == 0) { return NULL; } nameListOrig = nameList; srcLen = Tcl_UniCharToUtf(ch, src); want.fa = fontPtr->font.fa; want.xa = fontPtr->xa; want.fa.family = Tk_GetUid(faceName); want.fa.size = -fontPtr->pixelSize; hateFoundry = NULL; hateCharset = NULL; numEncodings = 0; Tcl_DStringInit(&dsEncodings); charset = NULL; /* lint, since numNames must be > 0 to get here. */ retry: bestIdx[0] = -1; bestIdx[1] = -1; bestScore[0] = (unsigned int) -1; bestScore[1] = (unsigned int) -1; for (nameIdx = 0; nameIdx < numNames; nameIdx++) { Tcl_Encoding encoding; char dst[16]; int scalable, srcRead, dstWrote; unsigned int score; if (nameList[nameIdx] == NULL) { continue; } if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) { goto crossout; } IdentifySymbolEncodings(&got); charset = GetEncodingAlias(got.xa.charset); if (hateFoundry != NULL) { /* * E. If the font we picked cannot actually display the character, * cross out all names with the same foundry and encoding. */ if ((hateFoundry == got.xa.foundry) && (strcmp(hateCharset, charset) == 0)) { goto crossout; } } else { /* * B. Cross out all names whose encodings we've already used. */ for (i = 0; i < fontPtr->numSubFonts; i++) { encoding = fontPtr->subFontArray[i].familyPtr->encoding; if (strcmp(charset, Tcl_GetEncodingName(encoding)) == 0) { goto crossout; } } } /* * C. Cross out all names whose encoding cannot handle the character. */ encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings); for (i = numEncodings; --i >= 0; encodingCachePtr++) { encoding = *encodingCachePtr; if (strcmp(Tcl_GetEncodingName(encoding), charset) == 0) { break; } } if (i < 0) { encoding = Tcl_GetEncoding(NULL, charset); if (encoding == NULL) { goto crossout; } Tcl_DStringAppend(&dsEncodings, (char *) &encoding, sizeof(encoding)); numEncodings++; } Tcl_UtfToExternal(NULL, encoding, src, srcLen, TCL_ENCODING_STOPONERROR, NULL, dst, sizeof(dst), &srcRead, &dstWrote, NULL); if (dstWrote == 0) { goto crossout; } /* * D. Rank each name and pick the best match. */ scalable = (got.fa.size == 0); score = RankAttributes(&want, &got); if (score < bestScore[scalable]) { bestIdx[scalable] = nameIdx; bestScore[scalable] = score; } if (score == 0) { break; } continue; crossout: if (nameList == nameListOrig) { /* * Not allowed to change pointers to memory that X gives you, so * make a copy. */ nameList = (char **) ckalloc(numNames * sizeof(char *)); memcpy(nameList, nameListOrig, numNames * sizeof(char *)); } nameList[nameIdx] = NULL; } fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore); encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings); for (i = numEncodings; --i >= 0; encodingCachePtr++) { Tcl_FreeEncoding(*encodingCachePtr); } Tcl_DStringFree(&dsEncodings); numEncodings = 0; if (fontStructPtr == NULL) { if (nameList != nameListOrig) { ckfree((char *) nameList); } XFreeFontNames(nameListOrig); return NULL; } InitSubFont(display, fontStructPtr, 0, &subFont); if (FontMapLookup(&subFont, ch) == 0) { /* * E. If the font we picked cannot actually display the character, * cross out all names with the same foundry and encoding and pick * another font. */ hateFoundry = got.xa.foundry; hateCharset = charset; ReleaseSubFont(display, &subFont); goto retry; } if (nameList != nameListOrig) { ckfree((char *) nameList); } XFreeFontNames(nameListOrig); if (fontPtr->numSubFonts >= SUBFONT_SPACE) { SubFont *newPtr; newPtr = (SubFont *) ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1)); memcpy((char *) newPtr, fontPtr->subFontArray, fontPtr->numSubFonts * sizeof(SubFont)); if (fixSubFontPtrPtr != NULL) { register SubFont *fixSubFontPtr = *fixSubFontPtrPtr; if (fixSubFontPtr != &fontPtr->controlSubFont) { *fixSubFontPtrPtr = newPtr + (fixSubFontPtr - fontPtr->subFontArray); } } if (fontPtr->subFontArray != fontPtr->staticSubFonts) { ckfree((char *) fontPtr->subFontArray); } fontPtr->subFontArray = newPtr; } fontPtr->subFontArray[fontPtr->numSubFonts] = subFont; fontPtr->numSubFonts++; return &fontPtr->subFontArray[fontPtr->numSubFonts - 1]; } /* *--------------------------------------------------------------------------- * * RankAttributes -- * * Determine how close the attributes of the font in question match the * attributes that we want. * * Results: * The return value is the score; lower numbers are better. *scalablePtr * is set to 0 if the font was not scalable, 1 otherwise. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static unsigned int RankAttributes( FontAttributes *wantPtr, /* The desired attributes. */ FontAttributes *gotPtr) /* The attributes we have to live with. */ { unsigned int penalty; penalty = 0; if (gotPtr->xa.foundry != wantPtr->xa.foundry) { penalty += 4500; } if (gotPtr->fa.family != wantPtr->fa.family) { penalty += 9000; } if (gotPtr->fa.weight != wantPtr->fa.weight) { penalty += 90; } if (gotPtr->fa.slant != wantPtr->fa.slant) { penalty += 60; } if (gotPtr->xa.slant != wantPtr->xa.slant) { penalty += 10; } if (gotPtr->xa.setwidth != wantPtr->xa.setwidth) { penalty += 1000; } if (gotPtr->fa.size == 0) { /* * A scalable font is almost always acceptable, but the corresponding * bitmapped font would be better. */ penalty += 10; } else { int diff; /* * It's worse to be too large than to be too small. */ diff = (-gotPtr->fa.size - -wantPtr->fa.size); if (diff > 0) { penalty += 600; } else if (diff < 0) { penalty += 150; diff = -diff; } penalty += 150 * diff; } if (gotPtr->xa.charset != wantPtr->xa.charset) { int i; CONST char *gotAlias, *wantAlias; penalty += 65000; gotAlias = GetEncodingAlias(gotPtr->xa.charset); wantAlias = GetEncodingAlias(wantPtr->xa.charset); if (strcmp(gotAlias, wantAlias) != 0) { penalty += 30000; for (i = 0; encodingList[i] != NULL; i++) { if (strcmp(gotAlias, encodingList[i]) == 0) { penalty -= 30000; break; } penalty += 20000; } } } return penalty; } /* *--------------------------------------------------------------------------- * * GetScreenFont -- * * Given the names for the best scalable and best bitmapped font, * actually construct an XFontStruct based on the best XLFD. This is * where all the alias and fallback substitution bottoms out. * * Results: * The screen font that best corresponds to the set of attributes. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static XFontStruct * GetScreenFont( Display *display, /* Display for new XFontStruct. */ FontAttributes *wantPtr, /* Contains desired actual pixel-size if the * best font was scalable. */ char **nameList, /* Array of XLFDs. */ int bestIdx[2], /* Indices into above array for XLFD of best * bitmapped and best scalable font. */ unsigned int bestScore[2]) /* Scores of best bitmapped and best scalable * font. XLFD corresponding to lowest score * will be constructed. */ { XFontStruct *fontStructPtr; if ((bestIdx[0] < 0) && (bestIdx[1] < 0)) { return NULL; } /* * Now we know which is the closest matching scalable font and the closest * matching bitmapped font. If the scalable font was a better match, try * getting the scalable font; however, if the scalable font was not * actually available in the desired pointsize, fall back to the closest * bitmapped font. */ fontStructPtr = NULL; if (bestScore[1] < bestScore[0]) { char *str, *rest, buf[256]; int i; /* * Fill in the desired pixel size for this font. */ tryscale: str = nameList[bestIdx[1]]; for (i = 0; i < XLFD_PIXEL_SIZE; i++) { str = strchr(str + 1, '-'); } rest = str; for (i = XLFD_PIXEL_SIZE; i < XLFD_CHARSET; i++) { rest = strchr(rest + 1, '-'); } *str = '\0'; sprintf(buf, "%.200s-%d-*-*-*-*-*%s", nameList[bestIdx[1]], -wantPtr->fa.size, rest); *str = '-'; fontStructPtr = XLoadQueryFont(display, buf); bestScore[1] = INT_MAX; } if (fontStructPtr == NULL) { fontStructPtr = XLoadQueryFont(display, nameList[bestIdx[0]]); if (fontStructPtr == NULL) { /* * This shouldn't happen because the font name is one of the names * that X gave us to use, but it does anyhow. */ if (bestScore[1] < INT_MAX) { goto tryscale; } return GetSystemFont(display); } } return fontStructPtr; } /* *--------------------------------------------------------------------------- * * GetSystemFont -- * * Absolute fallback mechanism, called when we need a font and no other * font can be found and/or instantiated. * * Results: * A pointer to a font. Never NULL. * * Side effects: * If there are NO fonts installed on the system, this call will panic, * but how did you get X running in that case? * *--------------------------------------------------------------------------- */ static XFontStruct * GetSystemFont( Display *display) /* Display for new XFontStruct. */ { XFontStruct *fontStructPtr; fontStructPtr = XLoadQueryFont(display, "fixed"); if (fontStructPtr == NULL) { fontStructPtr = XLoadQueryFont(display, "*"); if (fontStructPtr == NULL) { Tcl_Panic("TkpGetFontFromAttributes: cannot get any font"); } } return fontStructPtr; } /* *--------------------------------------------------------------------------- * * GetFontAttributes -- * * Given a screen font, determine its actual attributes, which are not * necessarily the attributes that were used to construct it. * * Results: * *faPtr is filled with the screen font's attributes. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int GetFontAttributes( Display *display, /* Display that owns the screen font. */ XFontStruct *fontStructPtr, /* Screen font to query. */ FontAttributes *faPtr) /* For storing attributes of screen font. */ { unsigned long value; char *name; if ((XGetFontProperty(fontStructPtr, XA_FONT, &value) != False) && (value != 0)) { name = XGetAtomName(display, (Atom) value); if (TkFontParseXLFD(name, &faPtr->fa, &faPtr->xa) != TCL_OK) { faPtr->fa.family = Tk_GetUid(name); faPtr->xa.foundry = Tk_GetUid(""); faPtr->xa.charset = Tk_GetUid(""); } XFree(name); } else { TkInitFontAttributes(&faPtr->fa); TkInitXLFDAttributes(&faPtr->xa); } /* * Do last ditch check for family. It seems that some X servers can fail * on the X font calls above, slipping through earlier checks. X-Win32 5.4 * is one of these. */ if (faPtr->fa.family == NULL) { faPtr->fa.family = Tk_GetUid(""); faPtr->xa.foundry = Tk_GetUid(""); faPtr->xa.charset = Tk_GetUid(""); } return IdentifySymbolEncodings(faPtr); } /* *--------------------------------------------------------------------------- * * ListFonts -- * * Utility function to return the array of all XLFDs on the system with * the specified face name. * * Results: * The return value is an array of XLFDs, which should be freed with * XFreeFontNames(), or NULL if no XLFDs matched the requested name. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static char ** ListFonts( Display *display, /* Display to query. */ CONST char *faceName, /* Desired face name, or "*" for all. */ int *numNamesPtr) /* Filled with length of returned array, or 0 * if no names were found. */ { char buf[256]; sprintf(buf, "-*-%.80s-*-*-*-*-*-*-*-*-*-*-*-*", faceName); return XListFonts(display, buf, 10000, numNamesPtr); } static char ** ListFontOrAlias( Display *display, /* Display to query. */ CONST char *faceName, /* Desired face name, or "*" for all. */ int *numNamesPtr) /* Filled with length of returned array, or 0 * if no names were found. */ { char **nameList, **aliases; int i; nameList = ListFonts(display, faceName, numNamesPtr); if (nameList != NULL) { return nameList; } aliases = TkFontGetAliasList(faceName); if (aliases != NULL) { for (i = 0; aliases[i] != NULL; i++) { nameList = ListFonts(display, aliases[i], numNamesPtr); if (nameList != NULL) { return nameList; } } } *numNamesPtr = 0; return NULL; } /* *--------------------------------------------------------------------------- * * IdentifySymbolEncodings -- * * If the font attributes refer to a symbol font, update the charset * field of the font attributes so that it reflects the encoding of that * symbol font. In general, the raw value for the charset field parsed * from an XLFD is meaningless for symbol fonts. * * Symbol fonts are all fonts whose name appears in the symbolClass. * * Results: * The return value is non-zero if the font attributes specify a symbol * font, or 0 otherwise. If a non-zero value is returned the charset * field of the font attributes will be changed to the string that * represents the actual encoding for the symbol font. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int IdentifySymbolEncodings( FontAttributes *faPtr) { int i, j; char **aliases, **symbolClass; symbolClass = TkFontGetSymbolClass(); for (i = 0; symbolClass[i] != NULL; i++) { if (strcasecmp(faPtr->fa.family, symbolClass[i]) == 0) { faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(symbolClass[i])); return 1; } aliases = TkFontGetAliasList(symbolClass[i]); for (j = 0; (aliases != NULL) && (aliases[j] != NULL); j++) { if (strcasecmp(faPtr->fa.family, aliases[j]) == 0) { faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(aliases[j])); return 1; } } } return 0; } /* *--------------------------------------------------------------------------- * * GetEncodingAlias -- * * Map the name of an encoding to another name that should be used when * actually loading the encoding. For instance, the encodings * "jisc6226.1978", "jisx0208.1983", "jisx0208.1990", and "jisx0208.1996" * are well-known names for the same encoding and are represented by one * encoding table: "jis0208". * * Results: * As above. If the name has no alias, the original name is returned. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static CONST char * GetEncodingAlias( CONST char *name) /* The name to look up. */ { EncodingAlias *aliasPtr; for (aliasPtr = encodingAliases; aliasPtr->aliasPattern != NULL; ) { if (Tcl_StringMatch((char *) name, aliasPtr->aliasPattern)) { return aliasPtr->realName; } aliasPtr++; } return name; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixDefault.h0000644003604700454610000004117012612445655014512 0ustar dgp771div/* * tkUnixDefault.h -- * * This file defines the defaults for all options for all of * the Tk widgets. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TKUNIXDEFAULT #define _TKUNIXDEFAULT /* * The definitions below provide symbolic names for the default colors. * NORMAL_BG - Normal background color. * ACTIVE_BG - Background color when widget is active. * SELECT_BG - Background color for selected text. * TROUGH - Background color for troughs in scales and scrollbars. * INDICATOR - Color for indicator when button is selected. * DISABLED - Foreground color when widget is disabled. */ #define BLACK "#000000" #define WHITE "#ffffff" #define NORMAL_BG "#d9d9d9" #define ACTIVE_BG "#ececec" #define SELECT_BG "#c3c3c3" #define TROUGH "#b3b3b3" #define CHECK_INDICATOR WHITE #define MENU_INDICATOR BLACK #define DISABLED "#a3a3a3" /* * Defaults for labels, buttons, checkbuttons, and radiobuttons: */ #define DEF_BUTTON_ANCHOR "center" #define DEF_BUTTON_ACTIVE_BG_COLOR ACTIVE_BG #define DEF_BUTTON_ACTIVE_BG_MONO BLACK #define DEF_BUTTON_ACTIVE_FG_COLOR BLACK #define DEF_CHKRAD_ACTIVE_FG_COLOR DEF_BUTTON_ACTIVE_FG_COLOR #define DEF_BUTTON_ACTIVE_FG_MONO WHITE #define DEF_BUTTON_BG_COLOR NORMAL_BG #define DEF_BUTTON_BG_MONO WHITE #define DEF_BUTTON_BITMAP "" #define DEF_BUTTON_BORDER_WIDTH "1" #define DEF_BUTTON_CURSOR "" #define DEF_BUTTON_COMPOUND "none" #define DEF_BUTTON_COMMAND "" #define DEF_BUTTON_DEFAULT "disabled" #define DEF_BUTTON_DISABLED_FG_COLOR DISABLED #define DEF_BUTTON_DISABLED_FG_MONO "" #define DEF_BUTTON_FG BLACK #define DEF_CHKRAD_FG DEF_BUTTON_FG #define DEF_BUTTON_FONT "TkDefaultFont" #define DEF_BUTTON_HEIGHT "0" #define DEF_BUTTON_HIGHLIGHT_BG_COLOR DEF_BUTTON_BG_COLOR #define DEF_BUTTON_HIGHLIGHT_BG_MONO DEF_BUTTON_BG_MONO #define DEF_BUTTON_HIGHLIGHT BLACK #define DEF_LABEL_HIGHLIGHT_WIDTH "0" #define DEF_BUTTON_HIGHLIGHT_WIDTH "1" #define DEF_BUTTON_IMAGE (char *) NULL #define DEF_BUTTON_INDICATOR "1" #define DEF_BUTTON_JUSTIFY "center" #define DEF_BUTTON_OFF_VALUE "0" #define DEF_BUTTON_ON_VALUE "1" #define DEF_BUTTON_TRISTATE_VALUE "" #define DEF_BUTTON_OVER_RELIEF "" #define DEF_BUTTON_PADX "3m" #define DEF_LABCHKRAD_PADX "1" #define DEF_BUTTON_PADY "1m" #define DEF_LABCHKRAD_PADY "1" #define DEF_BUTTON_RELIEF "raised" #define DEF_LABCHKRAD_RELIEF "flat" #define DEF_BUTTON_REPEAT_DELAY "0" #define DEF_BUTTON_REPEAT_INTERVAL "0" #define DEF_BUTTON_SELECT_COLOR CHECK_INDICATOR #define DEF_BUTTON_SELECT_MONO BLACK #define DEF_BUTTON_SELECT_IMAGE (char *) NULL #define DEF_BUTTON_STATE "normal" #define DEF_LABEL_TAKE_FOCUS "0" #define DEF_BUTTON_TAKE_FOCUS (char *) NULL #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" #define DEF_BUTTON_UNDERLINE "-1" #define DEF_BUTTON_VALUE "" #define DEF_BUTTON_WIDTH "0" #define DEF_BUTTON_WRAP_LENGTH "0" #define DEF_RADIOBUTTON_VARIABLE "selectedButton" #define DEF_CHECKBUTTON_VARIABLE "" /* * Defaults for canvases: */ #define DEF_CANVAS_BG_COLOR NORMAL_BG #define DEF_CANVAS_BG_MONO WHITE #define DEF_CANVAS_BORDER_WIDTH "0" #define DEF_CANVAS_CLOSE_ENOUGH "1" #define DEF_CANVAS_CONFINE "1" #define DEF_CANVAS_CURSOR "" #define DEF_CANVAS_HEIGHT "7c" #define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG #define DEF_CANVAS_HIGHLIGHT BLACK #define DEF_CANVAS_HIGHLIGHT_WIDTH "1" #define DEF_CANVAS_INSERT_BG BLACK #define DEF_CANVAS_INSERT_BD_COLOR "0" #define DEF_CANVAS_INSERT_BD_MONO "0" #define DEF_CANVAS_INSERT_OFF_TIME "300" #define DEF_CANVAS_INSERT_ON_TIME "600" #define DEF_CANVAS_INSERT_WIDTH "2" #define DEF_CANVAS_RELIEF "flat" #define DEF_CANVAS_SCROLL_REGION "" #define DEF_CANVAS_SELECT_COLOR SELECT_BG #define DEF_CANVAS_SELECT_MONO BLACK #define DEF_CANVAS_SELECT_BD_COLOR "1" #define DEF_CANVAS_SELECT_BD_MONO "0" #define DEF_CANVAS_SELECT_FG_COLOR BLACK #define DEF_CANVAS_SELECT_FG_MONO WHITE #define DEF_CANVAS_TAKE_FOCUS (char *) NULL #define DEF_CANVAS_WIDTH "10c" #define DEF_CANVAS_X_SCROLL_CMD "" #define DEF_CANVAS_X_SCROLL_INCREMENT "0" #define DEF_CANVAS_Y_SCROLL_CMD "" #define DEF_CANVAS_Y_SCROLL_INCREMENT "0" /* * Defaults for entries: */ #define DEF_ENTRY_BG_COLOR WHITE #define DEF_ENTRY_BG_MONO WHITE #define DEF_ENTRY_BORDER_WIDTH "1" #define DEF_ENTRY_CURSOR "xterm" #define DEF_ENTRY_DISABLED_BG_COLOR NORMAL_BG #define DEF_ENTRY_DISABLED_BG_MONO WHITE #define DEF_ENTRY_DISABLED_FG DISABLED #define DEF_ENTRY_EXPORT_SELECTION "1" #define DEF_ENTRY_FONT "TkTextFont" #define DEF_ENTRY_FG BLACK #define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG #define DEF_ENTRY_HIGHLIGHT BLACK #define DEF_ENTRY_HIGHLIGHT_WIDTH "1" #define DEF_ENTRY_INSERT_BG BLACK #define DEF_ENTRY_INSERT_BD_COLOR "0" #define DEF_ENTRY_INSERT_BD_MONO "0" #define DEF_ENTRY_INSERT_OFF_TIME "300" #define DEF_ENTRY_INSERT_ON_TIME "600" #define DEF_ENTRY_INSERT_WIDTH "2" #define DEF_ENTRY_JUSTIFY "left" #define DEF_ENTRY_READONLY_BG_COLOR NORMAL_BG #define DEF_ENTRY_READONLY_BG_MONO WHITE #define DEF_ENTRY_RELIEF "sunken" #define DEF_ENTRY_SCROLL_COMMAND "" #define DEF_ENTRY_SELECT_COLOR SELECT_BG #define DEF_ENTRY_SELECT_MONO BLACK #define DEF_ENTRY_SELECT_BD_COLOR "0" #define DEF_ENTRY_SELECT_BD_MONO "0" #define DEF_ENTRY_SELECT_FG_COLOR BLACK #define DEF_ENTRY_SELECT_FG_MONO WHITE #define DEF_ENTRY_SHOW (char *) NULL #define DEF_ENTRY_STATE "normal" #define DEF_ENTRY_TAKE_FOCUS (char *) NULL #define DEF_ENTRY_TEXT_VARIABLE "" #define DEF_ENTRY_WIDTH "20" /* * Defaults for frames: */ #define DEF_FRAME_BG_COLOR NORMAL_BG #define DEF_FRAME_BG_MONO WHITE #define DEF_FRAME_BORDER_WIDTH "0" #define DEF_FRAME_CLASS "Frame" #define DEF_FRAME_COLORMAP "" #define DEF_FRAME_CONTAINER "0" #define DEF_FRAME_CURSOR "" #define DEF_FRAME_HEIGHT "0" #define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG #define DEF_FRAME_HIGHLIGHT BLACK #define DEF_FRAME_HIGHLIGHT_WIDTH "0" #define DEF_FRAME_LABEL "" #define DEF_FRAME_PADX "0" #define DEF_FRAME_PADY "0" #define DEF_FRAME_RELIEF "flat" #define DEF_FRAME_TAKE_FOCUS "0" #define DEF_FRAME_VISUAL "" #define DEF_FRAME_WIDTH "0" /* * Defaults for labelframes: */ #define DEF_LABELFRAME_BORDER_WIDTH "2" #define DEF_LABELFRAME_CLASS "Labelframe" #define DEF_LABELFRAME_RELIEF "groove" #define DEF_LABELFRAME_FG BLACK #define DEF_LABELFRAME_FONT "TkDefaultFont" #define DEF_LABELFRAME_TEXT "" #define DEF_LABELFRAME_LABELANCHOR "nw" /* * Defaults for listboxes: */ #define DEF_LISTBOX_ACTIVE_STYLE "dotbox" #define DEF_LISTBOX_BG_COLOR WHITE #define DEF_LISTBOX_BG_MONO WHITE #define DEF_LISTBOX_BORDER_WIDTH "1" #define DEF_LISTBOX_CURSOR "" #define DEF_LISTBOX_DISABLED_FG DISABLED #define DEF_LISTBOX_EXPORT_SELECTION "1" #define DEF_LISTBOX_FONT "TkDefaultFont" #define DEF_LISTBOX_FG BLACK #define DEF_LISTBOX_HEIGHT "10" #define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG #define DEF_LISTBOX_HIGHLIGHT BLACK #define DEF_LISTBOX_HIGHLIGHT_WIDTH "1" #define DEF_LISTBOX_RELIEF "sunken" #define DEF_LISTBOX_SCROLL_COMMAND "" #define DEF_LISTBOX_LIST_VARIABLE "" #define DEF_LISTBOX_SELECT_COLOR SELECT_BG #define DEF_LISTBOX_SELECT_MONO BLACK #define DEF_LISTBOX_SELECT_BD "0" #define DEF_LISTBOX_SELECT_FG_COLOR BLACK #define DEF_LISTBOX_SELECT_FG_MONO WHITE #define DEF_LISTBOX_SELECT_MODE "browse" #define DEF_LISTBOX_SET_GRID "0" #define DEF_LISTBOX_STATE "normal" #define DEF_LISTBOX_TAKE_FOCUS (char *) NULL #define DEF_LISTBOX_WIDTH "20" /* * Defaults for individual entries of menus: */ #define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL #define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL #define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL #define DEF_MENU_ENTRY_BG (char *) NULL #define DEF_MENU_ENTRY_BITMAP None #define DEF_MENU_ENTRY_COLUMN_BREAK "0" #define DEF_MENU_ENTRY_COMMAND (char *) NULL #define DEF_MENU_ENTRY_COMPOUND "none" #define DEF_MENU_ENTRY_FG (char *) NULL #define DEF_MENU_ENTRY_FONT (char *) NULL #define DEF_MENU_ENTRY_HIDE_MARGIN "0" #define DEF_MENU_ENTRY_IMAGE (char *) NULL #define DEF_MENU_ENTRY_INDICATOR "1" #define DEF_MENU_ENTRY_LABEL (char *) NULL #define DEF_MENU_ENTRY_MENU (char *) NULL #define DEF_MENU_ENTRY_OFF_VALUE "0" #define DEF_MENU_ENTRY_ON_VALUE "1" #define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL #define DEF_MENU_ENTRY_STATE "normal" #define DEF_MENU_ENTRY_VALUE (char *) NULL #define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" #define DEF_MENU_ENTRY_SELECT (char *) NULL #define DEF_MENU_ENTRY_UNDERLINE "-1" /* * Defaults for menus overall: */ #define DEF_MENU_ACTIVE_BG_COLOR ACTIVE_BG #define DEF_MENU_ACTIVE_BG_MONO BLACK #define DEF_MENU_ACTIVE_BORDER_WIDTH "1" #define DEF_MENU_ACTIVE_FG_COLOR BLACK #define DEF_MENU_ACTIVE_FG_MONO WHITE #define DEF_MENU_BG_COLOR NORMAL_BG #define DEF_MENU_BG_MONO WHITE #define DEF_MENU_BORDER_WIDTH "1" #define DEF_MENU_CURSOR "arrow" #define DEF_MENU_DISABLED_FG_COLOR DISABLED #define DEF_MENU_DISABLED_FG_MONO "" #define DEF_MENU_FONT "TkMenuFont" #define DEF_MENU_FG BLACK #define DEF_MENU_POST_COMMAND "" #define DEF_MENU_RELIEF "raised" #define DEF_MENU_SELECT_COLOR MENU_INDICATOR #define DEF_MENU_SELECT_MONO BLACK #define DEF_MENU_TAKE_FOCUS "0" #define DEF_MENU_TEAROFF "1" #define DEF_MENU_TEAROFF_CMD (char *) NULL #define DEF_MENU_TITLE "" #define DEF_MENU_TYPE "normal" /* * Defaults for menubuttons: */ #define DEF_MENUBUTTON_ANCHOR "center" #define DEF_MENUBUTTON_ACTIVE_BG_COLOR ACTIVE_BG #define DEF_MENUBUTTON_ACTIVE_BG_MONO BLACK #define DEF_MENUBUTTON_ACTIVE_FG_COLOR BLACK #define DEF_MENUBUTTON_ACTIVE_FG_MONO WHITE #define DEF_MENUBUTTON_BG_COLOR NORMAL_BG #define DEF_MENUBUTTON_BG_MONO WHITE #define DEF_MENUBUTTON_BITMAP "" #define DEF_MENUBUTTON_BORDER_WIDTH "1" #define DEF_MENUBUTTON_CURSOR "" #define DEF_MENUBUTTON_DIRECTION "below" #define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED #define DEF_MENUBUTTON_DISABLED_FG_MONO "" #define DEF_MENUBUTTON_FONT "TkDefaultFont" #define DEF_MENUBUTTON_FG BLACK #define DEF_MENUBUTTON_HEIGHT "0" #define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR #define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO #define DEF_MENUBUTTON_HIGHLIGHT BLACK #define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0" #define DEF_MENUBUTTON_IMAGE (char *) NULL #define DEF_MENUBUTTON_INDICATOR "0" #define DEF_MENUBUTTON_JUSTIFY "center" #define DEF_MENUBUTTON_MENU "" #define DEF_MENUBUTTON_PADX "4p" #define DEF_MENUBUTTON_PADY "3p" #define DEF_MENUBUTTON_RELIEF "flat" #define DEF_MENUBUTTON_STATE "normal" #define DEF_MENUBUTTON_TAKE_FOCUS "0" #define DEF_MENUBUTTON_TEXT "" #define DEF_MENUBUTTON_TEXT_VARIABLE "" #define DEF_MENUBUTTON_UNDERLINE "-1" #define DEF_MENUBUTTON_WIDTH "0" #define DEF_MENUBUTTON_WRAP_LENGTH "0" /* * Defaults for messages: */ #define DEF_MESSAGE_ANCHOR "center" #define DEF_MESSAGE_ASPECT "150" #define DEF_MESSAGE_BG_COLOR NORMAL_BG #define DEF_MESSAGE_BG_MONO WHITE #define DEF_MESSAGE_BORDER_WIDTH "1" #define DEF_MESSAGE_CURSOR "" #define DEF_MESSAGE_FG BLACK #define DEF_MESSAGE_FONT "TkDefaultFont" #define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG #define DEF_MESSAGE_HIGHLIGHT BLACK #define DEF_MESSAGE_HIGHLIGHT_WIDTH "0" #define DEF_MESSAGE_JUSTIFY "left" #define DEF_MESSAGE_PADX "-1" #define DEF_MESSAGE_PADY "-1" #define DEF_MESSAGE_RELIEF "flat" #define DEF_MESSAGE_TAKE_FOCUS "0" #define DEF_MESSAGE_TEXT "" #define DEF_MESSAGE_TEXT_VARIABLE "" #define DEF_MESSAGE_WIDTH "0" /* * Defaults for panedwindows */ #define DEF_PANEDWINDOW_BG_COLOR NORMAL_BG #define DEF_PANEDWINDOW_BG_MONO WHITE #define DEF_PANEDWINDOW_BORDERWIDTH "1" #define DEF_PANEDWINDOW_CURSOR "" #define DEF_PANEDWINDOW_HANDLEPAD "8" #define DEF_PANEDWINDOW_HANDLESIZE "8" #define DEF_PANEDWINDOW_HEIGHT "" #define DEF_PANEDWINDOW_OPAQUERESIZE "1" #define DEF_PANEDWINDOW_ORIENT "horizontal" #define DEF_PANEDWINDOW_PROXYBORDER "2" #define DEF_PANEDWINDOW_RELIEF "flat" #define DEF_PANEDWINDOW_SASHCURSOR "" #define DEF_PANEDWINDOW_SASHPAD "0" #define DEF_PANEDWINDOW_SASHRELIEF "flat" #define DEF_PANEDWINDOW_SASHWIDTH "3" #define DEF_PANEDWINDOW_SHOWHANDLE "0" #define DEF_PANEDWINDOW_WIDTH "" /* * Defaults for panedwindow panes */ #define DEF_PANEDWINDOW_PANE_AFTER "" #define DEF_PANEDWINDOW_PANE_BEFORE "" #define DEF_PANEDWINDOW_PANE_HEIGHT "" #define DEF_PANEDWINDOW_PANE_MINSIZE "0" #define DEF_PANEDWINDOW_PANE_PADX "0" #define DEF_PANEDWINDOW_PANE_PADY "0" #define DEF_PANEDWINDOW_PANE_STICKY "nsew" #define DEF_PANEDWINDOW_PANE_WIDTH "" #define DEF_PANEDWINDOW_PANE_HIDE "0" #define DEF_PANEDWINDOW_PANE_STRETCH "last" /* * Defaults for scales: */ #define DEF_SCALE_ACTIVE_BG_COLOR ACTIVE_BG #define DEF_SCALE_ACTIVE_BG_MONO BLACK #define DEF_SCALE_BG_COLOR NORMAL_BG #define DEF_SCALE_BG_MONO WHITE #define DEF_SCALE_BIG_INCREMENT "0" #define DEF_SCALE_BORDER_WIDTH "1" #define DEF_SCALE_COMMAND "" #define DEF_SCALE_CURSOR "" #define DEF_SCALE_DIGITS "0" #define DEF_SCALE_FONT "TkDefaultFont" #define DEF_SCALE_FG_COLOR BLACK #define DEF_SCALE_FG_MONO BLACK #define DEF_SCALE_FROM "0" #define DEF_SCALE_HIGHLIGHT_BG_COLOR DEF_SCALE_BG_COLOR #define DEF_SCALE_HIGHLIGHT_BG_MONO DEF_SCALE_BG_MONO #define DEF_SCALE_HIGHLIGHT BLACK #define DEF_SCALE_HIGHLIGHT_WIDTH "1" #define DEF_SCALE_LABEL "" #define DEF_SCALE_LENGTH "100" #define DEF_SCALE_ORIENT "vertical" #define DEF_SCALE_RELIEF "flat" #define DEF_SCALE_REPEAT_DELAY "300" #define DEF_SCALE_REPEAT_INTERVAL "100" #define DEF_SCALE_RESOLUTION "1" #define DEF_SCALE_TROUGH_COLOR TROUGH #define DEF_SCALE_TROUGH_MONO WHITE #define DEF_SCALE_SHOW_VALUE "1" #define DEF_SCALE_SLIDER_LENGTH "30" #define DEF_SCALE_SLIDER_RELIEF "raised" #define DEF_SCALE_STATE "normal" #define DEF_SCALE_TAKE_FOCUS (char *) NULL #define DEF_SCALE_TICK_INTERVAL "0" #define DEF_SCALE_TO "100" #define DEF_SCALE_VARIABLE "" #define DEF_SCALE_WIDTH "15" /* * Defaults for scrollbars: */ #define DEF_SCROLLBAR_ACTIVE_BG_COLOR ACTIVE_BG #define DEF_SCROLLBAR_ACTIVE_BG_MONO BLACK #define DEF_SCROLLBAR_ACTIVE_RELIEF "raised" #define DEF_SCROLLBAR_BG_COLOR NORMAL_BG #define DEF_SCROLLBAR_BG_MONO WHITE #define DEF_SCROLLBAR_BORDER_WIDTH "1" #define DEF_SCROLLBAR_COMMAND "" #define DEF_SCROLLBAR_CURSOR "" #define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1" #define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG #define DEF_SCROLLBAR_HIGHLIGHT BLACK #define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "0" #define DEF_SCROLLBAR_JUMP "0" #define DEF_SCROLLBAR_ORIENT "vertical" #define DEF_SCROLLBAR_RELIEF "sunken" #define DEF_SCROLLBAR_REPEAT_DELAY "300" #define DEF_SCROLLBAR_REPEAT_INTERVAL "100" #define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL #define DEF_SCROLLBAR_TROUGH_COLOR TROUGH #define DEF_SCROLLBAR_TROUGH_MONO WHITE #define DEF_SCROLLBAR_WIDTH "11" /* * Defaults for texts: */ #define DEF_TEXT_AUTO_SEPARATORS "1" #define DEF_TEXT_BG_COLOR WHITE #define DEF_TEXT_BG_MONO WHITE #define DEF_TEXT_BLOCK_CURSOR "0" #define DEF_TEXT_BORDER_WIDTH "1" #define DEF_TEXT_CURSOR "xterm" #define DEF_TEXT_FG BLACK #define DEF_TEXT_EXPORT_SELECTION "1" #define DEF_TEXT_FONT "TkFixedFont" #define DEF_TEXT_HEIGHT "24" #define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG #define DEF_TEXT_HIGHLIGHT BLACK #define DEF_TEXT_HIGHLIGHT_WIDTH "1" #define DEF_TEXT_INSERT_BG BLACK #define DEF_TEXT_INSERT_BD_COLOR "0" #define DEF_TEXT_INSERT_BD_MONO "0" #define DEF_TEXT_INSERT_OFF_TIME "300" #define DEF_TEXT_INSERT_ON_TIME "600" #define DEF_TEXT_INSERT_WIDTH "2" #define DEF_TEXT_MAX_UNDO "0" #define DEF_TEXT_PADX "1" #define DEF_TEXT_PADY "1" #define DEF_TEXT_RELIEF "sunken" #define DEF_TEXT_INACTIVE_SELECT_COLOR SELECT_BG #define DEF_TEXT_SELECT_COLOR SELECT_BG #define DEF_TEXT_SELECT_MONO BLACK #define DEF_TEXT_SELECT_BD_COLOR "0" #define DEF_TEXT_SELECT_BD_MONO "0" #define DEF_TEXT_SELECT_FG_COLOR BLACK #define DEF_TEXT_SELECT_FG_MONO WHITE #define DEF_TEXT_SELECT_RELIEF "raised" #define DEF_TEXT_SET_GRID "0" #define DEF_TEXT_SPACING1 "0" #define DEF_TEXT_SPACING2 "0" #define DEF_TEXT_SPACING3 "0" #define DEF_TEXT_STATE "normal" #define DEF_TEXT_TABS "" #define DEF_TEXT_TABSTYLE "tabular" #define DEF_TEXT_TAKE_FOCUS (char *) NULL #define DEF_TEXT_UNDO "0" #define DEF_TEXT_WIDTH "80" #define DEF_TEXT_WRAP "char" #define DEF_TEXT_XSCROLL_COMMAND "" #define DEF_TEXT_YSCROLL_COMMAND "" /* * Defaults for canvas text: */ #define DEF_CANVTEXT_FONT "TkDefaultFont" /* * Defaults for toplevels (most of the defaults for frames also apply * to toplevels): */ #define DEF_TOPLEVEL_CLASS "Toplevel" #define DEF_TOPLEVEL_MENU "" #define DEF_TOPLEVEL_SCREEN "" #define DEF_TOPLEVEL_USE "" #endif /* _TKUNIXDEFAULT */ tk8.5.19/unix/tkAppInit.c0000644003604700454610000000732412612445655013624 0ustar dgp771div/* * tkAppInit.c -- * * Provides a default version of the Tcl_AppInit procedure for use in * wish and similar Tk-based applications. * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tk.h" #include "locale.h" #ifdef TK_TEST extern int Tktest_Init(Tcl_Interp *interp); #endif /* TK_TEST */ /* *---------------------------------------------------------------------- * * main -- * * This is the main program for the application. * * Results: * None: Tk_Main never returns here, so this procedure never returns * either. * * Side effects: * Whatever the application does. * *---------------------------------------------------------------------- */ int main( int argc, /* Number of command-line arguments. */ char **argv) /* Values of command-line arguments. */ { /* * The following #if block allows you to change the AppInit function by * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire * file. The #if checks for that #define and uses Tcl_AppInit if it * doesn't exist. */ #ifndef TK_LOCAL_APPINIT #define TK_LOCAL_APPINIT Tcl_AppInit #endif extern int TK_LOCAL_APPINIT (Tcl_Interp *interp); /* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, * etc., without needing to rewrite Tk_Main() */ #ifdef TK_LOCAL_MAIN_HOOK extern int TK_LOCAL_MAIN_HOOK (int *argc, char ***argv); TK_LOCAL_MAIN_HOOK(&argc, &argv); #endif Tk_Main(argc, argv, TK_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. Most * applications, especially those that incorporate additional packages, * will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error message in * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } if (Tk_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "Tktest", Tktest_Init, (Tcl_PackageInitProc *) NULL); #endif /* TK_TEST */ /* * Call the init procedures for included packages. Each call should look * like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * * where "Mod" is the name of the module. */ /* * Call Tcl_CreateCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no user- * -specific startup file will be run under any conditions. */ Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnix.c0000644003604700454610000001416012612445655013177 0ustar dgp771div/* * tkUnix.c -- * * This file contains procedures that are UNIX/X-specific, and will * probably have to be written differently for Windows or Macintosh * platforms. * * 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. */ #include "tkInt.h" #ifdef HAVE_XSS #include #endif /* *---------------------------------------------------------------------- * * TkGetServerInfo -- * * Given a window, this procedure returns information about the window * server for that window. This procedure provides the guts of the "winfo * server" command. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TkGetServerInfo( Tcl_Interp *interp, /* The server information is returned in this * interpreter's result. */ Tk_Window tkwin) /* Token for window; this selects a particular * display and server. */ { char buffer[8 + TCL_INTEGER_SPACE * 2]; char buffer2[TCL_INTEGER_SPACE]; sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)), ProtocolRevision(Tk_Display(tkwin))); sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin))); Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)), buffer2, (char *) NULL); } /* *---------------------------------------------------------------------- * * TkGetDefaultScreenName -- * * Returns the name of the screen that Tk should use during * initialization. * * Results: * Returns the argument or a string that should not be freed by the * caller. * * Side effects: * None. * *---------------------------------------------------------------------- */ CONST char * TkGetDefaultScreenName( Tcl_Interp *interp, /* Interp used to find environment * variables. */ CONST char *screenName) /* Screen name from command line, or NULL. */ { if ((screenName == NULL) || (screenName[0] == '\0')) { screenName = Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY); } return screenName; } /* *---------------------------------------------------------------------- * * Tk_UpdatePointer -- * * Unused function in UNIX * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tk_UpdatePointer( Tk_Window tkwin, /* Window to which pointer event is reported. * May be NULL. */ int x, int y, /* Pointer location in root coords. */ int state) /* Modifier state mask. */ { /* * This function intentionally left blank */ } /* *---------------------------------------------------------------------- * * TkpBuildRegionFromAlphaData -- * * Set up a rectangle of the given region based on the supplied alpha * data. * * Results: * None * * Side effects: * The region is updated, with extra pixels added to it. * *---------------------------------------------------------------------- */ void TkpBuildRegionFromAlphaData( TkRegion region, /* Region to be updated. */ unsigned x, unsigned y, /* Where in region to update. */ unsigned width, unsigned height, /* Size of rectangle to update. */ unsigned char *dataPtr, /* Data to read from. */ unsigned pixelStride, /* Num bytes from one piece of alpha data to * the next in the line. */ unsigned lineStride) /* Num bytes from one line of alpha data to * the next line. */ { unsigned char *lineDataPtr; unsigned int x1, y1, end; XRectangle rect; for (y1 = 0; y1 < height; y1++) { lineDataPtr = dataPtr; for (x1 = 0; x1 < width; x1 = end) { /* * Search for first non-transparent pixel. */ while ((x1 < width) && !*lineDataPtr) { x1++; lineDataPtr += pixelStride; } end = x1; /* * Search for first transparent pixel. */ while ((end < width) && *lineDataPtr) { end++; lineDataPtr += pixelStride; } if (end > x1) { rect.x = x + x1; rect.y = y + y1; rect.width = end - x1; rect.height = 1; TkUnionRectWithRegion(&rect, region, region); } } dataPtr += lineStride; } } /* *---------------------------------------------------------------------- * * Tk_GetUserInactiveTime -- * * Return the number of milliseconds the user was inactive. * * Results: * The number of milliseconds since the user's latest interaction with * the system on the given display, or -1 if the XScreenSaver extension * is not supported by the client libraries or the X server * implementation. * * Side effects: * None. *---------------------------------------------------------------------- */ long Tk_GetUserInactiveTime( Display *dpy) /* The display for which to query the inactive * time. */ { long inactiveTime = -1; #ifdef HAVE_XSS int eventBase, errorBase, major, minor; /* * Calling XScreenSaverQueryVersion seems to be needed to prevent a crash * on some buggy versions of XFree86. */ if ( #ifdef __APPLE__ XScreenSaverQueryInfo != NULL && /* Support for weak-linked libXss. */ #endif XScreenSaverQueryExtension(dpy, &eventBase, &errorBase) && XScreenSaverQueryVersion(dpy, &major, &minor)) { XScreenSaverInfo *info = XScreenSaverAllocInfo(); if (info == NULL) { /* * We are out of memory. */ Tcl_Panic("Out of memory: XScreenSaverAllocInfo failed in Tk_GetUserInactiveTime"); } if (XScreenSaverQueryInfo(dpy, DefaultRootWindow(dpy), info)) { inactiveTime = info->idle; } XFree(info); } #endif /* HAVE_XSS */ return inactiveTime; } /* *---------------------------------------------------------------------- * * Tk_ResetUserInactiveTime -- * * Reset the user inactivity timer * * Results: * none * * Side effects: * The user inactivity timer of the underlaying windowing system is reset * to zero. * *---------------------------------------------------------------------- */ void Tk_ResetUserInactiveTime( Display *dpy) { XResetScreenSaver(dpy); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixDraw.c0000644003604700454610000001443712612445655014024 0ustar dgp771div/* * tkUnixDraw.c -- * * This file contains X specific drawing 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. */ #include "tkInt.h" #if !defined(__WIN32__) #include "tkUnixInt.h" #endif /* * The following structure is used to pass information to ScrollRestrictProc * from TkScrollWindow. */ typedef struct ScrollInfo { int done; /* Flag is 0 until filtering is done. */ Display *display; /* Display to filter. */ Window window; /* Window to filter. */ TkRegion region; /* Region into which damage is accumulated. */ int dx, dy; /* Amount by which window was shifted. */ } ScrollInfo; /* * Forward declarations for functions declared later in this file: */ static Tk_RestrictAction ScrollRestrictProc(ClientData arg, XEvent *eventPtr); /* *---------------------------------------------------------------------- * * TkScrollWindow -- * * Scroll a rectangle of the specified window and accumulate damage * information in the specified Region. * * Results: * Returns 0 if no damage additional damage was generated. Sets damageRgn * to contain the damaged areas and returns 1 if GraphicsExpose events * were detected. * * Side effects: * Scrolls the bits in the window and enters the event loop looking for * damage events. * *---------------------------------------------------------------------- */ int TkScrollWindow( Tk_Window tkwin, /* The window to be scrolled. */ GC gc, /* GC for window to be scrolled. */ int x, int y, int width, int height, /* Position rectangle to be scrolled. */ int dx, int dy, /* Distance rectangle should be moved. */ TkRegion damageRgn) /* Region to accumulate damage in. */ { Tk_RestrictProc *oldProc; ClientData oldArg, dummy; ScrollInfo info; XCopyArea(Tk_Display(tkwin), Tk_WindowId(tkwin), Tk_WindowId(tkwin), gc, x, y, (unsigned) width, (unsigned) height, x+dx, y+dy); info.done = 0; info.window = Tk_WindowId(tkwin); info.display = Tk_Display(tkwin); info.region = damageRgn; info.dx = dx; info.dy = dy; /* * Sync the event stream so all of the expose events will be on the Tk * event queue before we start filtering. This avoids busy waiting while * we filter events. */ TkpSync(info.display); oldProc = Tk_RestrictEvents(ScrollRestrictProc, (ClientData) &info, &oldArg); while (!info.done) { Tcl_ServiceEvent(TCL_WINDOW_EVENTS); } Tk_RestrictEvents(oldProc, oldArg, &dummy); if (XEmptyRegion((Region) damageRgn)) { return 0; } else { return 1; } } /* *---------------------------------------------------------------------- * * ScrollRestrictProc -- * * A Tk_RestrictProc used by TkScrollWindow to gather up Expose * information into a single damage region. It accumulates damage events * on the specified window until a NoExpose or the last GraphicsExpose * event is detected. * * Results: * None. * * Side effects: * Discards Expose events after accumulating damage information * for a particular window. * *---------------------------------------------------------------------- */ static Tk_RestrictAction ScrollRestrictProc( ClientData arg, XEvent *eventPtr) { ScrollInfo *info = (ScrollInfo *) arg; XRectangle rect; /* * Defer events which aren't for the specified window. */ if (info->done || (eventPtr->xany.display != info->display) || (eventPtr->xany.window != info->window)) { return TK_DEFER_EVENT; } if (eventPtr->type == NoExpose) { info->done = 1; } else if (eventPtr->type == GraphicsExpose) { rect.x = eventPtr->xgraphicsexpose.x; rect.y = eventPtr->xgraphicsexpose.y; rect.width = eventPtr->xgraphicsexpose.width; rect.height = eventPtr->xgraphicsexpose.height; XUnionRectWithRegion(&rect, (Region) info->region, (Region) info->region); if (eventPtr->xgraphicsexpose.count == 0) { info->done = 1; } } else if (eventPtr->type == Expose) { /* * This case is tricky. This event was already queued before the * XCopyArea was issued. If this area overlaps the area being copied, * then some of the copied area may be invalid. The easiest way to * handle this case is to mark both the original area and the shifted * area as damaged. */ rect.x = eventPtr->xexpose.x; rect.y = eventPtr->xexpose.y; rect.width = eventPtr->xexpose.width; rect.height = eventPtr->xexpose.height; XUnionRectWithRegion(&rect, (Region) info->region, (Region) info->region); rect.x += info->dx; rect.y += info->dy; XUnionRectWithRegion(&rect, (Region) info->region, (Region) info->region); } else { return TK_DEFER_EVENT; } return TK_DISCARD_EVENT; } /* *---------------------------------------------------------------------- * * TkpDrawHighlightBorder -- * * This function draws a rectangular ring around the outside of a widget * to indicate that it has received the input focus. * * On Unix, we just draw the simple inset ring. On other sytems, e.g. the * Mac, the focus ring is a little more complicated, so we need this * abstraction. * * Results: * None. * * Side effects: * A rectangle "width" pixels wide is drawn in "drawable", corresponding * to the outer area of "tkwin". * *---------------------------------------------------------------------- */ void TkpDrawHighlightBorder( Tk_Window tkwin, GC fgGC, GC bgGC, int highlightWidth, Drawable drawable) { TkDrawInsetFocusHighlight(tkwin, fgGC, highlightWidth, drawable, 0); } /* *---------------------------------------------------------------------- * * TkpDrawFrame -- * * This function draws the rectangular frame area. * * Results: * None. * * Side effects: * Draws inside the tkwin area. * *---------------------------------------------------------------------- */ void TkpDrawFrame( Tk_Window tkwin, Tk_3DBorder border, int highlightWidth, int borderWidth, int relief) { Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, highlightWidth, highlightWidth, Tk_Width(tkwin) - 2*highlightWidth, Tk_Height(tkwin) - 2*highlightWidth, borderWidth, relief); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/configure0000775003604700454610000131073612656405252013470 0ustar dgp771div#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59 for tk 8.5. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='tk' PACKAGE_TARNAME='tk' PACKAGE_VERSION='8.5' PACKAGE_STRING='tk 8.5' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. ac_includes_default="\ #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if STDC_HEADERS # include # include #else # if HAVE_STDLIB_H # include # endif #endif #if HAVE_STRING_H # if !STDC_HEADERS && HAVE_MEMORY_H # include # endif # include #endif #if HAVE_STRINGS_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_VERSION TCL_PATCH_LEVEL TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCLSH_PROG BUILD_TCLSH MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR ac_ct_AR TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT LIBOBJS XFT_CFLAGS XFT_LIBS UNIX_FONT_OBJS TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_YEAR TK_LIB_FILE TK_LIB_FLAG TK_LIB_SPEC TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_INCLUDE_SPEC TK_BUILD_STUB_LIB_SPEC TK_BUILD_STUB_LIB_PATH TK_SRC_DIR TK_SHARED_BUILD LD_LIBRARY_PATH_VAR TK_BUILD_LIB_SPEC TCL_STUB_FLAGS XINCLUDES XLIBSW LOCALES TK_WINDOWINGSYSTEM TK_PKG_DIR TK_LIBRARY LIB_RUNTIME_DIR PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_WISH_LIBS CFBUNDLELOCALIZATIONS TK_RSRC_FILE WISH_RSRC_FILE LIB_RSRC_FILE APP_RSRC_FILE REZ REZ_FLAGS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS ac_env_CPP_set=${CPP+set} ac_env_CPP_value=$CPP ac_cv_env_CPP_set=${CPP+set} ac_cv_env_CPP_value=$CPP # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures tk 8.5 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF X features: --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of tk 8.5:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-man-symlinks use symlinks for the manpages (default: off) --enable-man-compression=PROG compress the manpages with PROG (default: off) --enable-man-suffix=STRING use STRING as a suffix to manpage file names (default: no, tk if enabled without specifying STRING) --enable-threads build with threads (default: off) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (default: off) --enable-64bit-vis enable 64bit Sparc VIS support (default: off) --disable-rpath disable rpath support (default: on) --enable-corefoundation use CoreFoundation API on MacOSX (default: on) --enable-load allow dynamic loading and "load" command (default: on) --enable-symbols build with debugging symbols (default: off) --enable-aqua=yes|no use Aqua windowingsystem on Mac OS X (default: no) --enable-xft use freetype/fontconfig/xft (default: on) --enable-xss use XScreenSaver for activity timer (default: on) --enable-framework package shared libraries in MacOSX frameworks (default: off) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-tcl directory containing tcl configuration (tclConfig.sh) --with-x use the X Window System Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF tk configure 8.5 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tk $as_me 8.5, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu TK_VERSION=8.5 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=5 TK_PATCH_LEVEL=".19" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" #-------------------------------------------------------------------- # Find and load the tclConfig.sh file #-------------------------------------------------------------------- # # Ok, lets find the tcl configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true # Check whether --with-tcl or --without-tcl was given. if test "${with_tcl+set}" = set; then withval="$with_tcl" with_tclconfig="${withval}" fi; echo "$as_me:$LINENO: checking for Tcl configuration" >&5 echo $ECHO_N "checking for Tcl configuration... $ECHO_C" >&6 if test "${ac_cv_c_tclconfig+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then case "${with_tclconfig}" in */tclConfig.sh ) if test -f "${with_tclconfig}"; then { echo "$as_me:$LINENO: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&5 echo "$as_me: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&2;} with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" fi ;; esac if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" else { { echo "$as_me:$LINENO: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" >&5 echo "$as_me: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" >&2;} { (exit 1); exit 1; }; } fi fi # then check for a private Tcl installation if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ../tcl \ `ls -dr ../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ `ls -dr ../tcl[8-9].[0-9] 2>/dev/null` \ `ls -dr ../tcl[8-9].[0-9]* 2>/dev/null` \ ../../tcl \ `ls -dr ../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ `ls -dr ../../tcl[8-9].[0-9] 2>/dev/null` \ `ls -dr ../../tcl[8-9].[0-9]* 2>/dev/null` \ ../../../tcl \ `ls -dr ../../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ `ls -dr ../../../tcl[8-9].[0-9] 2>/dev/null` \ `ls -dr ../../../tcl[8-9].[0-9]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" break fi done fi # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ `ls -d /System/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tcl.framework/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" break fi done fi # check in a few common install locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" break fi done fi # check in a few other private locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ `ls -dr ${srcdir}/../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[8-9].[0-9] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[8-9].[0-9]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" break fi done fi fi if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" { { echo "$as_me:$LINENO: error: Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh" >&5 echo "$as_me: error: Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh" >&2;} { (exit 1); exit 1; }; } else no_tcl= TCL_BIN_DIR="${ac_cv_c_tclconfig}" echo "$as_me:$LINENO: result: found ${TCL_BIN_DIR}/tclConfig.sh" >&5 echo "${ECHO_T}found ${TCL_BIN_DIR}/tclConfig.sh" >&6 fi fi echo "$as_me:$LINENO: checking for existence of ${TCL_BIN_DIR}/tclConfig.sh" >&5 echo $ECHO_N "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... $ECHO_C" >&6 if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then echo "$as_me:$LINENO: result: loading" >&5 echo "${ECHO_T}loading" >&6 . "${TCL_BIN_DIR}/tclConfig.sh" else echo "$as_me:$LINENO: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 echo "${ECHO_T}could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6 fi # eval is required to do the TCL_DBGX substitution eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tcl.framework installed in an arbitrary location. case ${TCL_DEFS} in *TCL_FRAMEWORK*) if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" break fi done fi if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi # eval is required to do the TCL_DBGX substitution eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" if test "${TCL_VERSION}" != "${TK_VERSION}"; then { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5 echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: checking for tclsh" >&5 echo $ECHO_N "checking for tclsh... $ECHO_C" >&6 if test "${ac_cv_path_tclsh+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]* 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done fi if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" echo "$as_me:$LINENO: result: $TCLSH_PROG" >&5 echo "${ECHO_T}$TCLSH_PROG" >&6 else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" echo "$as_me:$LINENO: result: No tclsh found on PATH" >&5 echo "${ECHO_T}No tclsh found on PATH" >&6 fi echo "$as_me:$LINENO: checking for tclsh in Tcl build directory" >&5 echo $ECHO_N "checking for tclsh in Tcl build directory... $ECHO_C" >&6 BUILD_TCLSH="${TCL_BIN_DIR}"/tclsh echo "$as_me:$LINENO: result: $BUILD_TCLSH" >&5 echo "${ECHO_T}$BUILD_TCLSH" >&6 #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix="$TCL_PREFIX" fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # Make sure srcdir is fully qualified! srcdir="`cd "$srcdir" ; pwd`" TK_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking whether to use symlinks for manpages" >&5 echo $ECHO_N "checking whether to use symlinks for manpages... $ECHO_C" >&6 # Check whether --enable-man-symlinks or --disable-man-symlinks was given. if test "${enable_man_symlinks+set}" = set; then enableval="$enable_man_symlinks" test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 echo "$as_me:$LINENO: checking whether to compress the manpages" >&5 echo $ECHO_N "checking whether to compress the manpages... $ECHO_C" >&6 # Check whether --enable-man-compression or --disable-man-compression was given. if test "${enable_man_compression+set}" = set; then enableval="$enable_man_compression" case $enableval in yes) { { echo "$as_me:$LINENO: error: missing argument to --enable-man-compression" >&5 echo "$as_me: error: missing argument to --enable-man-compression" >&2;} { (exit 1); exit 1; }; };; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 if test "$enableval" != "no"; then echo "$as_me:$LINENO: checking for compressed file suffix" >&5 echo $ECHO_N "checking for compressed file suffix... $ECHO_C" >&6 touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" echo "$as_me:$LINENO: result: $Z" >&5 echo "${ECHO_T}$Z" >&6 fi echo "$as_me:$LINENO: checking whether to add a package name suffix for the manpages" >&5 echo $ECHO_N "checking whether to add a package name suffix for the manpages... $ECHO_C" >&6 # Check whether --enable-man-suffix or --disable-man-suffix was given. if test "${enable_man_suffix+set}" = set; then enableval="$enable_man_suffix" case $enableval in yes) enableval="tk" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac else enableval="no" fi; echo "$as_me:$LINENO: result: $enableval" >&5 echo "${ECHO_T}$enableval" >&6 #------------------------------------------------------------------------ # 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_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi fi 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 "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # limits header checks must come early to prevent # an autoconf bug that throws errors on configure ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6 ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6 if test "${ac_cv_prog_egrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | (grep -E '(a|b)') >/dev/null 2>&1 then ac_cv_prog_egrep='grep -E' else ac_cv_prog_egrep='egrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 echo "${ECHO_T}$ac_cv_prog_egrep" >&6 EGREP=$ac_cv_prog_egrep echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* 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 <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6 if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "${ac_cv_header_limits_h+set}" = set; then echo "$as_me:$LINENO: checking for limits.h" >&5 echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 if test "${ac_cv_header_limits_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 echo "${ECHO_T}$ac_cv_header_limits_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking limits.h usability" >&5 echo $ECHO_N "checking limits.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking limits.h presence" >&5 echo $ECHO_N "checking limits.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: limits.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: limits.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: limits.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: limits.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: limits.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: limits.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: limits.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: limits.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: limits.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: limits.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ----------------------------- ## ## Report this to the tk lists. ## ## ----------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for limits.h" >&5 echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 if test "${ac_cv_header_limits_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_limits_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 echo "${ECHO_T}$ac_cv_header_limits_h" >&6 fi if test $ac_cv_header_limits_h = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_LIMITS_H 1 _ACEOF else cat >>confdefs.h <<\_ACEOF #define NO_LIMITS_H 1 _ACEOF fi #-------------------------------------------------------------------- # Supply a substitute for stdlib.h if it doesn't define strtol, # strtoul, or strtod (which it doesn't in some versions of SunOS). #-------------------------------------------------------------------- if test "${ac_cv_header_stdlib_h+set}" = set; then echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 if test "${ac_cv_header_stdlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking stdlib.h usability" >&5 echo $ECHO_N "checking stdlib.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking stdlib.h presence" >&5 echo $ECHO_N "checking stdlib.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: stdlib.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: stdlib.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: stdlib.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: stdlib.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: stdlib.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: stdlib.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: stdlib.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: stdlib.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ----------------------------- ## ## Report this to the tk lists. ## ## ----------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 if test "${ac_cv_header_stdlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_stdlib_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 fi if test $ac_cv_header_stdlib_h = yes; then tk_ok=1 else tk_ok=0 fi cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtol" >/dev/null 2>&1; then : else tk_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtoul" >/dev/null 2>&1; then : else tk_ok=0 fi rm -f conftest* cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtod" >/dev/null 2>&1; then : else tk_ok=0 fi rm -f conftest* if test $tk_ok = 0; then cat >>confdefs.h <<\_ACEOF #define NO_STDLIB_H 1 _ACEOF fi #------------------------------------------------------------------------ # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then echo "$as_me:$LINENO: checking if the compiler understands -pipe" >&5 echo $ECHO_N "checking if the compiler understands -pipe... $ECHO_C" >&6 if test "${tcl_cv_cc_pipe+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_pipe=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_pipe=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_pipe" >&5 echo "${ECHO_T}$tcl_cv_cc_pipe" >&6 if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ # Threads support - this auto-enables if Tcl was compiled threaded #------------------------------------------------------------------------ # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else tcl_ok=no fi; if test "${TCL_THREADS}" = 1; then tcl_threaded_core=1; fi if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then TCL_THREADS=1 # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention cat >>confdefs.h <<\_ACEOF #define USE_THREAD_ALLOC 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF if test "`uname -s`" = "SunOS" ; then cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF fi cat >>confdefs.h <<\_ACEOF #define _THREAD_SAFE 1 _ACEOF echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthread" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lpthread... $ECHO_C" >&6 if test "${ac_cv_lib_pthread_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthread_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthread_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthread_pthread_mutex_init" >&6 if test $ac_cv_lib_pthread_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "no"; then # Check a little harder for __pthread_mutex_init in the same # library, as some systems hide it there until pthread.h is # defined. We could alternatively do an AC_TRY_COMPILE with # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] echo "$as_me:$LINENO: checking for __pthread_mutex_init in -lpthread" >&5 echo $ECHO_N "checking for __pthread_mutex_init in -lpthread... $ECHO_C" >&6 if test "${ac_cv_lib_pthread___pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char __pthread_mutex_init (); int main () { __pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthread___pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthread___pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthread___pthread_mutex_init" >&6 if test $ac_cv_lib_pthread___pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthread" else echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthreads" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lpthreads... $ECHO_C" >&6 if test "${ac_cv_lib_pthreads_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthreads $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_pthreads_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_pthreads_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_pthreads_pthread_mutex_init" >&6 if test $ac_cv_lib_pthreads_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthreads" else echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lc... $ECHO_C" >&6 if test "${ac_cv_lib_c_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_c_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_c_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_c_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_c_pthread_mutex_init" >&6 if test $ac_cv_lib_c_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "no"; then echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc_r" >&5 echo $ECHO_N "checking for pthread_mutex_init in -lc_r... $ECHO_C" >&6 if test "${ac_cv_lib_c_r_pthread_mutex_init+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc_r $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { pthread_mutex_init (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_c_r_pthread_mutex_init=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_c_r_pthread_mutex_init=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 echo "${ECHO_T}$ac_cv_lib_c_r_pthread_mutex_init" >&6 if test $ac_cv_lib_c_r_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -pthread" else TCL_THREADS=0 { echo "$as_me:$LINENO: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5 echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;} fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" for ac_func in pthread_attr_setstacksize pthread_atfork do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking for pthread_attr_get_np" >&5 echo $ECHO_N "checking for pthread_attr_get_np... $ECHO_C" >&6 if test "${ac_cv_func_pthread_attr_get_np+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define pthread_attr_get_np to an innocuous variant, in case declares pthread_attr_get_np. For example, HP-UX 11i declares gettimeofday. */ #define pthread_attr_get_np innocuous_pthread_attr_get_np /* System header to define __stub macros and hopefully few prototypes, which can conflict with char pthread_attr_get_np (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef pthread_attr_get_np /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_attr_get_np (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_pthread_attr_get_np) || defined (__stub___pthread_attr_get_np) choke me #else char (*f) () = pthread_attr_get_np; #endif #ifdef __cplusplus } #endif int main () { return f != pthread_attr_get_np; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_pthread_attr_get_np=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_pthread_attr_get_np=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_pthread_attr_get_np" >&5 echo "${ECHO_T}$ac_cv_func_pthread_attr_get_np" >&6 if test $ac_cv_func_pthread_attr_get_np = yes; then tcl_ok=yes else tcl_ok=no fi if test $tcl_ok = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_PTHREAD_ATTR_GET_NP 1 _ACEOF echo "$as_me:$LINENO: checking for pthread_attr_get_np declaration" >&5 echo $ECHO_N "checking for pthread_attr_get_np declaration... $ECHO_C" >&6 if test "${tcl_cv_grep_pthread_attr_get_np+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "pthread_attr_get_np" >/dev/null 2>&1; then tcl_cv_grep_pthread_attr_get_np=present else tcl_cv_grep_pthread_attr_get_np=missing fi rm -f conftest* fi echo "$as_me:$LINENO: result: $tcl_cv_grep_pthread_attr_get_np" >&5 echo "${ECHO_T}$tcl_cv_grep_pthread_attr_get_np" >&6 if test $tcl_cv_grep_pthread_attr_get_np = missing ; then cat >>confdefs.h <<\_ACEOF #define ATTRGETNP_NOT_DECLARED 1 _ACEOF fi else echo "$as_me:$LINENO: checking for pthread_getattr_np" >&5 echo $ECHO_N "checking for pthread_getattr_np... $ECHO_C" >&6 if test "${ac_cv_func_pthread_getattr_np+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define pthread_getattr_np to an innocuous variant, in case declares pthread_getattr_np. For example, HP-UX 11i declares gettimeofday. */ #define pthread_getattr_np innocuous_pthread_getattr_np /* System header to define __stub macros and hopefully few prototypes, which can conflict with char pthread_getattr_np (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef pthread_getattr_np /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pthread_getattr_np (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_pthread_getattr_np) || defined (__stub___pthread_getattr_np) choke me #else char (*f) () = pthread_getattr_np; #endif #ifdef __cplusplus } #endif int main () { return f != pthread_getattr_np; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_pthread_getattr_np=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_pthread_getattr_np=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_pthread_getattr_np" >&5 echo "${ECHO_T}$ac_cv_func_pthread_getattr_np" >&6 if test $ac_cv_func_pthread_getattr_np = yes; then tcl_ok=yes else tcl_ok=no fi if test $tcl_ok = yes ; then cat >>confdefs.h <<\_ACEOF #define HAVE_PTHREAD_GETATTR_NP 1 _ACEOF echo "$as_me:$LINENO: checking for pthread_getattr_np declaration" >&5 echo $ECHO_N "checking for pthread_getattr_np declaration... $ECHO_C" >&6 if test "${tcl_cv_grep_pthread_getattr_np+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "pthread_getattr_np" >/dev/null 2>&1; then tcl_cv_grep_pthread_getattr_np=present else tcl_cv_grep_pthread_getattr_np=missing fi rm -f conftest* fi echo "$as_me:$LINENO: result: $tcl_cv_grep_pthread_getattr_np" >&5 echo "${ECHO_T}$tcl_cv_grep_pthread_getattr_np" >&6 if test $tcl_cv_grep_pthread_getattr_np = missing ; then cat >>confdefs.h <<\_ACEOF #define GETATTRNP_NOT_DECLARED 1 _ACEOF fi fi fi if test $tcl_ok = no; then # Darwin thread stacksize API for ac_func in pthread_get_stacksize_np do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done fi LIBS=$ac_saved_libs else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output echo "$as_me:$LINENO: checking for building with threads" >&5 echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 if test "${TCL_THREADS}" = 1; then cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 _ACEOF if test "${tcl_threaded_core}" = 1; then echo "$as_me:$LINENO: result: yes (threaded core)" >&5 echo "${ECHO_T}yes (threaded core)" >&6 else echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 fi else echo "$as_me:$LINENO: result: no (default)" >&5 echo "${ECHO_T}no (default)" >&6 fi # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" echo "$as_me:$LINENO: checking how to build libraries" >&5 echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi; if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi if test "$tcl_ok" = "yes" ; then echo "$as_me:$LINENO: result: shared" >&5 echo "${ECHO_T}shared" >&6 SHARED_BUILD=1 else echo "$as_me:$LINENO: result: static" >&5 echo "${ECHO_T}static" >&6 SHARED_BUILD=0 cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 _ACEOF fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi # Step 0.a: Enable 64 bit support? echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" do64bit=$enableval else do64bit=no fi; echo "$as_me:$LINENO: result: $do64bit" >&5 echo "${ECHO_T}$do64bit" >&6 # Step 0.b: Enable Solaris 64 bit VIS support? echo "$as_me:$LINENO: checking if 64bit Sparc VIS support is requested" >&5 echo $ECHO_N "checking if 64bit Sparc VIS support is requested... $ECHO_C" >&6 # Check whether --enable-64bit-vis or --disable-64bit-vis was given. if test "${enable_64bit_vis+set}" = set; then enableval="$enable_64bit_vis" do64bitVIS=$enableval else do64bitVIS=no fi; echo "$as_me:$LINENO: result: $do64bitVIS" >&5 echo "${ECHO_T}$do64bitVIS" >&6 # Force 64bit on with VIS if test "$do64bitVIS" = "yes"; then do64bit=yes fi # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. echo "$as_me:$LINENO: checking if compiler supports visibility \"hidden\"" >&5 echo $ECHO_N "checking if compiler supports visibility \"hidden\"... $ECHO_C" >&6 if test "${tcl_cv_cc_visibility_hidden+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {} int main () { f(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_visibility_hidden=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_visibility_hidden=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 if test $tcl_cv_cc_visibility_hidden = yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE extern __attribute__((__visibility__("hidden"))) _ACEOF fi # Step 0.d: Disable -rpath support? echo "$as_me:$LINENO: checking if rpath support is requested" >&5 echo $ECHO_N "checking if rpath support is requested... $ECHO_C" >&6 # Check whether --enable-rpath or --disable-rpath was given. if test "${enable_rpath+set}" = set; then enableval="$enable_rpath" doRpath=$enableval else doRpath=yes fi; echo "$as_me:$LINENO: result: $doRpath" >&5 echo "${ECHO_T}$doRpath" >&6 # Step 1: set the variable "system" to hold the name and version number # for the system. echo "$as_me:$LINENO: checking system version" >&5 echo $ECHO_N "checking system version... $ECHO_C" >&6 if test "${tcl_cv_sys_version+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print $3}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi fi fi fi echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 echo "${ECHO_T}$tcl_cv_sys_version" >&6 system=$tcl_cv_sys_version # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6 if test "${ac_cv_lib_dl_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dlopen (); int main () { dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dl_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dl_dlopen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6 if test $ac_cv_lib_dl_dlopen = yes; then have_dl=yes else have_dl=no fi # Require ranlib early so we can override it in special cases below. if test x"${SHLIB_VERSION}" = x; then SHLIB_VERSION="1.0" fi # Step 3: set configuration options based on system name and version. do64bit_ok=no # default to '{$LIBS}' and set to "" on per-platform necessary basis SHLIB_LD_LIBS='${LIBS}' LDFLAGS_ORIG="$LDFLAGS" # When ld needs options to work in 64-bit mode, put them in # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] # is disabled by the user. [Bug 1016796] LDFLAGS_ARCH="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE=-O if test "$GCC" = yes; then CFLAGS_WARNING="-Wall" else CFLAGS_WARNING="" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 echo "${ECHO_T}$ac_ct_AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi AR=$ac_ct_AR else AR="$ac_cv_prog_AR" fi STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" case $system in AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then # AIX requires the _r compiler when gcc isn't being used case "${CC}" in *_r|*_r\ *) # ok ... ;; *) # Make sure only first arg gets _r CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` ;; esac echo "$as_me:$LINENO: result: Using $CC for compiling with threads" >&5 echo "${ECHO_T}Using $CC for compiling with threads" >&6 fi LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" LD_LIBRARY_PATH_VAR="LIBPATH" # ldAix No longer needed with use of -bexpall/-brtl # but some extensions may still reference it LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then if test "$GCC" = yes; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} else do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS_ARCH="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" fi fi if test "`uname -m`" = ia64; then # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" if test "$GCC" = yes; then CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' else CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' else if test "$GCC" = yes; then SHLIB_LD='${CC} -shared -Wl,-bexpall' else SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" LDFLAGS="$LDFLAGS -brtl" fi SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; BeOS*) SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -nostart' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- echo "$as_me:$LINENO: checking for inet_ntoa in -lbind" >&5 echo $ECHO_N "checking for inet_ntoa in -lbind... $ECHO_C" >&6 if test "${ac_cv_lib_bind_inet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lbind $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { inet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_bind_inet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_bind_inet_ntoa=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_bind_inet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_bind_inet_ntoa" >&6 if test $ac_cv_lib_bind_inet_ntoa = yes; then LIBS="$LIBS -lbind -lsocket" fi ;; BSD/OS-2.1*|BSD/OS-3*) SHLIB_CFLAGS="" SHLIB_LD="shlicc -r" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; BSD/OS-4.*) SHLIB_CFLAGS="-export-dynamic -fPIC" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o tclWinError.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a" echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 if test "${ac_cv_cygwin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __CYGWIN__ #error cygwin #endif int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_cygwin=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_cygwin=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5 echo "${ECHO_T}$ac_cv_cygwin" >&6 if test "$ac_cv_cygwin" = "no"; then { { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5 echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;} { (exit 1); exit 1; }; } fi if test "x${TCL_THREADS}" = "x0"; then { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5 echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} { (exit 1); exit 1; }; } fi do64bit_ok=yes if test "x${SHARED_BUILD}" = "x1"; then echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args" # The eval makes quoting arguments work. if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix then : else { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } fi fi ;; dgux*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5 echo $ECHO_N "checking for inet_ntoa in -lnetwork... $ECHO_C" >&6 if test "${ac_cv_lib_network_inet_ntoa+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnetwork $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { inet_ntoa (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_network_inet_ntoa=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_network_inet_ntoa=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_network_inet_ntoa" >&5 echo "${ECHO_T}$ac_cv_lib_network_inet_ntoa" >&6 if test $ac_cv_lib_network_inet_ntoa = yes; then LIBS="$LIBS -lnetwork" fi ;; HP-UX-*.11.*) # Use updated header definitions where possible cat >>confdefs.h <<\_ACEOF #define _XOPEN_SOURCE_EXTENDED 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _XOPEN_SOURCE 1 _ACEOF LIBS="$LIBS -lxnet" # Use the XOPEN network library if test "`uname -m`" = ia64; then SHLIB_SUFFIX=".so" else SHLIB_SUFFIX=".sl" fi echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); int main () { shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes"; then if test "$GCC" = yes; then case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} ;; esac else do64bit_ok=yes CFLAGS="$CFLAGS +DD64" LDFLAGS_ARCH="+DD64" fi fi ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); int main () { shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS="" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi ;; IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" else case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" ;; *) CFLAGS="$CFLAGS -n32" ;; esac LDFLAGS="$LDFLAGS -n32" fi ;; IRIX64-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then if test "$GCC" = yes; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported by gcc" >&5 echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" fi fi ;; Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "`uname -m`" = "alpha"; then CFLAGS="$CFLAGS -mieee" fi if test $do64bit = yes; then echo "$as_me:$LINENO: checking if compiler accepts -m64 flag" >&5 echo $ECHO_N "checking if compiler accepts -m64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_m64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_m64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_m64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_m64" >&5 echo "${ECHO_T}$tcl_cv_cc_m64" >&6 if test $tcl_cv_cc_m64 = yes; then CFLAGS="$CFLAGS -m64" do64bit_ok=yes fi fi # The combo of gcc + glibc has a bug related to inlining of # functions like strtod(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. if test x"${USE_COMPAT}" != x; then CFLAGS="$CFLAGS -fno-inline" fi ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-02 SHLIB_LD='${CC} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; MP-RAS-*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,-Bexport" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OpenBSD-*) arch=`arch -s` case "$arch" in vax) # Equivalent using configure option --disable-load # Step 4 will set the necessary variables DL_OBJS="" SHLIB_LD_LIBS="" LDFLAGS="" ;; *) case "$arch" in alpha|sparc|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" ;; esac case "$arch" in vax) CFLAGS_OPTIMIZE="-O1" ;; sh) CFLAGS_OPTIMIZE="-O0" ;; *) CFLAGS_OPTIMIZE="-O2" ;; esac if test "${TCL_THREADS}" = "1"; then # On OpenBSD: Compile with -pthread # Don't link with -lpthread LIBS=`echo $LIBS | sed s/-lpthread//` CFLAGS="$CFLAGS -pthread" fi # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi ;; FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi case $system in FreeBSD-3.*) # Version numbers are dot-stripped by system policy. TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .` UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' TCL_LIB_VERSIONS_OK=nodots ;; esac ;; Darwin-*) CFLAGS_OPTIMIZE="-Os" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if ($i~/^(isysroot|mmacosx-version-min)/) print "-"$i}'`" CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`" if test $do64bit = yes; then case `arch` in ppc) echo "$as_me:$LINENO: checking if compiler accepts -arch ppc64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch ppc64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_ppc64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_ppc64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_ppc64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_ppc64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_ppc64" >&6 if test $tcl_cv_cc_arch_ppc64 = yes; then CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes fi ;; i386) echo "$as_me:$LINENO: checking if compiler accepts -arch x86_64 flag" >&5 echo $ECHO_N "checking if compiler accepts -arch x86_64 flag... $ECHO_C" >&6 if test "${tcl_cv_cc_arch_x86_64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_arch_x86_64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_arch_x86_64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_x86_64" >&5 echo "${ECHO_T}$tcl_cv_cc_arch_x86_64" >&6 if test $tcl_cv_cc_arch_x86_64 = yes; then CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes fi ;; *) { echo "$as_me:$LINENO: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac else # Check for combined 32-bit and 64-bit fat build if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then fat_32_64=yes fi fi SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' echo "$as_me:$LINENO: checking if ld accepts -single_module flag" >&5 echo $ECHO_N "checking if ld accepts -single_module flag... $ECHO_C" >&6 if test "${tcl_cv_ld_single_module+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_single_module=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_single_module=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_single_module" >&5 echo "${ECHO_T}$tcl_cv_ld_single_module" >&6 if test $tcl_cv_ld_single_module = yes; then SHLIB_LD="${SHLIB_LD} -Wl,-single_module" fi SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" # Don't use -prebind when building for Mac OS X 10.4 or later only: if test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int($2)}'`" -lt 4 -a \ "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int($2)}'`" -lt 4; then LDFLAGS="$LDFLAGS -prebind" fi LDFLAGS="$LDFLAGS -headerpad_max_install_names" echo "$as_me:$LINENO: checking if ld accepts -search_paths_first flag" >&5 echo $ECHO_N "checking if ld accepts -search_paths_first flag... $ECHO_C" >&6 if test "${tcl_cv_ld_search_paths_first+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_search_paths_first=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_search_paths_first=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_search_paths_first" >&5 echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6 if test $tcl_cv_ld_search_paths_first = yes; then LDFLAGS="$LDFLAGS -Wl,-search_paths_first" fi if test "$tcl_cv_cc_visibility_hidden" != yes; then cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE __private_extern__ _ACEOF fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" cat >>confdefs.h <<\_ACEOF #define MAC_OSX_TCL 1 _ACEOF PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' echo "$as_me:$LINENO: checking whether to use CoreFoundation" >&5 echo $ECHO_N "checking whether to use CoreFoundation... $ECHO_C" >&6 # Check whether --enable-corefoundation or --disable-corefoundation was given. if test "${enable_corefoundation+set}" = set; then enableval="$enable_corefoundation" tcl_corefoundation=$enableval else tcl_corefoundation=yes fi; echo "$as_me:$LINENO: result: $tcl_corefoundation" >&5 echo "${ECHO_T}$tcl_corefoundation" >&6 if test $tcl_corefoundation = yes; then echo "$as_me:$LINENO: checking for CoreFoundation.framework" >&5 echo $ECHO_N "checking for CoreFoundation.framework... $ECHO_C" >&6 if test "${tcl_cv_lib_corefoundation+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_libs=$LIBS if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit # archs from CFLAGS et al. while testing for # presence of CF. 64-bit CF is disabled in # tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi LIBS="$LIBS -framework CoreFoundation" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_lib_corefoundation=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_lib_corefoundation=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi LIBS=$hold_libs fi echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation" >&5 echo "${ECHO_T}$tcl_cv_lib_corefoundation" >&6 if test $tcl_cv_lib_corefoundation = yes; then LIBS="$LIBS -framework CoreFoundation" cat >>confdefs.h <<\_ACEOF #define HAVE_COREFOUNDATION 1 _ACEOF else tcl_corefoundation=no fi if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then echo "$as_me:$LINENO: checking for 64-bit CoreFoundation" >&5 echo $ECHO_N "checking for 64-bit CoreFoundation... $ECHO_C" >&6 if test "${tcl_cv_lib_corefoundation_64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { CFBundleRef b = CFBundleGetMainBundle(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_lib_corefoundation_64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_lib_corefoundation_64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation_64" >&5 echo "${ECHO_T}$tcl_cv_lib_corefoundation_64" >&6 if test $tcl_cv_lib_corefoundation_64 = no; then cat >>confdefs.h <<\_ACEOF #define NO_COREFOUNDATION_64 1 _ACEOF LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" fi fi fi ;; NEXTSTEP-*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -nostdlib -r' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadNext.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OS/390-*) SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy cat >>confdefs.h <<\_ACEOF #define _OE_SOCKETS 1 _ACEOF ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1 SHLIB_CFLAGS="" # Hack: make package name same as library name SHLIB_LD='ld -R -export :' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadOSF.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" if test "$SHARED_BUILD" = 1; then SHLIB_LD="ld -shared" else SHLIB_LD="ld -non_shared" fi SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" if test "$SHARED_BUILD" = 1; then SHLIB_LD='ld -shared -expect_unresolved "*"' else SHLIB_LD='ld -non_shared -expect_unresolved "*"' fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then CFLAGS="$CFLAGS -mieee" else CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" fi # see pthread_intro(3) for pthread support on osf1, k.furukawa if test "${TCL_THREADS}" = 1; then CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` if test "$GCC" = yes; then LIBS="$LIBS -lpthread -lmach -lexc" else CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi fi ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. if test "$GCC" = yes; then SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" else SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SINIX*5.4*) SHLIB_CFLAGS="-K PIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SunOS-4*) SHLIB_CFLAGS="-PIC" SHLIB_LD="ld" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # SunOS can't handle version numbers with dots in them in library # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it # requires an extra version number at the end of .so file names. # So, the library has to have a name like libtcl75.so.1.0 SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[0-6]) # Careful to not let 5.10+ fall into this case # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. cat >>confdefs.h <<\_ACEOF #define _REENTRANT 1 _ACEOF cat >>confdefs.h <<\_ACEOF #define _POSIX_PTHREAD_SEMANTICS 1 _ACEOF SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = yes; then arch=`isainfo` if test "$arch" = "sparcv9 sparc"; then if test "$GCC" = yes; then if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} else do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" fi else do64bit_ok=yes if test "$do64bitVIS" = yes; then CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" else CFLAGS="$CFLAGS -xarch=v9" LDFLAGS_ARCH="-xarch=v9" fi # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" fi else if test "$arch" = "amd64 i386"; then if test "$GCC" = yes; then case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) do64bit_ok=yes CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; esac else do64bit_ok=yes case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64";; esac fi else { echo "$as_me:$LINENO: WARNING: 64bit mode not supported for $arch" >&5 echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} fi fi fi #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- if test "$GCC" = yes; then use_sunmath=no else arch=`isainfo` echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5 echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6 if test "$arch" = "amd64 i386"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MATH_LIBS="-lsunmath $MATH_LIBS" if test "${ac_cv_header_sunmath_h+set}" = set; then echo "$as_me:$LINENO: checking for sunmath.h" >&5 echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 if test "${ac_cv_header_sunmath_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking sunmath.h usability" >&5 echo $ECHO_N "checking sunmath.h usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking sunmath.h presence" >&5 echo $ECHO_N "checking sunmath.h presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: sunmath.h: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: sunmath.h: present but cannot be compiled" >&5 echo "$as_me: WARNING: sunmath.h: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: sunmath.h: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: see the Autoconf documentation" >&5 echo "$as_me: WARNING: sunmath.h: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: sunmath.h: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: sunmath.h: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: sunmath.h: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ----------------------------- ## ## Report this to the tk lists. ## ## ----------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for sunmath.h" >&5 echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 if test "${ac_cv_header_sunmath_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_header_sunmath_h=$ac_header_preproc fi echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 fi use_sunmath=yes else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 use_sunmath=no fi fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "$do64bit_ok" = yes; then if test "$arch" = "sparcv9 sparc"; then # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" # for finding sparcv9 libgcc, get the regular libgcc # path, remove so name and append 'sparcv9' #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" else if test "$arch" = "amd64 i386"; then SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" fi fi fi else if test "$use_sunmath" = yes; then textmode=textoff else textmode=text fi case $system in SunOS-5.[1-9][0-9]*) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' fi ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" SHLIB_LD='${CC} -G' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. echo "$as_me:$LINENO: checking for ld accepts -Bexport flag" >&5 echo $ECHO_N "checking for ld accepts -Bexport flag... $ECHO_C" >&6 if test "${tcl_cv_ld_Bexport+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { int i; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_Bexport=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_Bexport=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_Bexport" >&5 echo "${ECHO_T}$tcl_cv_ld_Bexport" >&6 if test $tcl_cv_ld_Bexport = yes; then LDFLAGS="$LDFLAGS -Wl,-Bexport" fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac if test "$do64bit" = yes -a "$do64bit_ok" = no; then { echo "$as_me:$LINENO: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} fi if test "$do64bit" = yes -a "$do64bit_ok" = yes; then cat >>confdefs.h <<\_ACEOF #define TCL_CFG_DO64BIT 1 _ACEOF fi # Step 4: disable dynamic loading if requested via a command-line switch. # Check whether --enable-load or --disable-load was given. if test "${enable_load+set}" = set; then enableval="$enable_load" tcl_ok=$enableval else tcl_ok=yes fi; if test "$tcl_ok" = no; then DL_OBJS="" fi if test "x$DL_OBJS" != x; then BUILD_DLTEST="\$(DLTEST_TARGETS)" else { echo "$as_me:$LINENO: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" DL_OBJS="tclLoadNone.o" DL_LIBS="" LDFLAGS="$LDFLAGS_ORIG" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" fi LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then case $system in AIX-*) ;; BSD/OS*) ;; CYGWIN_*|MINGW32_*) ;; IRIX*) ;; NetBSD-*|FreeBSD-*|OpenBSD-*) ;; Darwin-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac fi if test "$SHARED_LIB_SUFFIX" = ""; then SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}' fi if test "$UNSHARED_LIB_SUFFIX" = ""; then UNSHARED_LIB_SUFFIX='${VERSION}.a' fi DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll"; then INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" else INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi else LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} if test "$RANLIB" = ""; then MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' else MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' fi fi # Stub lib does not depend on shared/static configuration if test "$RANLIB" = ""; then MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' else MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@' INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))' fi # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. if test "x${TCL_LIBS}" = x; then TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}" fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. echo "$as_me:$LINENO: checking for cast to union support" >&5 echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 if test "${tcl_cv_cast_to_union+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { union foo { int i; double d; }; union foo f = (union foo) (int) 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cast_to_union=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cast_to_union=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 if test "$tcl_cv_cast_to_union" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_CAST_TO_UNION 1 _ACEOF fi # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. cat >>confdefs.h <<_ACEOF #define TCL_SHLIB_EXT "${SHLIB_SUFFIX}" _ACEOF echo "$as_me:$LINENO: checking for build with symbols" >&5 echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" tcl_ok=$enableval else tcl_ok=no fi; # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. DBGX="" if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' cat >>confdefs.h <<\_ACEOF #define NDEBUG 1 _ACEOF echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 cat >>confdefs.h <<\_ACEOF #define TCL_CFG_OPTIMIZED 1 _ACEOF else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 echo "${ECHO_T}yes (standard debugging)" >&6 fi fi if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then cat >>confdefs.h <<\_ACEOF #define TCL_MEM_DEBUG 1 _ACEOF fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then echo "$as_me:$LINENO: result: enabled symbols mem debugging" >&5 echo "${ECHO_T}enabled symbols mem debugging" >&6 else echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 echo "${ECHO_T}enabled $tcl_ok debugging" >&6 fi fi #-------------------------------------------------------------------- # Detect what compiler flags to set for 64-bit support. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for required early compiler flags" >&5 echo $ECHO_N "checking for required early compiler flags... $ECHO_C" >&6 tcl_flags="" if test "${tcl_cv_flag__isoc99_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__isoc99_source=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _ISOC99_SOURCE 1 #include int main () { char *p = (char *)strtoll; char *q = (char *)strtoull; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__isoc99_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_flag__isoc99_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define _ISOC99_SOURCE 1 _ACEOF tcl_flags="$tcl_flags _ISOC99_SOURCE" fi if test "${tcl_cv_flag__largefile64_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile64_source=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _LARGEFILE64_SOURCE 1 #include int main () { struct stat64 buf; int i = stat64("/", &buf); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile64_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_flag__largefile64_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define _LARGEFILE64_SOURCE 1 _ACEOF tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi if test "${tcl_cv_flag__largefile_source64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { char *p = (char *)open64; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile_source64=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _LARGEFILE_SOURCE64 1 #include int main () { char *p = (char *)open64; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_flag__largefile_source64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_flag__largefile_source64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define _LARGEFILE_SOURCE64 1 _ACEOF tcl_flags="$tcl_flags _LARGEFILE_SOURCE64" fi if test "x${tcl_flags}" = "x" ; then echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 else echo "$as_me:$LINENO: result: ${tcl_flags}" >&5 echo "${ECHO_T}${tcl_flags}" >&6 fi echo "$as_me:$LINENO: checking for 64-bit integer type" >&5 echo $ECHO_N "checking for 64-bit integer type... $ECHO_C" >&6 if test "${tcl_cv_type_64bit+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { __int64 value = (__int64) 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_type_64bit=__int64 else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_type_64bit="long long" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { switch (0) { case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; } ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_64bit=${tcl_type_64bit} else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "${tcl_cv_type_64bit}" = none ; then cat >>confdefs.h <<\_ACEOF #define TCL_WIDE_INT_IS_LONG 1 _ACEOF echo "$as_me:$LINENO: result: using long" >&5 echo "${ECHO_T}using long" >&6 else cat >>confdefs.h <<_ACEOF #define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} _ACEOF echo "$as_me:$LINENO: result: ${tcl_cv_type_64bit}" >&5 echo "${ECHO_T}${tcl_cv_type_64bit}" >&6 # Now check for auxiliary declarations echo "$as_me:$LINENO: checking for struct dirent64" >&5 echo $ECHO_N "checking for struct dirent64... $ECHO_C" >&6 if test "${tcl_cv_struct_dirent64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { struct dirent64 p; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_struct_dirent64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_struct_dirent64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_struct_dirent64" >&5 echo "${ECHO_T}$tcl_cv_struct_dirent64" >&6 if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_STRUCT_DIRENT64 1 _ACEOF fi echo "$as_me:$LINENO: checking for struct stat64" >&5 echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6 if test "${tcl_cv_struct_stat64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct stat64 p; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_struct_stat64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_struct_stat64=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_struct_stat64" >&5 echo "${ECHO_T}$tcl_cv_struct_stat64" >&6 if test "x${tcl_cv_struct_stat64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_STRUCT_STAT64 1 _ACEOF fi for ac_func in open64 lseek64 do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $ac_func to an innocuous variant, in case declares $ac_func. For example, HP-UX 11i declares gettimeofday. */ #define $ac_func innocuous_$ac_func /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $ac_func /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else char (*f) () = $ac_func; #endif #ifdef __cplusplus } #endif int main () { return f != $ac_func; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking for off64_t" >&5 echo $ECHO_N "checking for off64_t... $ECHO_C" >&6 if test "${tcl_cv_type_off64_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { off64_t offset; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_off64_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_off64_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_TYPE_OFF64_T 1 _ACEOF echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi #-------------------------------------------------------------------- # Check endianness because we can optimize some operations #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6 if test "${ac_cv_c_bigendian+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # See if sys/param.h defines the BYTE_ORDER macro. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN bogus endian macros #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # It does; now see whether it defined to BIG_ENDIAN or not. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if BYTE_ORDER != BIG_ENDIAN not big endian #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_bigendian=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # It does not; compile a test program. if test "$cross_compiling" = yes; then # try to guess the endianness by grepping values into an object file ac_cv_c_bigendian=unknown cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } int main () { _ascii (); _ebcdic (); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then ac_cv_c_bigendian=yes fi if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then if test "$ac_cv_c_bigendian" = unknown; then ac_cv_c_bigendian=no else # finding both strings is unlikely to happen, but who knows? ac_cv_c_bigendian=unknown fi fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* Are we little or big endian? From Harbison&Steele. */ union { long l; char c[sizeof (long)]; } u; u.l = 1; exit (u.c[sizeof (long) - 1] == 1); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_c_bigendian=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 echo "${ECHO_T}$ac_cv_c_bigendian" >&6 case $ac_cv_c_bigendian in yes) cat >>confdefs.h <<\_ACEOF #define WORDS_BIGENDIAN 1 _ACEOF ;; no) ;; *) { { echo "$as_me:$LINENO: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&5 echo "$as_me: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&2;} { (exit 1); exit 1; }; } ;; esac #------------------------------------------------------------------------ # If Tcl and Tk are installed in different places, adjust the library # search path to reflect this. #------------------------------------------------------------------------ LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib" fi if test "$TCL_PREFIX" != "$prefix"; then { echo "$as_me:$LINENO: WARNING: Different --prefix selected for Tk and Tcl! [package require Tk] may not work correctly in tclsh." >&5 echo "$as_me: WARNING: Different --prefix selected for Tk and Tcl! [package require Tk] may not work correctly in tclsh." >&2;} fi #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things # that appear to be useful and aren't already in sys/types.h. # This appears to be true only on the RS/6000 under AIX. Some # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for fd_set in sys/types" >&5 echo $ECHO_N "checking for fd_set in sys/types... $ECHO_C" >&6 if test "${tcl_cv_type_fd_set+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { fd_set readMask, writeMask; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_type_fd_set=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_type_fd_set=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_type_fd_set" >&5 echo "${ECHO_T}$tcl_cv_type_fd_set" >&6 tk_ok=$tcl_cv_type_fd_set if test $tk_ok = no; then echo "$as_me:$LINENO: checking for fd_mask in sys/select" >&5 echo $ECHO_N "checking for fd_mask in sys/select... $ECHO_C" >&6 if test "${tcl_cv_grep_fd_mask+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "fd_mask" >/dev/null 2>&1; then tcl_cv_grep_fd_mask=present else tcl_cv_grep_fd_mask=missing fi rm -f conftest* fi echo "$as_me:$LINENO: result: $tcl_cv_grep_fd_mask" >&5 echo "${ECHO_T}$tcl_cv_grep_fd_mask" >&6 if test $tcl_cv_grep_fd_mask = present; then cat >>confdefs.h <<\_ACEOF #define HAVE_SYS_SELECT_H 1 _ACEOF tk_ok=yes fi fi if test $tk_ok = no; then cat >>confdefs.h <<\_ACEOF #define NO_FD_SET 1 _ACEOF fi #------------------------------------------------------------------------------ # Find out all about time handling differences. #------------------------------------------------------------------------------ for ac_header in sys/time.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ----------------------------- ## ## Report this to the tk lists. ## ## ----------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6 if test "${ac_cv_header_time+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include int main () { if ((struct tm *) 0) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_time=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_time=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 echo "${ECHO_T}$ac_cv_header_time" >&6 if test $ac_cv_header_time = yes; then cat >>confdefs.h <<\_ACEOF #define TIME_WITH_SYS_TIME 1 _ACEOF fi #-------------------------------------------------------------------- # Under Solaris 2.4, strtod returns the wrong value for the # terminating character under some conditions. Check for this # and if the problem exists use a substitute procedure # "fixstrtod" (provided by Tcl) that corrects the error. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for strtod" >&5 echo $ECHO_N "checking for strtod... $ECHO_C" >&6 if test "${ac_cv_func_strtod+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define strtod to an innocuous variant, in case declares strtod. For example, HP-UX 11i declares gettimeofday. */ #define strtod innocuous_strtod /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strtod (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef strtod /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strtod (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strtod) || defined (__stub___strtod) choke me #else char (*f) () = strtod; #endif #ifdef __cplusplus } #endif int main () { return f != strtod; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_strtod=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_strtod=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 echo "${ECHO_T}$ac_cv_func_strtod" >&6 if test $ac_cv_func_strtod = yes; then tcl_strtod=1 else tcl_strtod=0 fi if test "$tcl_strtod" = 1; then echo "$as_me:$LINENO: checking for Solaris2.4/Tru64 strtod bugs" >&5 echo $ECHO_N "checking for Solaris2.4/Tru64 strtod bugs... $ECHO_C" >&6 if test "${tcl_cv_strtod_buggy+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_strtod_buggy=buggy else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ extern double strtod(); int main() { char *infString="Inf", *nanString="NaN", *spaceString=" "; char *term; double value; value = strtod(infString, &term); if ((term != infString) && (term[-1] == 0)) { exit(1); } value = strtod(nanString, &term); if ((term != nanString) && (term[-1] == 0)) { exit(1); } value = strtod(spaceString, &term); if (term == (spaceString+1)) { exit(1); } exit(0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_strtod_buggy=ok else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) tcl_cv_strtod_buggy=buggy fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi echo "$as_me:$LINENO: result: $tcl_cv_strtod_buggy" >&5 echo "${ECHO_T}$tcl_cv_strtod_buggy" >&6 if test "$tcl_cv_strtod_buggy" = buggy; then case $LIBOBJS in "fixstrtod.$ac_objext" | \ *" fixstrtod.$ac_objext" | \ "fixstrtod.$ac_objext "* | \ *" fixstrtod.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" ;; esac USE_COMPAT=1 cat >>confdefs.h <<\_ACEOF #define strtod fixstrtod _ACEOF fi fi #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for mode_t" >&5 echo $ECHO_N "checking for mode_t... $ECHO_C" >&6 if test "${ac_cv_type_mode_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((mode_t *) 0) return 0; if (sizeof (mode_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_mode_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_mode_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_mode_t" >&5 echo "${ECHO_T}$ac_cv_type_mode_t" >&6 if test $ac_cv_type_mode_t = yes; then : else cat >>confdefs.h <<_ACEOF #define mode_t int _ACEOF fi echo "$as_me:$LINENO: checking for pid_t" >&5 echo $ECHO_N "checking for pid_t... $ECHO_C" >&6 if test "${ac_cv_type_pid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((pid_t *) 0) return 0; if (sizeof (pid_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_pid_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_pid_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 echo "${ECHO_T}$ac_cv_type_pid_t" >&6 if test $ac_cv_type_pid_t = yes; then : else cat >>confdefs.h <<_ACEOF #define pid_t int _ACEOF fi echo "$as_me:$LINENO: checking for size_t" >&5 echo $ECHO_N "checking for size_t... $ECHO_C" >&6 if test "${ac_cv_type_size_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((size_t *) 0) return 0; if (sizeof (size_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_size_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_size_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5 echo "${ECHO_T}$ac_cv_type_size_t" >&6 if test $ac_cv_type_size_t = yes; then : else cat >>confdefs.h <<_ACEOF #define size_t unsigned _ACEOF fi echo "$as_me:$LINENO: checking for uid_t in sys/types.h" >&5 echo $ECHO_N "checking for uid_t in sys/types.h... $ECHO_C" >&6 if test "${ac_cv_type_uid_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "uid_t" >/dev/null 2>&1; then ac_cv_type_uid_t=yes else ac_cv_type_uid_t=no fi rm -f conftest* fi echo "$as_me:$LINENO: result: $ac_cv_type_uid_t" >&5 echo "${ECHO_T}$ac_cv_type_uid_t" >&6 if test $ac_cv_type_uid_t = no; then cat >>confdefs.h <<\_ACEOF #define uid_t int _ACEOF cat >>confdefs.h <<\_ACEOF #define gid_t int _ACEOF fi echo "$as_me:$LINENO: checking for intptr_t" >&5 echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 if test "${ac_cv_type_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((intptr_t *) 0) return 0; if (sizeof (intptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_intptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_intptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 if test $ac_cv_type_intptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_INTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 if test "${tcl_cv_intptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 echo "${ECHO_T}$tcl_cv_intptr_t" >&6 if test "$tcl_cv_intptr_t" != none; then cat >>confdefs.h <<_ACEOF #define intptr_t $tcl_cv_intptr_t _ACEOF fi fi echo "$as_me:$LINENO: checking for uintptr_t" >&5 echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 if test "${ac_cv_type_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((uintptr_t *) 0) return 0; if (sizeof (uintptr_t)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_uintptr_t=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_uintptr_t=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 if test $ac_cv_type_uintptr_t = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_UINTPTR_T 1 _ACEOF else echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 if test "${tcl_cv_uintptr_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ none; do if test "$tcl_cv_uintptr_t" != none; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_ok=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 if test "$tcl_cv_uintptr_t" != none; then cat >>confdefs.h <<_ACEOF #define uintptr_t $tcl_cv_uintptr_t _ACEOF fi fi #------------------------------------------- # In OS/390 struct pwd has no pw_gecos field #------------------------------------------- echo "$as_me:$LINENO: checking pw_gecos in struct pwd" >&5 echo $ECHO_N "checking pw_gecos in struct pwd... $ECHO_C" >&6 if test "${tcl_cv_pwd_pw_gecos+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { struct passwd pwd; pwd.pw_gecos; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_pwd_pw_gecos=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_pwd_pw_gecos=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $tcl_cv_pwd_pw_gecos" >&5 echo "${ECHO_T}$tcl_cv_pwd_pw_gecos" >&6 if test $tcl_cv_pwd_pw_gecos = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_PW_GECOS 1 _ACEOF fi #-------------------------------------------------------------------- # On Mac OS X, we can build either with X11 or with Aqua #-------------------------------------------------------------------- if test "`uname -s`" = "Darwin" ; then echo "$as_me:$LINENO: checking whether to use Aqua" >&5 echo $ECHO_N "checking whether to use Aqua... $ECHO_C" >&6 # Check whether --enable-aqua or --disable-aqua was given. if test "${enable_aqua+set}" = set; then enableval="$enable_aqua" tk_aqua=$enableval else tk_aqua=no fi; if test $tk_aqua = yes -o $tk_aqua = cocoa; then tk_aqua=yes if test $tcl_corefoundation = no; then { echo "$as_me:$LINENO: WARNING: Aqua can only be used when CoreFoundation is available" >&5 echo "$as_me: WARNING: Aqua can only be used when CoreFoundation is available" >&2;} tk_aqua=no fi if test ! -d /System/Library/Frameworks/Cocoa.framework; then { echo "$as_me:$LINENO: WARNING: Aqua can only be used when Cocoa is available" >&5 echo "$as_me: WARNING: Aqua can only be used when Cocoa is available" >&2;} tk_aqua=no fi if test "`uname -r | awk -F. '{print $1}'`" -lt 9; then { echo "$as_me:$LINENO: WARNING: Aqua requires Mac OS X 10.5 or later" >&5 echo "$as_me: WARNING: Aqua requires Mac OS X 10.5 or later" >&2;} tk_aqua=no fi fi echo "$as_me:$LINENO: result: $tk_aqua" >&5 echo "${ECHO_T}$tk_aqua" >&6 if test "$fat_32_64" = yes; then if test $tk_aqua = no; then echo "$as_me:$LINENO: checking for 64-bit X11" >&5 echo $ECHO_N "checking for 64-bit X11... $ECHO_C" >&6 if test "${tcl_cv_lib_x11_64+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done CPPFLAGS="$CPPFLAGS -I/usr/X11R6/include" LDFLAGS="$LDFLAGS -L/usr/X11R6/lib -lX11" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { XrmInitialize(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_lib_x11_64=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_lib_x11_64=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi echo "$as_me:$LINENO: result: $tcl_cv_lib_x11_64" >&5 echo "${ECHO_T}$tcl_cv_lib_x11_64" >&6 fi # remove 64-bit arch flags from CFLAGS et al. for combined 32 & 64 bit # fat builds if configuration does not support 64-bit. if test "$tcl_cv_lib_x11_64" = no; then { echo "$as_me:$LINENO: Removing 64-bit architectures from compiler & linker flags" >&5 echo "$as_me: Removing 64-bit architectures from compiler & linker flags" >&6;} for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi fi if test $tk_aqua = no; then # check if weak linking whole libraries is possible. echo "$as_me:$LINENO: checking if ld accepts -weak-l flag" >&5 echo $ECHO_N "checking if ld accepts -weak-l flag... $ECHO_C" >&6 if test "${tcl_cv_ld_weak_l+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-weak-lm" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { double f = sin(1.0); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_ld_weak_l=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_ld_weak_l=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi echo "$as_me:$LINENO: result: $tcl_cv_ld_weak_l" >&5 echo "${ECHO_T}$tcl_cv_ld_weak_l" >&6 fi for ac_header in AvailabilityMacros.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ----------------------------- ## ## Report this to the tk lists. ## ## ----------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "$ac_cv_header_AvailabilityMacros_h" = yes; then echo "$as_me:$LINENO: checking if weak import is available" >&5 echo $ECHO_N "checking if weak import is available... $ECHO_C" >&6 if test "${tcl_cv_cc_weak_import+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); int main () { rand(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_weak_import=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_weak_import=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_weak_import" >&5 echo "${ECHO_T}$tcl_cv_cc_weak_import" >&6 if test $tcl_cv_cc_weak_import = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_WEAK_IMPORT 1 _ACEOF fi echo "$as_me:$LINENO: checking if Darwin SUSv3 extensions are available" >&5 echo $ECHO_N "checking if Darwin SUSv3 extensions are available... $ECHO_C" >&6 if test "${tcl_cv_cc_darwin_c_source+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #endif #define _DARWIN_C_SOURCE 1 #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then tcl_cv_cc_darwin_c_source=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 tcl_cv_cc_darwin_c_source=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi echo "$as_me:$LINENO: result: $tcl_cv_cc_darwin_c_source" >&5 echo "${ECHO_T}$tcl_cv_cc_darwin_c_source" >&6 if test $tcl_cv_cc_darwin_c_source = yes; then cat >>confdefs.h <<\_ACEOF #define _DARWIN_C_SOURCE 1 _ACEOF fi fi else tk_aqua=no fi if test $tk_aqua = yes; then cat >>confdefs.h <<\_ACEOF #define MAC_OSX_TK 1 _ACEOF LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit" EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c' TK_WINDOWINGSYSTEM=AQUA if test -n "${enable_symbols}" -a "${enable_symbols}" != no; then cat >>confdefs.h <<\_ACEOF #define TK_MAC_DEBUG 1 _ACEOF fi else #-------------------------------------------------------------------- # Locate the X11 header files and the X11 library archive. Try # the ac_path_x macro first, but if it doesn't find the X stuff # (e.g. because there's no xmkmf program) then check through # a list of possible directories. Under some conditions the # autoconf macro will return an include directory that contains # no include files, so double-check its result just to be safe. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking for X" >&5 echo $ECHO_N "checking for X... $ECHO_C" >&6 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then withval="$with_x" fi; # $have_x is `yes', `no', `disabled', or empty when we do not yet know. if test "x$with_x" = xno; then # The user explicitly disabled X. have_x=disabled else if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then # Both variables are already set. have_x=yes else if test "${ac_cv_have_x+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # One or both of the vars are not set, and there is no cached value. ac_x_includes=no ac_x_libraries=no rm -fr conftest.dir if mkdir conftest.dir; then cd conftest.dir # Make sure to not put "make" in the Imakefile rules, since we grep it out. cat >Imakefile <<'_ACEOF' acfindx: @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"' _ACEOF if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} acfindx 2>/dev/null | grep -v make` # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. for ac_extension in a so sl; do if test ! -f $ac_im_usrlibdir/libX11.$ac_extension && test -f $ac_im_libdir/libX11.$ac_extension; then ac_im_usrlibdir=$ac_im_libdir; break fi done # Screen out bogus values from the imake configuration. They are # bogus both because they are the default anyway, and because # using them would break gcc on systems where it needs fixed includes. case $ac_im_incroot in /usr/include) ;; *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; esac case $ac_im_usrlibdir in /usr/lib | /lib) ;; *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; esac fi cd .. rm -fr conftest.dir fi # Standard set of common directories for X headers. # Check X11 before X11Rn because it is often a symlink to the current release. ac_x_header_dirs=' /usr/X11/include /usr/X11R6/include /usr/X11R5/include /usr/X11R4/include /usr/include/X11 /usr/include/X11R6 /usr/include/X11R5 /usr/include/X11R4 /usr/local/X11/include /usr/local/X11R6/include /usr/local/X11R5/include /usr/local/X11R4/include /usr/local/include/X11 /usr/local/include/X11R6 /usr/local/include/X11R5 /usr/local/include/X11R4 /usr/X386/include /usr/x386/include /usr/XFree86/include/X11 /usr/include /usr/local/include /usr/unsupported/include /usr/athena/include /usr/local/x11r5/include /usr/lpp/Xamples/include /usr/openwin/include /usr/openwin/share/include' if test "$ac_x_includes" = no; then # Guess where to find include files, by looking for Xlib.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # We can compile using X headers with no special include directory. ac_x_includes= else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do if test -r "$ac_dir/X11/Xlib.h"; then ac_x_includes=$ac_dir break fi done fi rm -f conftest.err conftest.$ac_ext fi # $ac_x_includes = no if test "$ac_x_libraries" = no; then # Check for the libraries. # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS=$LIBS LIBS="-lX11 $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { XrmInitialize () ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then LIBS=$ac_save_LIBS # We can link X programs with no special library path. ac_x_libraries= else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 LIBS=$ac_save_LIBS for ac_dir in `echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` do # Don't even attempt the hair of trying to link an X program! for ac_extension in a so sl; do if test -r $ac_dir/libXt.$ac_extension; then ac_x_libraries=$ac_dir break 2 fi done done fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi # $ac_x_libraries = no if test "$ac_x_includes" = no || test "$ac_x_libraries" = no; then # Didn't find X anywhere. Cache the known absence of X. ac_cv_have_x="have_x=no" else # Record where we found X for the cache. ac_cv_have_x="have_x=yes \ ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries" fi fi fi eval "$ac_cv_have_x" fi # $with_x != no if test "$have_x" != yes; then echo "$as_me:$LINENO: result: $have_x" >&5 echo "${ECHO_T}$have_x" >&6 no_x=yes else # If each of the values was on the command line, it overrides each guess. test "x$x_includes" = xNONE && x_includes=$ac_x_includes test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries # Update the cache value to reflect the command line values. ac_cv_have_x="have_x=yes \ ac_x_includes=$x_includes ac_x_libraries=$x_libraries" echo "$as_me:$LINENO: result: libraries $x_libraries, headers $x_includes" >&5 echo "${ECHO_T}libraries $x_libraries, headers $x_includes" >&6 fi not_really_there="" if test "$no_x" = ""; then if test "$x_includes" = ""; then cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 not_really_there="yes" fi rm -f conftest.err conftest.$ac_ext else if test ! -r $x_includes/X11/Xlib.h; then not_really_there="yes" fi fi fi if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then echo "$as_me:$LINENO: checking for X11 header files" >&5 echo $ECHO_N "checking for X11 header files... $ECHO_C" >&6 found_xincludes="no" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then found_xincludes="yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 found_xincludes="no" fi rm -f conftest.err conftest.$ac_ext if test "$found_xincludes" = "no"; then dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" for i in $dirs ; do if test -r $i/X11/Xlib.h; then echo "$as_me:$LINENO: result: $i" >&5 echo "${ECHO_T}$i" >&6 XINCLUDES=" -I$i" found_xincludes="yes" break fi done fi else if test "$x_includes" != ""; then XINCLUDES="-I$x_includes" found_xincludes="yes" fi fi if test "$found_xincludes" = "no"; then echo "$as_me:$LINENO: result: couldn't find any!" >&5 echo "${ECHO_T}couldn't find any!" >&6 fi if test "$no_x" = yes; then echo "$as_me:$LINENO: checking for X11 libraries" >&5 echo $ECHO_N "checking for X11 libraries... $ECHO_C" >&6 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 if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl -o -r $i/libX11.dylib; then echo "$as_me:$LINENO: result: $i" >&5 echo "${ECHO_T}$i" >&6 XLIBSW="-L$i -lX11" x_libraries="$i" break fi done else if test "$x_libraries" = ""; then XLIBSW=-lX11 else XLIBSW="-L$x_libraries -lX11" fi fi if test "$XLIBSW" = nope ; then echo "$as_me:$LINENO: checking for XCreateWindow in -lXwindow" >&5 echo $ECHO_N "checking for XCreateWindow in -lXwindow... $ECHO_C" >&6 if test "${ac_cv_lib_Xwindow_XCreateWindow+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lXwindow $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char XCreateWindow (); int main () { XCreateWindow (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_Xwindow_XCreateWindow=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_Xwindow_XCreateWindow=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_Xwindow_XCreateWindow" >&5 echo "${ECHO_T}$ac_cv_lib_Xwindow_XCreateWindow" >&6 if test $ac_cv_lib_Xwindow_XCreateWindow = yes; then XLIBSW=-lXwindow fi fi if test "$XLIBSW" = nope ; then echo "$as_me:$LINENO: result: could not find any! Using -lX11." >&5 echo "${ECHO_T}could not find any! Using -lX11." >&6 XLIBSW=-lX11 fi TK_WINDOWINGSYSTEM=X11 fi #-------------------------------------------------------------------- # Various manipulations on the search path used at runtime to # find shared libraries: # 1. If the X library binaries are in a non-standard directory, # add the X library location into that search path. # 2. On systems such as AIX and Ultrix that use "-L" as the # search path option, colons cannot be used to separate # directories from each other. Change colons to " -L". # 3. Create two sets of search flags, one for use in cc lines # and the other for when the linker is invoked directly. In # the second case, '-Wl,' must be stripped off and commas must # be replaced by spaces. #-------------------------------------------------------------------- if test "x${x_libraries}" != "x"; then if test "x${x_libraries}" != "xNONE"; then LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${x_libraries}" fi fi if test "${TCL_LD_SEARCH_FLAGS}" = '-L${LIB_RUNTIME_DIR}'; then LIB_RUNTIME_DIR=`echo ${LIB_RUNTIME_DIR} |sed -e 's/:/ -L/g'` fi #-------------------------------------------------------------------- # Check for the existence of various libraries. The order here # is important, so that then end up in the right order in the # command line generated by make. The -lsocket and -lnsl libraries # require a couple of special tricks: # 1. Use "connect" and "accept" to check for -lsocket, and # "gethostbyname" to check for -lnsl. # 2. Use each function name only once: can't redo a check because # autoconf caches the results of the last check and won't redo it. # 3. Use -lnsl and -lsocket only if they supply procedures that # aren't already present in the normal libraries. This is because # IRIX 5.2 has libraries, but they aren't needed and they're # bogus: they goof up name resolution if used. # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- if test $tk_aqua = no; then echo "$as_me:$LINENO: checking for main in -lXbsd" >&5 echo $ECHO_N "checking for main in -lXbsd... $ECHO_C" >&6 if test "${ac_cv_lib_Xbsd_main+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lXbsd $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { main (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_Xbsd_main=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_Xbsd_main=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_Xbsd_main" >&5 echo "${ECHO_T}$ac_cv_lib_Xbsd_main" >&6 if test $ac_cv_lib_Xbsd_main = yes; then LIBS="$LIBS -lXbsd" fi fi #-------------------------------------------------------------------- # One more check related to the X libraries. The standard releases # of Ultrix don't support the "xauth" mechanism, so send won't work # unless TK_NO_SECURITY is defined. However, there are usually copies # of the MIT X server available as well, which do support xauth. # Check for the MIT stuff and use it if it exists. # # Note: can't use ac_check_lib macro (at least, not in Autoconf 2.1) # because it can't deal with the "-" in the library name. #-------------------------------------------------------------------- if test -d /usr/include/mit -a $tk_aqua = no; then echo "$as_me:$LINENO: checking MIT X libraries" >&5 echo $ECHO_N "checking MIT X libraries... $ECHO_C" >&6 tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS -I/usr/include/mit" tk_oldLibs=$LIBS LIBS="$LIBS -lX11-mit" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int main () { XOpenDisplay(0); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 XLIBSW="-lX11-mit" XINCLUDES="-I/usr/include/mit" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi #-------------------------------------------------------------------- # Check for freetype / fontconfig / Xft support. #-------------------------------------------------------------------- if test $tk_aqua = no; then echo "$as_me:$LINENO: checking whether to use xft" >&5 echo $ECHO_N "checking whether to use xft... $ECHO_C" >&6 # Check whether --enable-xft or --disable-xft was given. if test "${enable_xft+set}" = set; then enableval="$enable_xft" enable_xft=$enableval else enable_xft="default" fi; XFT_CFLAGS="" XFT_LIBS="" if test "$enable_xft" = "no" ; then echo "$as_me:$LINENO: result: $enable_xft" >&5 echo "${ECHO_T}$enable_xft" >&6 else found_xft="yes" XFT_CFLAGS=`xft-config --cflags 2>/dev/null` || found_xft="no" XFT_LIBS=`xft-config --libs 2>/dev/null` || found_xft="no" if test "$found_xft" = "no" ; then found_xft=yes XFT_CFLAGS=`pkg-config --cflags xft 2>/dev/null` || found_xft="no" XFT_LIBS=`pkg-config --libs xft 2>/dev/null` || found_xft="no" fi echo "$as_me:$LINENO: result: $found_xft" >&5 echo "${ECHO_T}$found_xft" >&6 if test "$found_xft" = "yes" ; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" tk_oldLibs=$LIBS LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" echo "$as_me:$LINENO: checking for X11/Xft/Xft.h" >&5 echo $ECHO_N "checking for X11/Xft/Xft.h... $ECHO_C" >&6 if test "${ac_cv_header_X11_Xft_Xft_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_X11_Xft_Xft_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_X11_Xft_Xft_h=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_header_X11_Xft_Xft_h" >&5 echo "${ECHO_T}$ac_cv_header_X11_Xft_Xft_h" >&6 if test $ac_cv_header_X11_Xft_Xft_h = yes; then : else found_xft=no fi CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi if test "$found_xft" = "yes" ; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" tk_oldLibs=$LIBS LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" echo "$as_me:$LINENO: checking for XftFontOpen in -lXft" >&5 echo $ECHO_N "checking for XftFontOpen in -lXft... $ECHO_C" >&6 if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lXft $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char XftFontOpen (); int main () { XftFontOpen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_Xft_XftFontOpen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_Xft_XftFontOpen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_Xft_XftFontOpen" >&5 echo "${ECHO_T}$ac_cv_lib_Xft_XftFontOpen" >&6 if test $ac_cv_lib_Xft_XftFontOpen = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBXFT 1 _ACEOF LIBS="-lXft $LIBS" else found_xft=no fi CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi if test "$found_xft" = "yes" ; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" tk_oldLibs=$LIBS LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW -lfontconfig" echo "$as_me:$LINENO: checking for FcFontSort in -lfontconfig" >&5 echo $ECHO_N "checking for FcFontSort in -lfontconfig... $ECHO_C" >&6 if test "${ac_cv_lib_fontconfig_FcFontSort+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lfontconfig $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char FcFontSort (); int main () { FcFontSort (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_fontconfig_FcFontSort=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_fontconfig_FcFontSort=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_fontconfig_FcFontSort" >&5 echo "${ECHO_T}$ac_cv_lib_fontconfig_FcFontSort" >&6 if test $ac_cv_lib_fontconfig_FcFontSort = yes; then XFT_LIBS="$XFT_LIBS -lfontconfig" fi CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi if test "$found_xft" = "no" ; then if test "$enable_xft" = "yes" ; then { echo "$as_me:$LINENO: WARNING: Can't find xft configuration, or xft is unusable" >&5 echo "$as_me: WARNING: Can't find xft configuration, or xft is unusable" >&2;} fi enable_xft=no XFT_CFLAGS="" XFT_LIBS="" else enable_xft=yes fi fi if test $enable_xft = "yes" ; then UNIX_FONT_OBJS=tkUnixRFont.o cat >>confdefs.h <<\_ACEOF #define HAVE_XFT 1 _ACEOF else UNIX_FONT_OBJS=tkUnixFont.o fi fi #-------------------------------------------------------------------- # Check for XkbKeycodeToKeysym. #-------------------------------------------------------------------- if test $tk_aqua = no; then tk_oldCFlags=$CFLAGS tk_oldLibs=$LIBS CFLAGS="$CFLAGS $XINCLUDES" LIBS="$LIBS $XLIBSW" echo "$as_me:$LINENO: checking for X11/XKBlib.h" >&5 echo $ECHO_N "checking for X11/XKBlib.h... $ECHO_C" >&6 if test "${ac_cv_header_X11_XKBlib_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_X11_XKBlib_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_X11_XKBlib_h=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_header_X11_XKBlib_h" >&5 echo "${ECHO_T}$ac_cv_header_X11_XKBlib_h" >&6 if test $ac_cv_header_X11_XKBlib_h = yes; then xkblib_header_found=yes else xkblib_header_found=no fi if test $xkblib_header_found = "yes" ; then echo "$as_me:$LINENO: checking for XkbKeycodeToKeysym in -lX11" >&5 echo $ECHO_N "checking for XkbKeycodeToKeysym in -lX11... $ECHO_C" >&6 if test "${ac_cv_lib_X11_XkbKeycodeToKeysym+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lX11 $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char XkbKeycodeToKeysym (); int main () { XkbKeycodeToKeysym (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_X11_XkbKeycodeToKeysym=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_X11_XkbKeycodeToKeysym=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_X11_XkbKeycodeToKeysym" >&5 echo "${ECHO_T}$ac_cv_lib_X11_XkbKeycodeToKeysym" >&6 if test $ac_cv_lib_X11_XkbKeycodeToKeysym = yes; then xkbkeycodetokeysym_found=yes else xkbkeycodetokeysym_found=no fi else xkbkeycodetokeysym_found=no fi if test $xkbkeycodetokeysym_found = "yes" ; then cat >>confdefs.h <<\_ACEOF #define HAVE_XKBKEYCODETOKEYSYM 1 _ACEOF fi CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi #-------------------------------------------------------------------- # XXX Do this last. # It might modify XLIBSW which could affect other tests. # # Check whether the header and library for the XScreenSaver # extension are available, and set HAVE_XSS if so. # XScreenSaver is needed for Tk_GetUserInactiveTime(). #-------------------------------------------------------------------- if test $tk_aqua = no; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES" tk_oldLibs=$LIBS LIBS="$tk_oldLibs $XLIBSW" xss_header_found=no xss_lib_found=no echo "$as_me:$LINENO: checking whether to try to use XScreenSaver" >&5 echo $ECHO_N "checking whether to try to use XScreenSaver... $ECHO_C" >&6 # Check whether --enable-xss or --disable-xss was given. if test "${enable_xss+set}" = set; then enableval="$enable_xss" enable_xss=$enableval else enable_xss=yes fi; if test "$enable_xss" = "no" ; then echo "$as_me:$LINENO: result: $enable_xss" >&5 echo "${ECHO_T}$enable_xss" >&6 else echo "$as_me:$LINENO: result: $enable_xss" >&5 echo "${ECHO_T}$enable_xss" >&6 echo "$as_me:$LINENO: checking for X11/extensions/scrnsaver.h" >&5 echo $ECHO_N "checking for X11/extensions/scrnsaver.h... $ECHO_C" >&6 if test "${ac_cv_header_X11_extensions_scrnsaver_h+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_X11_extensions_scrnsaver_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_X11_extensions_scrnsaver_h=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_header_X11_extensions_scrnsaver_h" >&5 echo "${ECHO_T}$ac_cv_header_X11_extensions_scrnsaver_h" >&6 if test $ac_cv_header_X11_extensions_scrnsaver_h = yes; then xss_header_found=yes fi echo "$as_me:$LINENO: checking for XScreenSaverQueryInfo" >&5 echo $ECHO_N "checking for XScreenSaverQueryInfo... $ECHO_C" >&6 if test "${ac_cv_func_XScreenSaverQueryInfo+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define XScreenSaverQueryInfo to an innocuous variant, in case declares XScreenSaverQueryInfo. For example, HP-UX 11i declares gettimeofday. */ #define XScreenSaverQueryInfo innocuous_XScreenSaverQueryInfo /* System header to define __stub macros and hopefully few prototypes, which can conflict with char XScreenSaverQueryInfo (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef XScreenSaverQueryInfo /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char XScreenSaverQueryInfo (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_XScreenSaverQueryInfo) || defined (__stub___XScreenSaverQueryInfo) choke me #else char (*f) () = XScreenSaverQueryInfo; #endif #ifdef __cplusplus } #endif int main () { return f != XScreenSaverQueryInfo; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_XScreenSaverQueryInfo=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_XScreenSaverQueryInfo=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_XScreenSaverQueryInfo" >&5 echo "${ECHO_T}$ac_cv_func_XScreenSaverQueryInfo" >&6 if test $ac_cv_func_XScreenSaverQueryInfo = yes; then : else echo "$as_me:$LINENO: checking for XScreenSaverQueryInfo in -lXext" >&5 echo $ECHO_N "checking for XScreenSaverQueryInfo in -lXext... $ECHO_C" >&6 if test "${ac_cv_lib_Xext_XScreenSaverQueryInfo+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lXext $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char XScreenSaverQueryInfo (); int main () { XScreenSaverQueryInfo (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_Xext_XScreenSaverQueryInfo=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_Xext_XScreenSaverQueryInfo=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_Xext_XScreenSaverQueryInfo" >&5 echo "${ECHO_T}$ac_cv_lib_Xext_XScreenSaverQueryInfo" >&6 if test $ac_cv_lib_Xext_XScreenSaverQueryInfo = yes; then XLIBSW="$XLIBSW -lXext" xss_lib_found=yes else echo "$as_me:$LINENO: checking for XScreenSaverQueryInfo in -lXss" >&5 echo $ECHO_N "checking for XScreenSaverQueryInfo in -lXss... $ECHO_C" >&6 if test "${ac_cv_lib_Xss_XScreenSaverQueryInfo+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lXss -lXext $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char XScreenSaverQueryInfo (); int main () { XScreenSaverQueryInfo (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_Xss_XScreenSaverQueryInfo=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_Xss_XScreenSaverQueryInfo=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_Xss_XScreenSaverQueryInfo" >&5 echo "${ECHO_T}$ac_cv_lib_Xss_XScreenSaverQueryInfo" >&6 if test $ac_cv_lib_Xss_XScreenSaverQueryInfo = yes; then if test "$tcl_cv_ld_weak_l" = yes; then # On Darwin, weak link libXss if possible, # as it is only available on Tiger or later. XLIBSW="$XLIBSW -Wl,-weak-lXss -lXext" else XLIBSW="$XLIBSW -lXss -lXext" fi xss_lib_found=yes fi fi fi fi if test $enable_xss = yes -a $xss_lib_found = yes -a $xss_header_found = yes; then cat >>confdefs.h <<\_ACEOF #define HAVE_XSS 1 _ACEOF fi CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi #-------------------------------------------------------------------- # Figure out whether "char" is unsigned. If so, set a # #define for __CHAR_UNSIGNED__. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether char is unsigned" >&5 echo $ECHO_N "checking whether char is unsigned... $ECHO_C" >&6 if test "${ac_cv_c_char_unsigned+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((char) -1) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_char_unsigned=no else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_char_unsigned=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_char_unsigned" >&5 echo "${ECHO_T}$ac_cv_c_char_unsigned" >&6 if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then cat >>confdefs.h <<\_ACEOF #define __CHAR_UNSIGNED__ 1 _ACEOF fi #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtk as a shared library instead of a static library. #-------------------------------------------------------------------- eval eval "TK_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}" eval eval "TK_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}" eval "TK_LIB_FILE=libtk${LIB_SUFFIX}" # tkConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed # since on some platforms TK_LIB_FILE contains shell escapes. eval "TK_LIB_FILE=${TK_LIB_FILE}" if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \${TCL_STUB_LIB_SPEC}" TCL_STUB_FLAGS="-DUSE_TCL_STUBS" fi TK_LIBRARY='$(prefix)/lib/tk$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' TK_PKG_DIR='tk$(VERSION)' TK_RSRC_FILE='tk$(VERSION).rsrc' WISH_RSRC_FILE='wish$(VERSION).rsrc' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then echo "$as_me:$LINENO: checking how to package libraries" >&5 echo $ECHO_N "checking how to package libraries... $ECHO_C" >&6 # Check whether --enable-framework or --disable-framework was given. if test "${enable_framework+set}" = set; then enableval="$enable_framework" enable_framework=$enableval else enable_framework=no fi; if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then { echo "$as_me:$LINENO: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} enable_framework=no fi if test $tcl_corefoundation = no; then { echo "$as_me:$LINENO: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} enable_framework=no fi fi if test $enable_framework = yes; then echo "$as_me:$LINENO: result: framework" >&5 echo "${ECHO_T}framework" >&6 FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then echo "$as_me:$LINENO: result: shared library" >&5 echo "${ECHO_T}shared library" >&6 else echo "$as_me:$LINENO: result: static library" >&5 echo "${ECHO_T}static library" >&6 fi FRAMEWORK_BUILD=0 fi fi TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version ${TK_VERSION}`echo ${TK_PATCH_LEVEL} | awk '{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}'`" TK_SHLIB_LD_EXTRAS="${TK_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}/${TK_LIB_FILE}" -unexported_symbols_list $$(f=$(TK_LIB_FILE).E && nm -gp tkMacOSX*.o 2>/dev/null | awk "/^[0-9a-f]+ . \.objc/ {print \$$3}" > $$f && nm -gjp "$(TCL_BIN_DIR)"/$(TCL_STUB_LIB_FILE) | grep ^_[^_] >> $$f && echo $$f)' echo "$LDFLAGS " | grep -q -- '-prebind ' && TK_SHLIB_LD_EXTRAS="${TK_SHLIB_LD_EXTRAS}"' -seg1addr 0xb000000' TK_SHLIB_LD_EXTRAS="${TK_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tk-Info.plist' EXTRA_WISH_LIBS='-sectcreate __TEXT __info_plist Wish-Info.plist' EXTRA_APP_CC_SWITCHES="${EXTRA_APP_CC_SWITCHES}"' -mdynamic-no-pic' ac_config_files="$ac_config_files Tk-Info.plist:../macosx/Tk-Info.plist.in Wish-Info.plist:../macosx/Wish-Info.plist.in" for l in ${LOCALES}; do CFBUNDLELOCALIZATIONS="${CFBUNDLELOCALIZATIONS}$l"; done TK_YEAR="`date +%Y`" fi if test "$FRAMEWORK_BUILD" = "1" ; then cat >>confdefs.h <<\_ACEOF #define TK_FRAMEWORK 1 _ACEOF # Construct a fake local framework structure to make linking with # '-framework Tk' and running of tktest work ac_config_commands="$ac_config_commands Tk.framework" LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" if test "${libdir}" = '${exec_prefix}/lib'; then # override libdir default libdir="/Library/Frameworks" fi TK_LIB_FILE="Tk" TK_LIB_FLAG="-framework Tk" TK_BUILD_LIB_SPEC="-F`pwd | sed -e 's/ /\\\\ /g'` -framework Tk" TK_LIB_SPEC="-F${libdir} -framework Tk" libdir="${libdir}/Tk.framework/Versions/\${VERSION}" TK_LIBRARY="${libdir}/Resources/Scripts" TK_PKG_DIR="Resources/Scripts" TK_RSRC_FILE="Tk.rsrc" WISH_RSRC_FILE="Wish.rsrc" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tk" EXTRA_INSTALL="install-private-headers html-tk" EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TkTOC.html' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tk-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' if test $tk_aqua = yes; then EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Images to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)/Resources"; done' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing wish$(VERSION) script to $(INSTALL_ROOT)/'"${bindir}"'" && mkdir -p "$(INSTALL_ROOT)/'"${bindir}"'" && printf > "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)" "#!/bin/sh\n\"\$$(dirname \$$0)'"`eval d="${bindir}"; echo "$d" | sed -e 's#/[^/][^/]*#/..#g'`"'$(bindir)/Wish\" \"\$$@\"" && chmod +x "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)"' bindir="${libdir}/Resources/Wish.app/Contents/MacOS" EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Info.plist to $(BIN_INSTALL_DIR)/.." && $(INSTALL_DATA) Wish-Info.plist "$(BIN_INSTALL_DIR)/../Info.plist" && mv -f "$(BIN_INSTALL_DIR)/wish$(VERSION)" "$(BIN_INSTALL_DIR)/Wish"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.icns to $(BIN_INSTALL_DIR)/../Resources" && mkdir -p "$(BIN_INSTALL_DIR)/../Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Tk.icns" "$(BIN_INSTALL_DIR)/../Resources/Wish.icns"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.sdef to $(BIN_INSTALL_DIR)/../Resources" && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Wish.sdef" "$(BIN_INSTALL_DIR)/../Resources"' fi EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tk.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tkConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we # can pick up a potential make override of VERSION. Also, don't put this # into CFLAGS as it should not go into tkConfig.sh EXTRA_CC_SWITCHES="$EXTRA_CC_SWITCHES"' -DTK_FRAMEWORK_VERSION=\"$(VERSION)\"' else if test $tk_aqua = yes; then EXTRA_INSTALL_BINARIES='@echo "Installing Images to $(LIB_INSTALL_DIR)/" && mkdir -p "$(LIB_INSTALL_DIR)" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)"; done' fi # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" if test "${ac_cv_cygwin}" = "yes" -a "$SHARED_BUILD" = "1"; then TK_LIB_FLAG="-ltk`echo ${TK_VERSION} | tr -d .`" TK_BUILD_LIB_SPEC="-L\$(TOP_DIR)/win ${TK_LIB_FLAG}" else if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TK_LIB_FLAG="-ltk${TK_VERSION}" else TK_LIB_FLAG="-ltk`echo ${TK_VERSION} | tr -d .`" fi TK_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TK_LIB_FLAG}" fi TK_LIB_SPEC="-L${libdir} ${TK_LIB_FLAG}" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tk # stub support. #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TK_VERSION} eval "TK_STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}" eval "TK_STUB_LIB_DIR=${libdir}" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}" else TK_STUB_LIB_FLAG="-ltkstub`echo ${TK_VERSION} | tr -d .`" fi TK_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_SPEC="-L${TK_STUB_LIB_DIR} ${TK_STUB_LIB_FLAG}" TK_BUILD_STUB_LIB_PATH="`pwd`/${TK_STUB_LIB_FILE}" TK_STUB_LIB_PATH="${TK_STUB_LIB_DIR}/${TK_STUB_LIB_FILE}" # Install time header dir can be set via --includedir eval "TK_INCLUDE_SPEC=\"-I${includedir}\"" #------------------------------------------------------------------------ # tkConfig.sh refers to this by a different name #------------------------------------------------------------------------ TK_SHARED_BUILD=${SHARED_BUILD} ac_config_files="$ac_config_files Makefile:../unix/Makefile.in tkConfig.sh:../unix/tkConfig.sh.in tk.pc:../unix/tk.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat >confdef2opt.sed <<\_ACEOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p _ACEOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by tk $as_me 8.5, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Configuration commands: $config_commands Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ tk config.status 8.5 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # INIT-COMMANDS section. # VERSION=${TK_VERSION} && tk_aqua=${tk_aqua} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Tk-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tk-Info.plist:../macosx/Tk-Info.plist.in" ;; "Wish-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Wish-Info.plist:../macosx/Wish-Info.plist.in" ;; "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; "tkConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tkConfig.sh:../unix/tkConfig.sh.in" ;; "tk.pc" ) CONFIG_FILES="$CONFIG_FILES tk.pc:../unix/tk.pc.in" ;; "Tk.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tk.framework" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t s,@TCLSH_PROG@,$TCLSH_PROG,;t t s,@BUILD_TCLSH@,$BUILD_TCLSH,;t t s,@MAN_FLAGS@,$MAN_FLAGS,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@CPP@,$CPP,;t t s,@EGREP@,$EGREP,;t t s,@TCL_THREADS@,$TCL_THREADS,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@AR@,$AR,;t t s,@ac_ct_AR@,$ac_ct_AR,;t t s,@TCL_LIBS@,$TCL_LIBS,;t t s,@DL_LIBS@,$DL_LIBS,;t t s,@DL_OBJS@,$DL_OBJS,;t t s,@PLAT_OBJS@,$PLAT_OBJS,;t t s,@PLAT_SRCS@,$PLAT_SRCS,;t t s,@LDAIX_SRC@,$LDAIX_SRC,;t t s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t s,@CC_SEARCH_FLAGS@,$CC_SEARCH_FLAGS,;t t s,@LD_SEARCH_FLAGS@,$LD_SEARCH_FLAGS,;t t s,@STLIB_LD@,$STLIB_LD,;t t s,@SHLIB_LD@,$SHLIB_LD,;t t s,@TCL_SHLIB_LD_EXTRAS@,$TCL_SHLIB_LD_EXTRAS,;t t s,@TK_SHLIB_LD_EXTRAS@,$TK_SHLIB_LD_EXTRAS,;t t s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@INSTALL_LIB@,$INSTALL_LIB,;t t s,@DLL_INSTALL_DIR@,$DLL_INSTALL_DIR,;t t s,@INSTALL_STUB_LIB@,$INSTALL_STUB_LIB,;t t s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@XFT_CFLAGS@,$XFT_CFLAGS,;t t s,@XFT_LIBS@,$XFT_LIBS,;t t s,@UNIX_FONT_OBJS@,$UNIX_FONT_OBJS,;t t s,@TK_VERSION@,$TK_VERSION,;t t s,@TK_MAJOR_VERSION@,$TK_MAJOR_VERSION,;t t s,@TK_MINOR_VERSION@,$TK_MINOR_VERSION,;t t s,@TK_PATCH_LEVEL@,$TK_PATCH_LEVEL,;t t s,@TK_YEAR@,$TK_YEAR,;t t s,@TK_LIB_FILE@,$TK_LIB_FILE,;t t s,@TK_LIB_FLAG@,$TK_LIB_FLAG,;t t s,@TK_LIB_SPEC@,$TK_LIB_SPEC,;t t s,@TK_STUB_LIB_FILE@,$TK_STUB_LIB_FILE,;t t s,@TK_STUB_LIB_FLAG@,$TK_STUB_LIB_FLAG,;t t s,@TK_STUB_LIB_SPEC@,$TK_STUB_LIB_SPEC,;t t s,@TK_STUB_LIB_PATH@,$TK_STUB_LIB_PATH,;t t s,@TK_INCLUDE_SPEC@,$TK_INCLUDE_SPEC,;t t s,@TK_BUILD_STUB_LIB_SPEC@,$TK_BUILD_STUB_LIB_SPEC,;t t s,@TK_BUILD_STUB_LIB_PATH@,$TK_BUILD_STUB_LIB_PATH,;t t s,@TK_SRC_DIR@,$TK_SRC_DIR,;t t s,@TK_SHARED_BUILD@,$TK_SHARED_BUILD,;t t s,@LD_LIBRARY_PATH_VAR@,$LD_LIBRARY_PATH_VAR,;t t s,@TK_BUILD_LIB_SPEC@,$TK_BUILD_LIB_SPEC,;t t s,@TCL_STUB_FLAGS@,$TCL_STUB_FLAGS,;t t s,@XINCLUDES@,$XINCLUDES,;t t s,@XLIBSW@,$XLIBSW,;t t s,@LOCALES@,$LOCALES,;t t s,@TK_WINDOWINGSYSTEM@,$TK_WINDOWINGSYSTEM,;t t s,@TK_PKG_DIR@,$TK_PKG_DIR,;t t s,@TK_LIBRARY@,$TK_LIBRARY,;t t s,@LIB_RUNTIME_DIR@,$LIB_RUNTIME_DIR,;t t s,@PRIVATE_INCLUDE_DIR@,$PRIVATE_INCLUDE_DIR,;t t s,@HTML_DIR@,$HTML_DIR,;t t s,@EXTRA_CC_SWITCHES@,$EXTRA_CC_SWITCHES,;t t s,@EXTRA_APP_CC_SWITCHES@,$EXTRA_APP_CC_SWITCHES,;t t s,@EXTRA_INSTALL@,$EXTRA_INSTALL,;t t s,@EXTRA_INSTALL_BINARIES@,$EXTRA_INSTALL_BINARIES,;t t s,@EXTRA_BUILD_HTML@,$EXTRA_BUILD_HTML,;t t s,@EXTRA_WISH_LIBS@,$EXTRA_WISH_LIBS,;t t s,@CFBUNDLELOCALIZATIONS@,$CFBUNDLELOCALIZATIONS,;t t s,@TK_RSRC_FILE@,$TK_RSRC_FILE,;t t s,@WISH_RSRC_FILE@,$WISH_RSRC_FILE,;t t s,@LIB_RSRC_FILE@,$LIB_RSRC_FILE,;t t s,@APP_RSRC_FILE@,$APP_RSRC_FILE,;t t s,@REZ@,$REZ,;t t s,@REZ_FLAGS@,$REZ_FLAGS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # # CONFIG_COMMANDS section. # for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue ac_dest=`echo "$ac_file" | sed 's,:.*,,'` ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_dir=`(dirname "$ac_dest") 2>/dev/null || $as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_dest" : 'X\(//\)[^/]' \| \ X"$ac_dest" : 'X\(//\)$' \| \ X"$ac_dest" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_dest" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac { echo "$as_me:$LINENO: executing $ac_dest commands" >&5 echo "$as_me: executing $ac_dest commands" >&6;} case $ac_dest in Tk.framework ) n=Tk && f=$n.framework && v=Versions/$VERSION && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && if test $tk_aqua = yes; then ln -s ../../../../$n.rsrc $f/$v/Resources; fi && unset n f v ;; esac done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi tk8.5.19/unix/license.terms0000644003604700454610000000424012656405252014242 0ustar dgp771divThis software is copyrighted by the Regents of the University of California, Sun Microsystems, Inc., and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7013 (b) (3) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. tk8.5.19/unix/tkUnixScale.c0000644003604700454610000005061412612445655014153 0ustar dgp771div/* * tkUnixScale.c -- * * This file implements the X specific portion of the scrollbar widget. * * Copyright (c) 1996 by Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" #include "tkScale.h" /* * Forward declarations for functions defined later in this file: */ static void DisplayHorizontalScale(TkScale *scalePtr, Drawable drawable, XRectangle *drawnAreaPtr); static void DisplayHorizontalValue(TkScale *scalePtr, Drawable drawable, double value, int top); static void DisplayVerticalScale(TkScale *scalePtr, Drawable drawable, XRectangle *drawnAreaPtr); static void DisplayVerticalValue(TkScale *scalePtr, Drawable drawable, double value, int rightEdge); /* *---------------------------------------------------------------------- * * TkpCreateScale -- * * Allocate a new TkScale structure. * * Results: * Returns a newly allocated TkScale structure. * * Side effects: * None. * *---------------------------------------------------------------------- */ TkScale * TkpCreateScale( Tk_Window tkwin) { return (TkScale *) ckalloc(sizeof(TkScale)); } /* *---------------------------------------------------------------------- * * TkpDestroyScale -- * * Destroy a TkScale structure. It's necessary to do this with * Tcl_EventuallyFree to allow the Tcl_Preserve(scalePtr) to work as * expected in TkpDisplayScale. (hobbs) * * Results: * None * * Side effects: * Memory is freed. * *---------------------------------------------------------------------- */ void TkpDestroyScale( TkScale *scalePtr) { Tcl_EventuallyFree((ClientData) scalePtr, TCL_DYNAMIC); } /* *-------------------------------------------------------------- * * DisplayVerticalScale -- * * This function redraws the contents of a vertical scale window. It is * invoked as a do-when-idle handler, so it only runs when there's * nothing else for the application to do. * * Results: * There is no return value. If only a part of the scale needs to be * redrawn, then drawnAreaPtr is modified to reflect the area that was * actually modified. * * Side effects: * Information appears on the screen. * *-------------------------------------------------------------- */ static void DisplayVerticalScale( TkScale *scalePtr, /* Widget record for scale. */ Drawable drawable, /* Where to display scale (window or * pixmap). */ XRectangle *drawnAreaPtr) /* Initally contains area of window; if only a * part of the scale is redrawn, gets modified * to reflect the part of the window that was * redrawn. */ { Tk_Window tkwin = scalePtr->tkwin; int x, y, width, height, shadowWidth; double tickValue, tickInterval = scalePtr->tickInterval; Tk_3DBorder sliderBorder; /* * Display the information from left to right across the window. */ if (!(scalePtr->flags & REDRAW_OTHER)) { drawnAreaPtr->x = scalePtr->vertTickRightX; drawnAreaPtr->y = scalePtr->inset; drawnAreaPtr->width = scalePtr->vertTroughX + scalePtr->width + 2*scalePtr->borderWidth - scalePtr->vertTickRightX; drawnAreaPtr->height -= 2*scalePtr->inset; } Tk_Fill3DRectangle(tkwin, drawable, scalePtr->bgBorder, drawnAreaPtr->x, drawnAreaPtr->y, drawnAreaPtr->width, drawnAreaPtr->height, 0, TK_RELIEF_FLAT); if (scalePtr->flags & REDRAW_OTHER) { /* * Display the tick marks. */ if (tickInterval != 0) { double ticks, maxTicks; /* * Ensure that we will only draw enough of the tick values such * that they don't overlap */ ticks = fabs((scalePtr->toValue - scalePtr->fromValue) / tickInterval); maxTicks = (double) Tk_Height(tkwin) / (double) scalePtr->fontHeight; if (ticks > maxTicks) { tickInterval *= (ticks / maxTicks); } for (tickValue = scalePtr->fromValue; ; tickValue += tickInterval) { /* * The TkRoundToResolution call gets rid of accumulated * round-off errors, if any. */ tickValue = TkRoundToResolution(scalePtr, tickValue); if (scalePtr->toValue >= scalePtr->fromValue) { if (tickValue > scalePtr->toValue) { break; } } else { if (tickValue < scalePtr->toValue) { break; } } DisplayVerticalValue(scalePtr, drawable, tickValue, scalePtr->vertTickRightX); } } } /* * Display the value, if it is desired. */ if (scalePtr->showValue) { DisplayVerticalValue(scalePtr, drawable, scalePtr->value, scalePtr->vertValueRightX); } /* * Display the trough and the slider. */ Tk_Draw3DRectangle(tkwin, drawable, scalePtr->bgBorder, scalePtr->vertTroughX, scalePtr->inset, scalePtr->width + 2*scalePtr->borderWidth, Tk_Height(tkwin) - 2*scalePtr->inset, scalePtr->borderWidth, TK_RELIEF_SUNKEN); XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC, scalePtr->vertTroughX + scalePtr->borderWidth, scalePtr->inset + scalePtr->borderWidth, (unsigned) scalePtr->width, (unsigned) (Tk_Height(tkwin) - 2*scalePtr->inset - 2*scalePtr->borderWidth)); if (scalePtr->state == STATE_ACTIVE) { sliderBorder = scalePtr->activeBorder; } else { sliderBorder = scalePtr->bgBorder; } width = scalePtr->width; height = scalePtr->sliderLength/2; x = scalePtr->vertTroughX + scalePtr->borderWidth; y = TkScaleValueToPixel(scalePtr, scalePtr->value) - height; shadowWidth = scalePtr->borderWidth/2; if (shadowWidth == 0) { shadowWidth = 1; } Tk_Draw3DRectangle(tkwin, drawable, sliderBorder, x, y, width, 2*height, shadowWidth, scalePtr->sliderRelief); x += shadowWidth; y += shadowWidth; width -= 2*shadowWidth; height -= shadowWidth; Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y, width, height, shadowWidth, scalePtr->sliderRelief); Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y+height, width, height, shadowWidth, scalePtr->sliderRelief); /* * Draw the label to the right of the scale. */ if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) { Tk_FontMetrics fm; Tk_GetFontMetrics(scalePtr->tkfont, &fm); Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC, scalePtr->tkfont, scalePtr->label, scalePtr->labelLength, scalePtr->vertLabelX, scalePtr->inset + (3*fm.ascent)/2); } } /* *---------------------------------------------------------------------- * * DisplayVerticalValue -- * * This function is called to display values (scale readings) for * vertically-oriented scales. * * Results: * None. * * Side effects: * The numerical value corresponding to value is displayed with its right * edge at "rightEdge", and at a vertical position in the scale that * corresponds to "value". * *---------------------------------------------------------------------- */ static void DisplayVerticalValue( register TkScale *scalePtr, /* Information about widget in which to * display value. */ Drawable drawable, /* Pixmap or window in which to draw the * value. */ double value, /* Y-coordinate of number to display, * specified in application coords, not in * pixels (we'll compute pixels). */ int rightEdge) /* X-coordinate of right edge of text, * specified in pixels. */ { register Tk_Window tkwin = scalePtr->tkwin; int y, width, length; char valueString[TCL_DOUBLE_SPACE]; Tk_FontMetrics fm; Tk_GetFontMetrics(scalePtr->tkfont, &fm); y = TkScaleValueToPixel(scalePtr, value) + fm.ascent/2; sprintf(valueString, scalePtr->format, value); length = (int) strlen(valueString); width = Tk_TextWidth(scalePtr->tkfont, valueString, length); /* * Adjust the y-coordinate if necessary to keep the text entirely inside * the window. */ if ((y - fm.ascent) < (scalePtr->inset + SPACING)) { y = scalePtr->inset + SPACING + fm.ascent; } if ((y + fm.descent) > (Tk_Height(tkwin) - scalePtr->inset - SPACING)) { y = Tk_Height(tkwin) - scalePtr->inset - SPACING - fm.descent; } Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC, scalePtr->tkfont, valueString, length, rightEdge - width, y); } /* *-------------------------------------------------------------- * * DisplayHorizontalScale -- * * This function redraws the contents of a horizontal scale window. It is * invoked as a do-when-idle handler, so it only runs when there's * nothing else for the application to do. * * Results: * There is no return value. If only a part of the scale needs to be * redrawn, then drawnAreaPtr is modified to reflect the area that was * actually modified. * * Side effects: * Information appears on the screen. * *-------------------------------------------------------------- */ static void DisplayHorizontalScale( TkScale *scalePtr, /* Widget record for scale. */ Drawable drawable, /* Where to display scale (window or * pixmap). */ XRectangle *drawnAreaPtr) /* Initally contains area of window; if only a * part of the scale is redrawn, gets modified * to reflect the part of the window that was * redrawn. */ { register Tk_Window tkwin = scalePtr->tkwin; int x, y, width, height, shadowWidth; double tickValue, tickInterval = scalePtr->tickInterval; Tk_3DBorder sliderBorder; /* * Display the information from bottom to top across the window. */ if (!(scalePtr->flags & REDRAW_OTHER)) { drawnAreaPtr->x = scalePtr->inset; drawnAreaPtr->y = scalePtr->horizValueY; drawnAreaPtr->width -= 2*scalePtr->inset; drawnAreaPtr->height = scalePtr->horizTroughY + scalePtr->width + 2*scalePtr->borderWidth - scalePtr->horizValueY; } Tk_Fill3DRectangle(tkwin, drawable, scalePtr->bgBorder, drawnAreaPtr->x, drawnAreaPtr->y, drawnAreaPtr->width, drawnAreaPtr->height, 0, TK_RELIEF_FLAT); if (scalePtr->flags & REDRAW_OTHER) { /* * Display the tick marks. */ if (tickInterval != 0) { char valueString[TCL_DOUBLE_SPACE]; double ticks, maxTicks; /* * Ensure that we will only draw enough of the tick values such * that they don't overlap. We base this off the width that * fromValue would take. Not exact, but better than no constraint. */ ticks = fabs((scalePtr->toValue - scalePtr->fromValue) / tickInterval); sprintf(valueString, scalePtr->format, scalePtr->fromValue); maxTicks = (double) Tk_Width(tkwin) / (double) Tk_TextWidth(scalePtr->tkfont, valueString, -1); if (ticks > maxTicks) { tickInterval *= (ticks / maxTicks); } for (tickValue = scalePtr->fromValue; ; tickValue += tickInterval) { /* * The TkRoundToResolution call gets rid of accumulated * round-off errors, if any. */ tickValue = TkRoundToResolution(scalePtr, tickValue); if (scalePtr->toValue >= scalePtr->fromValue) { if (tickValue > scalePtr->toValue) { break; } } else { if (tickValue < scalePtr->toValue) { break; } } DisplayHorizontalValue(scalePtr, drawable, tickValue, scalePtr->horizTickY); } } } /* * Display the value, if it is desired. */ if (scalePtr->showValue) { DisplayHorizontalValue(scalePtr, drawable, scalePtr->value, scalePtr->horizValueY); } /* * Display the trough and the slider. */ y = scalePtr->horizTroughY; Tk_Draw3DRectangle(tkwin, drawable, scalePtr->bgBorder, scalePtr->inset, y, Tk_Width(tkwin) - 2*scalePtr->inset, scalePtr->width + 2*scalePtr->borderWidth, scalePtr->borderWidth, TK_RELIEF_SUNKEN); XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC, scalePtr->inset + scalePtr->borderWidth, y + scalePtr->borderWidth, (unsigned) (Tk_Width(tkwin) - 2*scalePtr->inset - 2*scalePtr->borderWidth), (unsigned) scalePtr->width); if (scalePtr->state == STATE_ACTIVE) { sliderBorder = scalePtr->activeBorder; } else { sliderBorder = scalePtr->bgBorder; } width = scalePtr->sliderLength/2; height = scalePtr->width; x = TkScaleValueToPixel(scalePtr, scalePtr->value) - width; y += scalePtr->borderWidth; shadowWidth = scalePtr->borderWidth/2; if (shadowWidth == 0) { shadowWidth = 1; } Tk_Draw3DRectangle(tkwin, drawable, sliderBorder, x, y, 2*width, height, shadowWidth, scalePtr->sliderRelief); x += shadowWidth; y += shadowWidth; width -= shadowWidth; height -= 2*shadowWidth; Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y, width, height, shadowWidth, scalePtr->sliderRelief); Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x+width, y, width, height, shadowWidth, scalePtr->sliderRelief); /* * Draw the label at the top of the scale. */ if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) { Tk_FontMetrics fm; Tk_GetFontMetrics(scalePtr->tkfont, &fm); Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC, scalePtr->tkfont, scalePtr->label, scalePtr->labelLength, scalePtr->inset + fm.ascent/2, scalePtr->horizLabelY + fm.ascent); } } /* *---------------------------------------------------------------------- * * DisplayHorizontalValue -- * * This function is called to display values (scale readings) for * horizontally-oriented scales. * * Results: * None. * * Side effects: * The numerical value corresponding to value is displayed with its * bottom edge at "bottom", and at a horizontal position in the scale * that corresponds to "value". * *---------------------------------------------------------------------- */ static void DisplayHorizontalValue( register TkScale *scalePtr, /* Information about widget in which to * display value. */ Drawable drawable, /* Pixmap or window in which to draw the * value. */ double value, /* X-coordinate of number to display, * specified in application coords, not in * pixels (we'll compute pixels). */ int top) /* Y-coordinate of top edge of text, specified * in pixels. */ { register Tk_Window tkwin = scalePtr->tkwin; int x, y, length, width; char valueString[TCL_DOUBLE_SPACE]; Tk_FontMetrics fm; x = TkScaleValueToPixel(scalePtr, value); Tk_GetFontMetrics(scalePtr->tkfont, &fm); y = top + fm.ascent; sprintf(valueString, scalePtr->format, value); length = (int) strlen(valueString); width = Tk_TextWidth(scalePtr->tkfont, valueString, length); /* * Adjust the x-coordinate if necessary to keep the text entirely inside * the window. */ x -= (width)/2; if (x < (scalePtr->inset + SPACING)) { x = scalePtr->inset + SPACING; } /* * Check the right border so use starting point +text width for the check. */ if (x + width >= (Tk_Width(tkwin) - scalePtr->inset)) { x = Tk_Width(tkwin) - scalePtr->inset - SPACING - width; } Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC, scalePtr->tkfont, valueString, length, x, y); } /* *---------------------------------------------------------------------- * * TkpDisplayScale -- * * This function is invoked as an idle handler to redisplay the contents * of a scale widget. * * Results: * None. * * Side effects: * The scale gets redisplayed. * *---------------------------------------------------------------------- */ void TkpDisplayScale( ClientData clientData) /* Widget record for scale. */ { TkScale *scalePtr = (TkScale *) clientData; Tk_Window tkwin = scalePtr->tkwin; Tcl_Interp *interp = scalePtr->interp; Pixmap pixmap; int result; char string[TCL_DOUBLE_SPACE]; XRectangle drawnArea; scalePtr->flags &= ~REDRAW_PENDING; if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) { goto done; } /* * Invoke the scale's command if needed. */ Tcl_Preserve((ClientData) scalePtr); if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) { Tcl_Preserve((ClientData) interp); sprintf(string, scalePtr->format, scalePtr->value); result = Tcl_VarEval(interp, scalePtr->command, " ", string, (char *) NULL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command executed by scale)"); Tcl_BackgroundError(interp); } Tcl_Release((ClientData) interp); } scalePtr->flags &= ~INVOKE_COMMAND; if (scalePtr->flags & SCALE_DELETED) { Tcl_Release((ClientData) scalePtr); return; } Tcl_Release((ClientData) scalePtr); #ifndef TK_NO_DOUBLE_BUFFERING /* * In order to avoid screen flashes, this function redraws the scale in a * pixmap, then copies the pixmap to the screen in a single operation. * This means that there's no point in time where the on-sreen image has * been cleared. */ pixmap = Tk_GetPixmap(scalePtr->display, Tk_WindowId(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); #else pixmap = Tk_WindowId(tkwin); #endif /* TK_NO_DOUBLE_BUFFERING */ drawnArea.x = 0; drawnArea.y = 0; drawnArea.width = Tk_Width(tkwin); drawnArea.height = Tk_Height(tkwin); /* * Much of the redisplay is done totally differently for horizontal and * vertical scales. Handle the part that's different. */ if (scalePtr->orient == ORIENT_VERTICAL) { DisplayVerticalScale(scalePtr, pixmap, &drawnArea); } else { DisplayHorizontalScale(scalePtr, pixmap, &drawnArea); } /* * Now handle the part of redisplay that is the same for horizontal and * vertical scales: border and traversal highlight. */ if (scalePtr->flags & REDRAW_OTHER) { if (scalePtr->relief != TK_RELIEF_FLAT) { Tk_Draw3DRectangle(tkwin, pixmap, scalePtr->bgBorder, scalePtr->highlightWidth, scalePtr->highlightWidth, Tk_Width(tkwin) - 2*scalePtr->highlightWidth, Tk_Height(tkwin) - 2*scalePtr->highlightWidth, scalePtr->borderWidth, scalePtr->relief); } if (scalePtr->highlightWidth != 0) { GC gc; if (scalePtr->flags & GOT_FOCUS) { gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap); } else { gc = Tk_GCForColor( Tk_3DBorderColor(scalePtr->highlightBorder), pixmap); } Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap); } } #ifndef TK_NO_DOUBLE_BUFFERING /* * Copy the information from the off-screen pixmap onto the screen, then * delete the pixmap. */ XCopyArea(scalePtr->display, pixmap, Tk_WindowId(tkwin), scalePtr->copyGC, drawnArea.x, drawnArea.y, drawnArea.width, drawnArea.height, drawnArea.x, drawnArea.y); Tk_FreePixmap(scalePtr->display, pixmap); #endif /* TK_NO_DOUBLE_BUFFERING */ done: scalePtr->flags &= ~REDRAW_ALL; } /* *---------------------------------------------------------------------- * * TkpScaleElement -- * * Determine which part of a scale widget lies under a given point. * * Results: * The return value is either TROUGH1, SLIDER, TROUGH2, or OTHER, * depending on which of the scale's active elements (if any) is under * the point at (x,y). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkpScaleElement( TkScale *scalePtr, /* Widget record for scale. */ int x, int y) /* Coordinates within scalePtr's window. */ { int sliderFirst; if (scalePtr->orient == ORIENT_VERTICAL) { if ((x < scalePtr->vertTroughX) || (x >= (scalePtr->vertTroughX + 2*scalePtr->borderWidth + scalePtr->width))) { return OTHER; } if ((y < scalePtr->inset) || (y >= (Tk_Height(scalePtr->tkwin) - scalePtr->inset))) { return OTHER; } sliderFirst = TkScaleValueToPixel(scalePtr, scalePtr->value) - scalePtr->sliderLength/2; if (y < sliderFirst) { return TROUGH1; } if (y < (sliderFirst+scalePtr->sliderLength)) { return SLIDER; } return TROUGH2; } if ((y < scalePtr->horizTroughY) || (y >= (scalePtr->horizTroughY + 2*scalePtr->borderWidth + scalePtr->width))) { return OTHER; } if ((x < scalePtr->inset) || (x >= (Tk_Width(scalePtr->tkwin) - scalePtr->inset))) { return OTHER; } sliderFirst = TkScaleValueToPixel(scalePtr, scalePtr->value) - scalePtr->sliderLength/2; if (x < sliderFirst) { return TROUGH1; } if (x < (sliderFirst+scalePtr->sliderLength)) { return SLIDER; } return TROUGH2; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tk.pc.in0000644003604700454610000000071112656405252013112 0ustar dgp771div# tk pkg-config source file prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ Name: The Tk Toolkit Description: Tk is a cross-platform graphical user interface toolkit, the standard GUI not only for Tcl, but for many other dynamic languages as well. URL: http://www.tcl.tk/ Version: @TK_VERSION@@TK_PATCH_LEVEL@ Requires: tcl >= 8.5 Libs: -L${libdir} @TK_LIB_FLAG@ Libs.private: @XFT_LIBS@ @XLIBSW@ Cflags: -I${includedir} tk8.5.19/unix/configure.in0000775003604700454610000010006212656405252014061 0ustar dgp771div#! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tk installation dnl to configure the system for the local environment. AC_INIT([tk],[8.5]) AC_PREREQ(2.59) dnl This is only used when included from macosx/configure.ac m4_ifdef([SC_USE_CONFIG_HEADERS], [ AC_CONFIG_HEADERS([tkConfig.h:../unix/tkConfig.h.in]) AC_CONFIG_COMMANDS_PRE([DEFS="-DHAVE_TK_CONFIG_H -imacros tkConfig.h"]) AH_TOP([ #ifndef _TKCONFIG #define _TKCONFIG]) AH_BOTTOM([ /* Undef unused package specific autoheader defines so that we can * include both tclConfig.h and tkConfig.h at the same time: */ /* override */ #undef PACKAGE_NAME /* override */ #undef PACKAGE_STRING /* override */ #undef PACKAGE_TARNAME #endif /* _TKCONFIG */]) ]) TK_VERSION=8.5 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=5 TK_PATCH_LEVEL=".19" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" #-------------------------------------------------------------------- # Find and load the tclConfig.sh file #-------------------------------------------------------------------- SC_PATH_TCLCONFIG SC_LOAD_TCLCONFIG if test "${TCL_VERSION}" != "${TK_VERSION}"; then AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) fi SC_PROG_TCLSH SC_BUILD_TCLSH #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix="$TCL_PREFIX" fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # Make sure srcdir is fully qualified! srcdir="`cd "$srcdir" ; pwd`" TK_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ SC_CONFIG_MANPAGES #------------------------------------------------------------------------ # 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 # limits header checks must come early to prevent # an autoconf bug that throws errors on configure AC_CHECK_HEADER(limits.h, [AC_DEFINE(HAVE_LIMITS_H, 1, [Do we have ?])], [AC_DEFINE(NO_LIMITS_H, 1, [Do we have ?])]) #-------------------------------------------------------------------- # Supply a substitute for stdlib.h if it doesn't define strtol, # strtoul, or strtod (which it doesn't in some versions of SunOS). #-------------------------------------------------------------------- AC_CHECK_HEADER(stdlib.h, tk_ok=1, tk_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tk_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tk_ok=0) AC_EGREP_HEADER(strtod, stdlib.h, , tk_ok=0) if test $tk_ok = 0; then AC_DEFINE(NO_STDLIB_H, 1, [Do we have ?]) fi #------------------------------------------------------------------------ # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then AC_CACHE_CHECK([if the compiler understands -pipe], tcl_cv_cc_pipe, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" AC_TRY_COMPILE(,, tcl_cv_cc_pipe=yes, tcl_cv_cc_pipe=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ # Threads support - this auto-enables if Tcl was compiled threaded #------------------------------------------------------------------------ SC_ENABLE_THREADS # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" SC_ENABLE_SHARED #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- SC_CONFIG_CFLAGS SC_ENABLE_SYMBOLS #-------------------------------------------------------------------- # Detect what compiler flags to set for 64-bit support. #-------------------------------------------------------------------- SC_TCL_EARLY_FLAGS SC_TCL_64BIT_FLAGS #-------------------------------------------------------------------- # Check endianness because we can optimize some operations #-------------------------------------------------------------------- AC_C_BIGENDIAN #------------------------------------------------------------------------ # If Tcl and Tk are installed in different places, adjust the library # search path to reflect this. #------------------------------------------------------------------------ LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib" fi if test "$TCL_PREFIX" != "$prefix"; then AC_MSG_WARN([ Different --prefix selected for Tk and Tcl! [[package require Tk]] may not work correctly in tclsh.]) fi #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things # that appear to be useful and aren't already in sys/types.h. # This appears to be true only on the RS/6000 under AIX. Some # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- AC_CACHE_CHECK([for fd_set in sys/types], tcl_cv_type_fd_set, [ AC_TRY_COMPILE([#include ],[fd_set readMask, writeMask;], tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no)]) tk_ok=$tcl_cv_type_fd_set if test $tk_ok = no; then AC_CACHE_CHECK([for fd_mask in sys/select], tcl_cv_grep_fd_mask, [ AC_EGREP_HEADER(fd_mask, sys/select.h, tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)]) if test $tcl_cv_grep_fd_mask = present; then AC_DEFINE(HAVE_SYS_SELECT_H, 1, [Should we include ?]) tk_ok=yes fi fi if test $tk_ok = no; then AC_DEFINE(NO_FD_SET, 1, [Do we have fd_set?]) fi #------------------------------------------------------------------------------ # Find out all about time handling differences. #------------------------------------------------------------------------------ AC_CHECK_HEADERS(sys/time.h) AC_HEADER_TIME #-------------------------------------------------------------------- # Under Solaris 2.4, strtod returns the wrong value for the # terminating character under some conditions. Check for this # and if the problem exists use a substitute procedure # "fixstrtod" (provided by Tcl) that corrects the error. #-------------------------------------------------------------------- SC_BUGGY_STRTOD #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- AC_TYPE_MODE_T AC_TYPE_PID_T AC_TYPE_SIZE_T AC_TYPE_UID_T AC_CHECK_TYPE([intptr_t], [ AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [ for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) if test "$tcl_cv_intptr_t" != none; then AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer type wide enough to hold a pointer.]) fi ]) AC_CHECK_TYPE([uintptr_t], [ AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [ AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [ for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ none; do if test "$tcl_cv_uintptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) if test "$tcl_cv_uintptr_t" != none; then AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer type wide enough to hold a pointer.]) fi ]) #------------------------------------------- # In OS/390 struct pwd has no pw_gecos field #------------------------------------------- AC_CACHE_CHECK([pw_gecos in struct pwd], tcl_cv_pwd_pw_gecos, [ AC_TRY_COMPILE([#include ], [struct passwd pwd; pwd.pw_gecos;], tcl_cv_pwd_pw_gecos=yes, tcl_cv_pwd_pw_gecos=no)]) if test $tcl_cv_pwd_pw_gecos = yes; then AC_DEFINE(HAVE_PW_GECOS, 1, [Does struct password have a pw_gecos field?]) fi #-------------------------------------------------------------------- # On Mac OS X, we can build either with X11 or with Aqua #-------------------------------------------------------------------- if test "`uname -s`" = "Darwin" ; then AC_MSG_CHECKING([whether to use Aqua]) AC_ARG_ENABLE(aqua, AC_HELP_STRING([--enable-aqua=yes|no], [use Aqua windowingsystem on Mac OS X (default: no)]), [tk_aqua=$enableval], [tk_aqua=no]) if test $tk_aqua = yes -o $tk_aqua = cocoa; then tk_aqua=yes if test $tcl_corefoundation = no; then AC_MSG_WARN([Aqua can only be used when CoreFoundation is available]) tk_aqua=no fi if test ! -d /System/Library/Frameworks/Cocoa.framework; then AC_MSG_WARN([Aqua can only be used when Cocoa is available]) tk_aqua=no fi if test "`uname -r | awk -F. '{print [$]1}'`" -lt 9; then AC_MSG_WARN([Aqua requires Mac OS X 10.5 or later]) tk_aqua=no fi fi AC_MSG_RESULT([$tk_aqua]) if test "$fat_32_64" = yes; then if test $tk_aqua = no; then AC_CACHE_CHECK([for 64-bit X11], tcl_cv_lib_x11_64, [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done CPPFLAGS="$CPPFLAGS -I/usr/X11R6/include" LDFLAGS="$LDFLAGS -L/usr/X11R6/lib -lX11" AC_TRY_LINK([#include ], [XrmInitialize();], tcl_cv_lib_x11_64=yes, tcl_cv_lib_x11_64=no) for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) fi # remove 64-bit arch flags from CFLAGS et al. for combined 32 & 64 bit # fat builds if configuration does not support 64-bit. if test "$tcl_cv_lib_x11_64" = no; then AC_MSG_NOTICE([Removing 64-bit architectures from compiler & linker flags]) for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi fi if test $tk_aqua = no; then # check if weak linking whole libraries is possible. AC_CACHE_CHECK([if ld accepts -weak-l flag], tcl_cv_ld_weak_l, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-weak-lm" AC_TRY_LINK([#include ], [double f = sin(1.0);], tcl_cv_ld_weak_l=yes, tcl_cv_ld_weak_l=no) LDFLAGS=$hold_ldflags]) fi AC_CHECK_HEADERS(AvailabilityMacros.h) if test "$ac_cv_header_AvailabilityMacros_h" = yes; then AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_TRY_LINK([ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); ], [rand();], tcl_cv_cc_weak_import=yes, tcl_cv_cc_weak_import=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_weak_import = yes; then AC_DEFINE(HAVE_WEAK_IMPORT, 1, [Is weak import available?]) fi AC_CACHE_CHECK([if Darwin SUSv3 extensions are available], tcl_cv_cc_darwin_c_source, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_TRY_COMPILE([ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050 #endif #define _DARWIN_C_SOURCE 1 #include ],,tcl_cv_cc_darwin_c_source=yes, tcl_cv_cc_darwin_c_source=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_darwin_c_source = yes; then AC_DEFINE(_DARWIN_C_SOURCE, 1, [Are Darwin SUSv3 extensions available?]) fi fi else tk_aqua=no fi if test $tk_aqua = yes; then AC_DEFINE(MAC_OSX_TK, 1, [Are we building TkAqua?]) LIBS="$LIBS -framework Cocoa -framework Carbon -framework IOKit" EXTRA_CC_SWITCHES='-std=gnu99 -x objective-c' TK_WINDOWINGSYSTEM=AQUA if test -n "${enable_symbols}" -a "${enable_symbols}" != no; then AC_DEFINE(TK_MAC_DEBUG, 1, [Are TkAqua debug messages enabled?]) fi else #-------------------------------------------------------------------- # Locate the X11 header files and the X11 library archive. Try # the ac_path_x macro first, but if it doesn't find the X stuff # (e.g. because there's no xmkmf program) then check through # a list of possible directories. Under some conditions the # autoconf macro will return an include directory that contains # no include files, so double-check its result just to be safe. #-------------------------------------------------------------------- SC_PATH_X TK_WINDOWINGSYSTEM=X11 fi #-------------------------------------------------------------------- # Various manipulations on the search path used at runtime to # find shared libraries: # 1. If the X library binaries are in a non-standard directory, # add the X library location into that search path. # 2. On systems such as AIX and Ultrix that use "-L" as the # search path option, colons cannot be used to separate # directories from each other. Change colons to " -L". # 3. Create two sets of search flags, one for use in cc lines # and the other for when the linker is invoked directly. In # the second case, '-Wl,' must be stripped off and commas must # be replaced by spaces. #-------------------------------------------------------------------- if test "x${x_libraries}" != "x"; then if test "x${x_libraries}" != "xNONE"; then LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${x_libraries}" fi fi if test "${TCL_LD_SEARCH_FLAGS}" = '-L${LIB_RUNTIME_DIR}'; then LIB_RUNTIME_DIR=`echo ${LIB_RUNTIME_DIR} |sed -e 's/:/ -L/g'` fi #-------------------------------------------------------------------- # Check for the existence of various libraries. The order here # is important, so that then end up in the right order in the # command line generated by make. The -lsocket and -lnsl libraries # require a couple of special tricks: # 1. Use "connect" and "accept" to check for -lsocket, and # "gethostbyname" to check for -lnsl. # 2. Use each function name only once: can't redo a check because # autoconf caches the results of the last check and won't redo it. # 3. Use -lnsl and -lsocket only if they supply procedures that # aren't already present in the normal libraries. This is because # IRIX 5.2 has libraries, but they aren't needed and they're # bogus: they goof up name resolution if used. # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. # To get around this problem, check for both libraries together # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- if test $tk_aqua = no; then AC_CHECK_LIB(Xbsd, main, [LIBS="$LIBS -lXbsd"]) fi #-------------------------------------------------------------------- # One more check related to the X libraries. The standard releases # of Ultrix don't support the "xauth" mechanism, so send won't work # unless TK_NO_SECURITY is defined. However, there are usually copies # of the MIT X server available as well, which do support xauth. # Check for the MIT stuff and use it if it exists. # # Note: can't use ac_check_lib macro (at least, not in Autoconf 2.1) # because it can't deal with the "-" in the library name. #-------------------------------------------------------------------- if test -d /usr/include/mit -a $tk_aqua = no; then AC_MSG_CHECKING([MIT X libraries]) tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS -I/usr/include/mit" tk_oldLibs=$LIBS LIBS="$LIBS -lX11-mit" AC_TRY_LINK([ #include ], [ XOpenDisplay(0); ], [ AC_MSG_RESULT([yes]) XLIBSW="-lX11-mit" XINCLUDES="-I/usr/include/mit" ], AC_MSG_RESULT([no])) CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi #-------------------------------------------------------------------- # Check for freetype / fontconfig / Xft support. #-------------------------------------------------------------------- if test $tk_aqua = no; then AC_MSG_CHECKING([whether to use xft]) AC_ARG_ENABLE(xft, AC_HELP_STRING([--enable-xft], [use freetype/fontconfig/xft (default: on)]), [enable_xft=$enableval], [enable_xft="default"]) XFT_CFLAGS="" XFT_LIBS="" if test "$enable_xft" = "no" ; then AC_MSG_RESULT([$enable_xft]) else found_xft="yes" dnl make sure package configurator (xft-config or pkg-config dnl says that xft is present. XFT_CFLAGS=`xft-config --cflags 2>/dev/null` || found_xft="no" XFT_LIBS=`xft-config --libs 2>/dev/null` || found_xft="no" if test "$found_xft" = "no" ; then found_xft=yes XFT_CFLAGS=`pkg-config --cflags xft 2>/dev/null` || found_xft="no" XFT_LIBS=`pkg-config --libs xft 2>/dev/null` || found_xft="no" fi AC_MSG_RESULT([$found_xft]) dnl make sure that compiling against Xft header file doesn't bomb if test "$found_xft" = "yes" ; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" tk_oldLibs=$LIBS LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" AC_CHECK_HEADER(X11/Xft/Xft.h, [], [ found_xft=no ],[#include ]) CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi dnl make sure that linking against Xft libraries finds freetype if test "$found_xft" = "yes" ; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" tk_oldLibs=$LIBS LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" AC_CHECK_LIB(Xft, XftFontOpen, [], [ found_xft=no ]) CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi dnl make sure that linking against fontconfig libraries finds Fc* symbols if test "$found_xft" = "yes" ; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" tk_oldLibs=$LIBS LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW -lfontconfig" AC_CHECK_LIB(fontconfig, FcFontSort, [ XFT_LIBS="$XFT_LIBS -lfontconfig" ], []) CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi dnl print a warning if xft is unusable and was specifically requested if test "$found_xft" = "no" ; then if test "$enable_xft" = "yes" ; then AC_MSG_WARN([Can't find xft configuration, or xft is unusable]) fi enable_xft=no XFT_CFLAGS="" XFT_LIBS="" else enable_xft=yes fi fi if test $enable_xft = "yes" ; then UNIX_FONT_OBJS=tkUnixRFont.o AC_DEFINE(HAVE_XFT, 1, [Have we turned on XFT (antialiased fonts)?]) else UNIX_FONT_OBJS=tkUnixFont.o fi AC_SUBST(XFT_CFLAGS) AC_SUBST(XFT_LIBS) AC_SUBST(UNIX_FONT_OBJS) fi #-------------------------------------------------------------------- # Check for XkbKeycodeToKeysym. #-------------------------------------------------------------------- if test $tk_aqua = no; then tk_oldCFlags=$CFLAGS tk_oldLibs=$LIBS CFLAGS="$CFLAGS $XINCLUDES" LIBS="$LIBS $XLIBSW" AC_CHECK_HEADER(X11/XKBlib.h, [ xkblib_header_found=yes ], [ xkblib_header_found=no ], [#include ]) if test $xkblib_header_found = "yes" ; then AC_CHECK_LIB(X11, XkbKeycodeToKeysym, [ xkbkeycodetokeysym_found=yes ], [ xkbkeycodetokeysym_found=no ]) else xkbkeycodetokeysym_found=no fi if test $xkbkeycodetokeysym_found = "yes" ; then AC_DEFINE(HAVE_XKBKEYCODETOKEYSYM, 1, [Do we have XkbKeycodeToKeysym?]) fi CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi #-------------------------------------------------------------------- # XXX Do this last. # It might modify XLIBSW which could affect other tests. # # Check whether the header and library for the XScreenSaver # extension are available, and set HAVE_XSS if so. # XScreenSaver is needed for Tk_GetUserInactiveTime(). #-------------------------------------------------------------------- if test $tk_aqua = no; then tk_oldCFlags=$CFLAGS CFLAGS="$CFLAGS $XINCLUDES" tk_oldLibs=$LIBS LIBS="$tk_oldLibs $XLIBSW" xss_header_found=no xss_lib_found=no AC_MSG_CHECKING([whether to try to use XScreenSaver]) AC_ARG_ENABLE(xss, AC_HELP_STRING([--enable-xss], [use XScreenSaver for activity timer (default: on)]), [enable_xss=$enableval], [enable_xss=yes]) if test "$enable_xss" = "no" ; then AC_MSG_RESULT([$enable_xss]) else AC_MSG_RESULT([$enable_xss]) AC_CHECK_HEADER(X11/extensions/scrnsaver.h, [ xss_header_found=yes ],,[#include ]) AC_CHECK_FUNC(XScreenSaverQueryInfo,,[ AC_CHECK_LIB(Xext, XScreenSaverQueryInfo, [ XLIBSW="$XLIBSW -lXext" xss_lib_found=yes ], [ AC_CHECK_LIB(Xss, XScreenSaverQueryInfo, [ if test "$tcl_cv_ld_weak_l" = yes; then # On Darwin, weak link libXss if possible, # as it is only available on Tiger or later. XLIBSW="$XLIBSW -Wl,-weak-lXss -lXext" else XLIBSW="$XLIBSW -lXss -lXext" fi xss_lib_found=yes ],, -lXext) ]) ]) fi if test $enable_xss = yes -a $xss_lib_found = yes -a $xss_header_found = yes; then AC_DEFINE(HAVE_XSS, 1, [Is XScreenSaver available?]) fi CFLAGS=$tk_oldCFlags LIBS=$tk_oldLibs fi #-------------------------------------------------------------------- # Figure out whether "char" is unsigned. If so, set a # #define for __CHAR_UNSIGNED__. #-------------------------------------------------------------------- AC_C_CHAR_UNSIGNED #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtk as a shared library instead of a static library. #-------------------------------------------------------------------- eval eval "TK_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}" eval eval "TK_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}" eval "TK_LIB_FILE=libtk${LIB_SUFFIX}" # tkConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed # since on some platforms TK_LIB_FILE contains shell escapes. eval "TK_LIB_FILE=${TK_LIB_FILE}" if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \${TCL_STUB_LIB_SPEC}" TCL_STUB_FLAGS="-DUSE_TCL_STUBS" fi TK_LIBRARY='$(prefix)/lib/tk$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' TK_PKG_DIR='tk$(VERSION)' TK_RSRC_FILE='tk$(VERSION).rsrc' WISH_RSRC_FILE='wish$(VERSION).rsrc' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then SC_ENABLE_FRAMEWORK TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version ${TK_VERSION}`echo ${TK_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`" TK_SHLIB_LD_EXTRAS="${TK_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}/${TK_LIB_FILE}" -unexported_symbols_list $$(f=$(TK_LIB_FILE).E && nm -gp tkMacOSX*.o 2>/dev/null | awk "/^[[0-9a-f]]+ . \.objc/ {print \$$3}" > $$f && nm -gjp "$(TCL_BIN_DIR)"/$(TCL_STUB_LIB_FILE) | grep ^_[[^_]] >> $$f && echo $$f)' echo "$LDFLAGS " | grep -q -- '-prebind ' && TK_SHLIB_LD_EXTRAS="${TK_SHLIB_LD_EXTRAS}"' -seg1addr 0xb000000' TK_SHLIB_LD_EXTRAS="${TK_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tk-Info.plist' EXTRA_WISH_LIBS='-sectcreate __TEXT __info_plist Wish-Info.plist' EXTRA_APP_CC_SWITCHES="${EXTRA_APP_CC_SWITCHES}"' -mdynamic-no-pic' AC_CONFIG_FILES([Tk-Info.plist:../macosx/Tk-Info.plist.in Wish-Info.plist:../macosx/Wish-Info.plist.in]) for l in ${LOCALES}; do CFBUNDLELOCALIZATIONS="${CFBUNDLELOCALIZATIONS}$l"; done TK_YEAR="`date +%Y`" fi if test "$FRAMEWORK_BUILD" = "1" ; then AC_DEFINE(TK_FRAMEWORK, 1, [Is Tk built as a framework?]) # Construct a fake local framework structure to make linking with # '-framework Tk' and running of tktest work AC_CONFIG_COMMANDS([Tk.framework], [n=Tk && f=$n.framework && v=Versions/$VERSION && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && if test $tk_aqua = yes; then ln -s ../../../../$n.rsrc $f/$v/Resources; fi && unset n f v ], VERSION=${TK_VERSION} && tk_aqua=${tk_aqua}) LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" if test "${libdir}" = '${exec_prefix}/lib'; then # override libdir default libdir="/Library/Frameworks" fi TK_LIB_FILE="Tk" TK_LIB_FLAG="-framework Tk" TK_BUILD_LIB_SPEC="-F`pwd | sed -e 's/ /\\\\ /g'` -framework Tk" TK_LIB_SPEC="-F${libdir} -framework Tk" libdir="${libdir}/Tk.framework/Versions/\${VERSION}" TK_LIBRARY="${libdir}/Resources/Scripts" TK_PKG_DIR="Resources/Scripts" TK_RSRC_FILE="Tk.rsrc" WISH_RSRC_FILE="Wish.rsrc" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tk" EXTRA_INSTALL="install-private-headers html-tk" EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TkTOC.html' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tk-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' if test $tk_aqua = yes; then EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Images to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)/Resources"; done' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing wish$(VERSION) script to $(INSTALL_ROOT)/'"${bindir}"'" && mkdir -p "$(INSTALL_ROOT)/'"${bindir}"'" && printf > "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)" "#!/bin/sh\n\"\$$(dirname \$$0)'"`eval d="${bindir}"; echo "$d" | sed -e 's#/[^/][^/]*#/..#g'`"'$(bindir)/Wish\" \"\$$@\"" && chmod +x "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)"' bindir="${libdir}/Resources/Wish.app/Contents/MacOS" EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Info.plist to $(BIN_INSTALL_DIR)/.." && $(INSTALL_DATA) Wish-Info.plist "$(BIN_INSTALL_DIR)/../Info.plist" && mv -f "$(BIN_INSTALL_DIR)/wish$(VERSION)" "$(BIN_INSTALL_DIR)/Wish"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.icns to $(BIN_INSTALL_DIR)/../Resources" && mkdir -p "$(BIN_INSTALL_DIR)/../Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Tk.icns" "$(BIN_INSTALL_DIR)/../Resources/Wish.icns"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.sdef to $(BIN_INSTALL_DIR)/../Resources" && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Wish.sdef" "$(BIN_INSTALL_DIR)/../Resources"' fi EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tk.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tkConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we # can pick up a potential make override of VERSION. Also, don't put this # into CFLAGS as it should not go into tkConfig.sh EXTRA_CC_SWITCHES="$EXTRA_CC_SWITCHES"' -DTK_FRAMEWORK_VERSION=\"$(VERSION)\"' else if test $tk_aqua = yes; then EXTRA_INSTALL_BINARIES='@echo "Installing Images to $(LIB_INSTALL_DIR)/" && mkdir -p "$(LIB_INSTALL_DIR)" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)"; done' fi # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" if test "${ac_cv_cygwin}" = "yes" -a "$SHARED_BUILD" = "1"; then TK_LIB_FLAG="-ltk`echo ${TK_VERSION} | tr -d .`" TK_BUILD_LIB_SPEC="-L\$(TOP_DIR)/win ${TK_LIB_FLAG}" else if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TK_LIB_FLAG="-ltk${TK_VERSION}" else TK_LIB_FLAG="-ltk`echo ${TK_VERSION} | tr -d .`" fi TK_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TK_LIB_FLAG}" fi TK_LIB_SPEC="-L${libdir} ${TK_LIB_FLAG}" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tk # stub support. #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TK_VERSION} eval "TK_STUB_LIB_FILE=libtkstub${TK_UNSHARED_LIB_SUFFIX}" eval "TK_STUB_LIB_DIR=${libdir}" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}" else TK_STUB_LIB_FLAG="-ltkstub`echo ${TK_VERSION} | tr -d .`" fi TK_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_SPEC="-L${TK_STUB_LIB_DIR} ${TK_STUB_LIB_FLAG}" TK_BUILD_STUB_LIB_PATH="`pwd`/${TK_STUB_LIB_FILE}" TK_STUB_LIB_PATH="${TK_STUB_LIB_DIR}/${TK_STUB_LIB_FILE}" # Install time header dir can be set via --includedir eval "TK_INCLUDE_SPEC=\"-I${includedir}\"" #------------------------------------------------------------------------ # tkConfig.sh refers to this by a different name #------------------------------------------------------------------------ TK_SHARED_BUILD=${SHARED_BUILD} AC_SUBST(TK_VERSION) AC_SUBST(TK_MAJOR_VERSION) AC_SUBST(TK_MINOR_VERSION) AC_SUBST(TK_PATCH_LEVEL) AC_SUBST(TK_YEAR) AC_SUBST(TK_LIB_FILE) AC_SUBST(TK_LIB_FLAG) AC_SUBST(TK_LIB_SPEC) AC_SUBST(TK_STUB_LIB_FILE) AC_SUBST(TK_STUB_LIB_FLAG) AC_SUBST(TK_STUB_LIB_SPEC) AC_SUBST(TK_STUB_LIB_PATH) AC_SUBST(TK_INCLUDE_SPEC) AC_SUBST(TK_BUILD_STUB_LIB_SPEC) AC_SUBST(TK_BUILD_STUB_LIB_PATH) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_SHARED_BUILD) AC_SUBST(LD_LIBRARY_PATH_VAR) AC_SUBST(TK_BUILD_LIB_SPEC) AC_SUBST(TCL_STUB_FLAGS) AC_SUBST(XINCLUDES) AC_SUBST(XLIBSW) AC_SUBST(LOCALES) AC_SUBST(TK_WINDOWINGSYSTEM) AC_SUBST(TK_PKG_DIR) AC_SUBST(TK_LIBRARY) AC_SUBST(LIB_RUNTIME_DIR) AC_SUBST(PRIVATE_INCLUDE_DIR) AC_SUBST(HTML_DIR) AC_SUBST(EXTRA_CC_SWITCHES) AC_SUBST(EXTRA_APP_CC_SWITCHES) AC_SUBST(EXTRA_INSTALL) AC_SUBST(EXTRA_INSTALL_BINARIES) AC_SUBST(EXTRA_BUILD_HTML) AC_SUBST(EXTRA_WISH_LIBS) AC_SUBST(CFBUNDLELOCALIZATIONS) AC_SUBST(TK_RSRC_FILE) AC_SUBST(WISH_RSRC_FILE) AC_SUBST(LIB_RSRC_FILE) AC_SUBST(APP_RSRC_FILE) AC_SUBST(REZ) AC_SUBST(REZ_FLAGS) AC_CONFIG_FILES([ Makefile:../unix/Makefile.in tkConfig.sh:../unix/tkConfig.sh.in tk.pc:../unix/tk.pc.in ]) AC_OUTPUT dnl Local Variables: dnl mode: autoconf dnl End: tk8.5.19/unix/tkUnixXId.c0000644003604700454610000004051212627134671013603 0ustar dgp771div/* * tkUnixXId.c -- * * This file provides a replacement function for the default X resource * allocator (_XAllocID). The problem with the default allocator is that * it never re-uses ids, which causes long-lived applications to crash * when X resource identifiers wrap around. The replacement functions in * this file re-use old identifiers to prevent this problem. * * The code in this file is based on similar implementations by * George C. Kaplan and Michael Hoegeman. * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * The definition below is needed on some systems so that we can access the * resource_alloc field of Display structures in order to replace the resource * allocator. */ #define XLIB_ILLEGAL_ACCESS 1 #include "tkUnixInt.h" /* * A structure of the following type is used to hold one or more available * resource identifiers. There is a list of these structures for each display. */ #define IDS_PER_STACK 10 typedef struct TkIdStack { XID ids[IDS_PER_STACK]; /* Array of free identifiers. */ int numUsed; /* Indicates how many of the entries in ids * are currently in use. */ TkDisplay *dispPtr; /* Display to which ids belong. */ struct TkIdStack *nextPtr; /* Next bunch of free identifiers for the same * display. */ } TkIdStack; /* * Forward declarations for functions defined in this file: */ static XID AllocXId(Display *display); static Tk_RestrictAction CheckRestrictProc(ClientData clientData, XEvent *eventPtr); static void WindowIdCleanup(ClientData clientData); static void WindowIdCleanup2(ClientData clientData); /* *---------------------------------------------------------------------- * * TkInitXId -- * * This function is called to initialize the id allocator for a given * display. * * Results: * None. * * Side effects: * The official allocator for the display is set up to be AllocXId. * *---------------------------------------------------------------------- */ void TkInitXId( TkDisplay *dispPtr) /* Tk's information about the display. */ { dispPtr->idStackPtr = NULL; dispPtr->defaultAllocProc = (XID (*) (Display *display)) dispPtr->display->resource_alloc; dispPtr->display->resource_alloc = AllocXId; dispPtr->windowStackPtr = NULL; dispPtr->idCleanupScheduled = (Tcl_TimerToken) 0; } /* *---------------------------------------------------------------------- * * TkFreeXId -- * * This function is called to free resources for the id allocator for a * given display. * * Results: * None. * * Side effects: * Frees the id and window stack pools. * *---------------------------------------------------------------------- */ void TkFreeXId( TkDisplay *dispPtr) /* Tk's information about the display. */ { TkIdStack *stackPtr, *freePtr; if (dispPtr->idCleanupScheduled) { Tcl_DeleteTimerHandler(dispPtr->idCleanupScheduled); } for (stackPtr = dispPtr->idStackPtr; stackPtr != NULL; ) { freePtr = stackPtr; stackPtr = stackPtr->nextPtr; ckfree((char *) freePtr); } dispPtr->idStackPtr = NULL; for (stackPtr = dispPtr->windowStackPtr; stackPtr != NULL; ) { freePtr = stackPtr; stackPtr = stackPtr->nextPtr; ckfree((char *) freePtr); } dispPtr->windowStackPtr = NULL; } /* *---------------------------------------------------------------------- * * AllocXId -- * * This function is invoked by Xlib as the resource allocator for a * display. * * Results: * The return value is an X resource identifier that isn't currently in * use. * * Side effects: * The identifier is removed from the stack of free identifiers, if it * was previously on the stack. * *---------------------------------------------------------------------- */ static XID AllocXId( Display *display) /* Display for which to allocate. */ { TkDisplay *dispPtr; TkIdStack *stackPtr; /* * Find Tk's information about the display. */ dispPtr = TkGetDisplay(display); /* * If the topmost chunk on the stack is empty then free it. Then check for * a free id on the stack and return it if it exists. */ stackPtr = dispPtr->idStackPtr; if (stackPtr != NULL) { while (stackPtr->numUsed == 0) { dispPtr->idStackPtr = stackPtr->nextPtr; ckfree((char *) stackPtr); stackPtr = dispPtr->idStackPtr; if (stackPtr == NULL) { goto defAlloc; } } stackPtr->numUsed--; return stackPtr->ids[stackPtr->numUsed]; } /* * No free ids in the stack: just get one from the default allocator. */ defAlloc: return (*dispPtr->defaultAllocProc)(display); } /* *---------------------------------------------------------------------- * * Tk_FreeXId -- * * This function is called to indicate that an X resource identifier is * now free. * * Results: * None. * * Side effects: * The identifier is added to the stack of free identifiers for its * display, so that it can be re-used. * *---------------------------------------------------------------------- */ void Tk_FreeXId( Display *display, /* Display for which xid was allocated. */ XID xid) /* Identifier that is no longer in use. */ { TkDisplay *dispPtr; TkIdStack *stackPtr; /* * Find Tk's information about the display. */ dispPtr = TkGetDisplay(display); /* * Add a new chunk to the stack if the current chunk is full. */ stackPtr = dispPtr->idStackPtr; if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) { stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack)); stackPtr->numUsed = 0; stackPtr->dispPtr = dispPtr; stackPtr->nextPtr = dispPtr->idStackPtr; dispPtr->idStackPtr = stackPtr; } /* * Add the id to the current chunk. */ stackPtr->ids[stackPtr->numUsed] = xid; stackPtr->numUsed++; } /* *---------------------------------------------------------------------- * * TkFreeWindowId -- * * This function is invoked instead of TkFreeXId for window ids. See * below for the reason why. * * Results: * None. * * Side effects: * The id given by w will eventually be freed, so that it can be reused * for other resources. * * Design: * Freeing window ids is very tricky because there could still be events * pending for a window in the event queue (or even in the server) at the * time the window is destroyed. If the window id were to get reused * immediately for another window, old events could "drop in" on the new * window, causing unexpected behavior. * * Thus we have to wait to re-use a window id until we know that there * are no events left for it. Right now this is done in two steps. First, * we wait until we know that the server has seen the XDestroyWindow * request, so we can be sure that it won't generate more events for the * window and that any existing events are in our queue. Second, we make * sure that there are no events whatsoever in our queue (this is * conservative but safe). * * The first step is done by remembering the request id of the * XDestroyWindow request and using LastKnownRequestProcessed to see what * events the server has processed. If multiple windows get destroyed at * about the same time, we just remember the most recent request number * for any of them (again, conservative but safe). * * There are a few other complications as well. When Tk destroys a * sub-tree of windows, it only issues a single XDestroyWindow call, at * the very end for the root of the subtree. We can't free any of the * window ids until the final XDestroyWindow call. To make sure that this * happens, we have to keep track of deletions in progress, hence the * need for the "destroyCount" field of the display. * * One final problem. Some servers, like Sun X11/News servers still seem * to have problems with ids getting reused too quickly. I'm not * completely sure why this is a problem, but delaying the recycling of * ids appears to eliminate it. Therefore, we wait an additional few * seconds, even after "the coast is clear" before reusing the ids. * *---------------------------------------------------------------------- */ void TkFreeWindowId( TkDisplay *dispPtr, /* Display that w belongs to. */ Window w) /* X identifier for window on dispPtr. */ { TkIdStack *stackPtr; /* * Put the window id on a separate stack of window ids, rather than the * main stack, so it won't get reused right away. Add a new chunk to the * stack if the current chunk is full. */ stackPtr = dispPtr->windowStackPtr; if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) { stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack)); stackPtr->numUsed = 0; stackPtr->dispPtr = dispPtr; stackPtr->nextPtr = dispPtr->windowStackPtr; dispPtr->windowStackPtr = stackPtr; } /* * Add the id to the current chunk. */ stackPtr->ids[stackPtr->numUsed] = w; stackPtr->numUsed++; /* * Schedule a call to WindowIdCleanup if one isn't already scheduled. */ if (!dispPtr->idCleanupScheduled) { dispPtr->idCleanupScheduled = Tcl_CreateTimerHandler(100, WindowIdCleanup, (ClientData) dispPtr); } } /* *---------------------------------------------------------------------- * * WindowIdCleanup -- * * See if we can now free up all the accumulated ids of deleted windows. * * Results: * None. * * Side effects: * If it's safe to move the window ids back to the main free list, we * schedule this to happen after a few mores seconds of delay. If it's * not safe to move them yet, a timer handler gets invoked to try again * later. * *---------------------------------------------------------------------- */ static void WindowIdCleanup( ClientData clientData) /* Pointer to TkDisplay for display */ { TkDisplay *dispPtr = (TkDisplay *) clientData; int anyEvents, delta; Tk_RestrictProc *oldProc; ClientData oldData; static Tcl_Time timeout = {0, 0}; dispPtr->idCleanupScheduled = (Tcl_TimerToken) 0; /* * See if it's safe to recycle the window ids. It's safe if: * (a) no deletions are in progress. * (b) the server has seen all of the requests up to the last * XDestroyWindow request. * (c) there are no events in the event queue; the only way to test for * this right now is to create a restrict proc that will filter the * events, then call Tcl_DoOneEvent to see if the function gets * invoked. */ if (dispPtr->destroyCount > 0) { goto tryAgain; } delta = LastKnownRequestProcessed(dispPtr->display) - dispPtr->lastDestroyRequest; if (delta < 0) { XSync(dispPtr->display, False); } anyEvents = 0; oldProc = Tk_RestrictEvents(CheckRestrictProc, (ClientData) &anyEvents, &oldData); TkUnixDoOneXEvent(&timeout); Tk_RestrictEvents(oldProc, oldData, &oldData); if (anyEvents) { goto tryAgain; } /* * These ids look safe to recycle, but we still need to delay a bit more * (see comments for TkFreeWindowId). Schedule the final freeing. */ if (dispPtr->windowStackPtr != NULL) { Tcl_CreateTimerHandler(5000, WindowIdCleanup2, (ClientData) dispPtr->windowStackPtr); dispPtr->windowStackPtr = NULL; } return; /* * It's still not safe to free up the ids. Try again a bit later. */ tryAgain: dispPtr->idCleanupScheduled = Tcl_CreateTimerHandler(500, WindowIdCleanup, (ClientData) dispPtr); } /* *---------------------------------------------------------------------- * * WindowIdCleanup2 -- * * This function is the last one in the chain that recycles window ids. * It takes all of the ids indicated by its argument and adds them back * to the main id free list. * * Results: * None. * * Side effects: * Window ids get added to the main free list for their display. * *---------------------------------------------------------------------- */ static void WindowIdCleanup2( ClientData clientData) /* Pointer to TkIdStack list. */ { TkIdStack *stackPtr = (TkIdStack *) clientData; TkIdStack *lastPtr; lastPtr = stackPtr; while (lastPtr->nextPtr != NULL) { lastPtr = lastPtr->nextPtr; } lastPtr->nextPtr = stackPtr->dispPtr->idStackPtr; stackPtr->dispPtr->idStackPtr = stackPtr; } /* *---------------------------------------------------------------------- * * CheckRestrictProc -- * * This function is a restrict function, called by Tcl_DoOneEvent to * filter X events. All it does is to set a flag to indicate that there * are X events present. * * Results: * Sets the integer pointed to by the argument, then returns * TK_DEFER_EVENT. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tk_RestrictAction CheckRestrictProc( ClientData clientData, /* Pointer to flag to set. */ XEvent *eventPtr) /* Event to filter; not used. */ { int *flag = (int *) clientData; *flag = 1; return TK_DEFER_EVENT; } /* *---------------------------------------------------------------------- * * Tk_GetPixmap -- * * Same as the XCreatePixmap function except that it manages resource * identifiers better. * * Results: * Returns a new pixmap. * * Side effects: * None. * *---------------------------------------------------------------------- */ Pixmap Tk_GetPixmap( Display *display, /* Display for new pixmap. */ Drawable d, /* Drawable where pixmap will be used. */ int width, int height, /* Dimensions of pixmap. */ int depth) /* Bits per pixel for pixmap. */ { return XCreatePixmap(display, d, (unsigned) width, (unsigned) height, (unsigned) depth); } /* *---------------------------------------------------------------------- * * Tk_FreePixmap -- * * Same as the XFreePixmap function except that it also marks the * resource identifier as free. * * Results: * None. * * Side effects: * The pixmap is freed in the X server and its resource identifier is * saved for re-use. * *---------------------------------------------------------------------- */ void Tk_FreePixmap( Display *display, /* Display for which pixmap was allocated. */ Pixmap pixmap) /* Identifier for pixmap. */ { XFreePixmap(display, pixmap); Tk_FreeXId(display, (XID) pixmap); } /* *---------------------------------------------------------------------- * * TkpWindowWasRecentlyDeleted -- * * Checks whether the window was recently deleted. This is called by the * generic error handler to detect asynchronous notification of errors * due to operations by Tk on a window that was already deleted by the * server. * * Results: * 1 if the window was deleted recently, 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkpWindowWasRecentlyDeleted( Window win, /* The window to check for. */ TkDisplay *dispPtr) /* The window belongs to this display. */ { TkIdStack *stackPtr; int i; for (stackPtr = dispPtr->windowStackPtr; stackPtr != NULL; stackPtr = stackPtr->nextPtr) { for (i = 0; i < stackPtr->numUsed; i++) { if ((Window) stackPtr->ids[i] == win) { return 1; } } } return 0; } /* *---------------------------------------------------------------------- * * TkpScanWindowId -- * * Given a string, produce the corresponding Window Id. * * Results: * The return value is normally TCL_OK; in this case *idPtr will be set * to the Window value equivalent to string. If string is improperly * formed then TCL_ERROR is returned and an error message will be left in * the interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkpScanWindowId( Tcl_Interp *interp, CONST char *string, Window *idPtr) { int code; Tcl_Obj obj; obj.refCount = 1; obj.bytes = (char *) string; /* DANGER?! */ obj.length = strlen(string); obj.typePtr = NULL; code = Tcl_GetLongFromObj(interp, &obj, (long *)idPtr); if (obj.refCount > 1) { Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (obj.typePtr && obj.typePtr->freeIntRepProc) { obj.typePtr->freeIntRepProc(&obj); } return code; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixSend.c0000644003604700454610000016375412612445655014027 0ustar dgp771div/* * tkUnixSend.c -- * * This file provides functions that implement the "send" command, * allowing commands to be passed from interpreter to interpreter. * * Copyright (c) 1989-1994 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" /* * The following structure is used to keep track of the interpreters * registered by this process. */ typedef struct RegisteredInterp { char *name; /* Interpreter's name (malloc-ed). */ Tcl_Interp *interp; /* Interpreter associated with name. NULL * means that the application was unregistered * or deleted while a send was in progress to * it. */ TkDisplay *dispPtr; /* Display for the application. Needed because * we may need to unregister the interpreter * after its main window has been deleted. */ struct RegisteredInterp *nextPtr; /* Next in list of names associated with * interps in this process. NULL means end of * list. */ } RegisteredInterp; /* * A registry of all interpreters for a display is kept in a property * "InterpRegistry" on the root window of the display. It is organized as a * series of zero or more concatenated strings (in no particular order), each * of the form * window space name '\0' * where "window" is the hex id of the comm. window to use to talk to an * interpreter named "name". * * When the registry is being manipulated by an application (e.g. to add or * remove an entry), it is loaded into memory using a structure of the * following type: */ typedef struct NameRegistry { TkDisplay *dispPtr; /* Display from which the registry was * read. */ int locked; /* Non-zero means that the display was locked * when the property was read in. */ int modified; /* Non-zero means that the property has been * modified, so it needs to be written out * when the NameRegistry is closed. */ unsigned long propLength; /* Length of the property, in bytes. */ char *property; /* The contents of the property, or NULL if * none. See format description above; this is * *not* terminated by the first null * character. Dynamically allocated. */ int allocedByX; /* Non-zero means must free property with * XFree; zero means use ckfree. */ } NameRegistry; /* * When a result is being awaited from a sent command, one of the following * structures is present on a list of all outstanding sent commands. The * information in the structure is used to process the result when it arrives. * You're probably wondering how there could ever be multiple outstanding sent * commands. This could happen if interpreters invoke each other recursively. * It's unlikely, but possible. */ typedef struct PendingCommand { int serial; /* Serial number expected in result. */ TkDisplay *dispPtr; /* Display being used for communication. */ CONST char *target; /* Name of interpreter command is being sent * to. */ Window commWindow; /* Target's communication window. */ Tcl_Interp *interp; /* Interpreter from which the send was * invoked. */ int code; /* Tcl return code for command will be stored * here. */ char *result; /* String result for command (malloc'ed), or * NULL. */ char *errorInfo; /* Information for "errorInfo" variable, or * NULL (malloc'ed). */ char *errorCode; /* Information for "errorCode" variable, or * NULL (malloc'ed). */ int gotResponse; /* 1 means a response has been received, 0 * means the command is still outstanding. */ struct PendingCommand *nextPtr; /* Next in list of all outstanding commands. * NULL means end of list. */ } PendingCommand; typedef struct ThreadSpecificData { PendingCommand *pendingCommands; /* List of all commands currently being waited * for. */ RegisteredInterp *interpListPtr; /* List of all interpreters registered in the * current process. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The information below is used for communication between processes during * "send" commands. Each process keeps a private window, never even mapped, * with one property, "Comm". When a command is sent to an interpreter, the * command is appended to the comm property of the communication window * associated with the interp's process. Similarly, when a result is returned * from a sent command, it is also appended to the comm property. * * Each command and each result takes the form of ASCII text. For a command, * the text consists of a zero character followed by several null-terminated * ASCII strings. The first string consists of the single letter "c". * Subsequent strings have the form "option value" where the following options * are supported: * * -r commWindow serial * * This option means that a response should be sent to the window whose X * identifier is "commWindow" (in hex), and the response should be * identified with the serial number given by "serial" (in decimal). If * this option isn't specified then the send is asynchronous and no * response is sent. * * -n name * * "Name" gives the name of the application for which the command is * intended. This option must be present. * * -s script * * "Script" is the script to be executed. This option must be present. * * The options may appear in any order. The -n and -s options must be present, * but -r may be omitted for asynchronous RPCs. For compatibility with future * releases that may add new features, there may be additional options * present; as long as they start with a "-" character, they will be ignored. * * A result also consists of a zero character followed by several null- * terminated ASCII strings. The first string consists of the single letter * "r". Subsequent strings have the form "option value" where the following * options are supported: * * -s serial * * Identifies the command for which this is the result. It is the same as * the "serial" field from the -s option in the command. This option must * be present. * * -c code * * "Code" is the completion code for the script, in decimal. If the code * is omitted it defaults to TCL_OK. * * -r result * * "Result" is the result string for the script, which may be either a * result or an error message. If this field is omitted then it defaults * to an empty string. * * -i errorInfo * * "ErrorInfo" gives a string with which to initialize the errorInfo * variable. This option may be omitted; it is ignored unless the * completion code is TCL_ERROR. * * -e errorCode * * "ErrorCode" gives a string with with to initialize the errorCode * variable. This option may be omitted; it is ignored unless the * completion code is TCL_ERROR. * * Options may appear in any order, and only the -s option must be present. As * with commands, there may be additional options besides these; unknown * options are ignored. */ /* * Other miscellaneous per-process data: */ static struct { int sendSerial; /* The serial number that was used in the last * "send" command. */ int sendDebug; /* This can be set while debugging to do * things like skip locking the server. */ } localData = {0, 0}; /* * Maximum size property that can be read at one time by this module: */ #define MAX_PROP_WORDS 100000 /* * Forward declarations for functions defined later in this file: */ static int AppendErrorProc(ClientData clientData, XErrorEvent *errorPtr); static void AppendPropCarefully(Display *display, Window window, Atom property, char *value, int length, PendingCommand *pendingPtr); static void DeleteProc(ClientData clientData); static void RegAddName(NameRegistry *regPtr, CONST char *name, Window commWindow); static void RegClose(NameRegistry *regPtr); static void RegDeleteName(NameRegistry *regPtr, CONST char *name); static Window RegFindName(NameRegistry *regPtr, CONST char *name); static NameRegistry * RegOpen(Tcl_Interp *interp, TkDisplay *dispPtr, int lock); static void SendEventProc(ClientData clientData, XEvent *eventPtr); static int SendInit(Tcl_Interp *interp, TkDisplay *dispPtr); static Tk_RestrictAction SendRestrictProc(ClientData clientData, XEvent *eventPtr); static int ServerSecure(TkDisplay *dispPtr); static void UpdateCommWindow(TkDisplay *dispPtr); static int ValidateName(TkDisplay *dispPtr, CONST char *name, Window commWindow, int oldOK); /* *---------------------------------------------------------------------- * * RegOpen -- * * This function loads the name registry for a display into memory so * that it can be manipulated. * * Results: * The return value is a pointer to the loaded registry. * * Side effects: * If "lock" is set then the server will be locked. It is the caller's * responsibility to call RegClose when finished with the registry, so * that we can write back the registry if needed, unlock the server if * needed, and free memory. * *---------------------------------------------------------------------- */ static NameRegistry * RegOpen( Tcl_Interp *interp, /* Interpreter to use for error reporting * (errors cause a panic so in fact no error * is ever returned, but the interpreter is * needed anyway). */ TkDisplay *dispPtr, /* Display whose name registry is to be * opened. */ int lock) /* Non-zero means lock the window server when * opening the registry, so no-one else can * use the registry until we close it. */ { NameRegistry *regPtr; int result, actualFormat; unsigned long bytesAfter; Atom actualType; char **propertyPtr; if (dispPtr->commTkwin == NULL) { SendInit(interp, dispPtr); } regPtr = (NameRegistry *) ckalloc(sizeof(NameRegistry)); regPtr->dispPtr = dispPtr; regPtr->locked = 0; regPtr->modified = 0; regPtr->allocedByX = 1; propertyPtr = ®Ptr->property; if (lock && !localData.sendDebug) { XGrabServer(dispPtr->display); regPtr->locked = 1; } /* * Read the registry property. */ result = XGetWindowProperty(dispPtr->display, RootWindow(dispPtr->display, 0), dispPtr->registryProperty, 0, MAX_PROP_WORDS, False, XA_STRING, &actualType, &actualFormat, ®Ptr->propLength, &bytesAfter, (unsigned char **) propertyPtr); if (actualType == None) { regPtr->propLength = 0; regPtr->property = NULL; } else if ((result != Success) || (actualFormat != 8) || (actualType != XA_STRING)) { /* * The property is improperly formed; delete it. */ if (regPtr->property != NULL) { XFree(regPtr->property); regPtr->propLength = 0; regPtr->property = NULL; } XDeleteProperty(dispPtr->display, RootWindow(dispPtr->display, 0), dispPtr->registryProperty); } /* * Xlib placed an extra null byte after the end of the property, just to * make sure that it is always NULL-terminated. Be sure to include this * byte in our count if it's needed to ensure null termination (note: as * of 8/95 I'm no longer sure why this code is needed; seems like it * shouldn't be). */ if ((regPtr->propLength > 0) && (regPtr->property[regPtr->propLength-1] != 0)) { regPtr->propLength++; } return regPtr; } /* *---------------------------------------------------------------------- * * RegFindName -- * * Given an open name registry, this function finds an entry with a given * name, if there is one, and returns information about that entry. * * Results: * The return value is the X identifier for the comm window for the * application named "name", or None if there is no such entry in the * registry. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Window RegFindName( NameRegistry *regPtr, /* Pointer to a registry opened with a * previous call to RegOpen. */ CONST char *name) /* Name of an application. */ { char *p; for (p=regPtr->property ; p-regPtr->property<(int)regPtr->propLength ;) { char *entry = p; while ((*p != 0) && (!isspace(UCHAR(*p)))) { p++; } if ((*p != 0) && (strcmp(name, p+1) == 0)) { unsigned int id; if (sscanf(entry, "%x", &id) == 1) { /* * Must cast from an unsigned int to a Window in case we are * on a 64-bit architecture. */ return (Window) id; } } while (*p != 0) { p++; } p++; } return None; } /* *---------------------------------------------------------------------- * * RegDeleteName -- * * This function deletes the entry for a given name from an open * registry. * * Results: * None. * * Side effects: * If there used to be an entry named "name" in the registry, then it is * deleted and the registry is marked as modified so it will be written * back when closed. * *---------------------------------------------------------------------- */ static void RegDeleteName( NameRegistry *regPtr, /* Pointer to a registry opened with a * previous call to RegOpen. */ CONST char *name) /* Name of an application. */ { char *p; for (p=regPtr->property ; p-regPtr->property<(int)regPtr->propLength ;) { char *entry = p, *entryName; while ((*p != 0) && (!isspace(UCHAR(*p)))) { p++; } if (*p != 0) { p++; } entryName = p; while (*p != 0) { p++; } p++; if (strcmp(name, entryName) == 0) { int count; /* * Found the matching entry. Copy everything after it down on top * of it. */ count = regPtr->propLength - (p - regPtr->property); if (count > 0) { char *src, *dst; for (src=p , dst=entry ; count>0 ; src++, dst++, count--) { *dst = *src; } } regPtr->propLength -= p - entry; regPtr->modified = 1; return; } } } /* *---------------------------------------------------------------------- * * RegAddName -- * * Add a new entry to an open registry. * * Results: * None. * * Side effects: * The open registry is expanded; it is marked as modified so that it * will be written back when closed. * *---------------------------------------------------------------------- */ static void RegAddName( NameRegistry *regPtr, /* Pointer to a registry opened with a * previous call to RegOpen. */ CONST char *name, /* Name of an application. The caller must * ensure that this name isn't already * registered. */ Window commWindow) /* X identifier for comm. window of * application. */ { char id[30], *newProp; int idLength, newBytes; sprintf(id, "%x ", (unsigned int) commWindow); idLength = strlen(id); newBytes = idLength + strlen(name) + 1; newProp = ckalloc((unsigned) (regPtr->propLength + newBytes)); strcpy(newProp, id); strcpy(newProp+idLength, name); if (regPtr->property != NULL) { memcpy(newProp + newBytes, regPtr->property, regPtr->propLength); if (regPtr->allocedByX) { XFree(regPtr->property); } else { ckfree(regPtr->property); } } regPtr->modified = 1; regPtr->propLength += newBytes; regPtr->property = newProp; regPtr->allocedByX = 0; } /* *---------------------------------------------------------------------- * * RegClose -- * * This function is called to end a series of operations on a name * registry. * * Results: * None. * * Side effects: * The registry is written back if it has been modified, and the X server * is unlocked if it was locked. Memory for the registry is freed, so the * caller should never use regPtr again. * *---------------------------------------------------------------------- */ static void RegClose( NameRegistry *regPtr) /* Pointer to a registry opened with a * previous call to RegOpen. */ { if (regPtr->modified) { if (!regPtr->locked && !localData.sendDebug) { Tcl_Panic("The name registry was modified without being locked!"); } XChangeProperty(regPtr->dispPtr->display, RootWindow(regPtr->dispPtr->display, 0), regPtr->dispPtr->registryProperty, XA_STRING, 8, PropModeReplace, (unsigned char *) regPtr->property, (int) regPtr->propLength); } if (regPtr->locked) { XUngrabServer(regPtr->dispPtr->display); } /* * After ungrabbing the server, it's important to flush the output * immediately so that the server sees the ungrab command. Otherwise we * might do something else that needs to communicate with the server (such * as invoking a subprocess that needs to do I/O to the screen); if the * ungrab command is still sitting in our output buffer, we could * deadlock. */ XFlush(regPtr->dispPtr->display); if (regPtr->property != NULL) { if (regPtr->allocedByX) { XFree(regPtr->property); } else { ckfree(regPtr->property); } } ckfree((char *) regPtr); } /* *---------------------------------------------------------------------- * * ValidateName -- * * This function checks to see if an entry in the registry is still * valid. * * Results: * The return value is 1 if the given commWindow exists and its name is * "name". Otherwise 0 is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ValidateName( TkDisplay *dispPtr, /* Display for which to perform the * validation. */ CONST char *name, /* The name of an application. */ Window commWindow, /* X identifier for the application's comm. * window. */ int oldOK) /* Non-zero means that we should consider an * application to be valid even if it looks * like an old-style (pre-4.0) one; 0 means * consider these invalid. */ { int result, actualFormat, argc, i; unsigned long length, bytesAfter; Atom actualType; char *property, **propertyPtr = &property; Tk_ErrorHandler handler; CONST char **argv; property = NULL; /* * Ignore X errors when reading the property (e.g., the window might not * exist). If an error occurs, result will be some value other than * Success. */ handler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1, NULL, NULL); result = XGetWindowProperty(dispPtr->display, commWindow, dispPtr->appNameProperty, 0, MAX_PROP_WORDS, False, XA_STRING, &actualType, &actualFormat, &length, &bytesAfter, (unsigned char **) propertyPtr); if ((result == Success) && (actualType == None)) { XWindowAttributes atts; /* * The comm. window exists but the property we're looking for doesn't * exist. This probably means that the application comes from an older * version of Tk (< 4.0) that didn't set the property; if this is the * case, then assume for compatibility's sake that everything's OK. * However, it's also possible that some random application has * re-used the window id for something totally unrelated. Check a few * characteristics of the window, such as its dimensions and mapped * state, to be sure that it still "smells" like a commWindow. */ if (!oldOK || !XGetWindowAttributes(dispPtr->display, commWindow, &atts) || (atts.width != 1) || (atts.height != 1) || (atts.map_state != IsUnmapped)) { result = 0; } else { result = 1; } } else if ((result == Success) && (actualFormat == 8) && (actualType == XA_STRING)) { result = 0; if (Tcl_SplitList(NULL, property, &argc, &argv) == TCL_OK) { for (i = 0; i < argc; i++) { if (strcmp(argv[i], name) == 0) { result = 1; break; } } ckfree((char *) argv); } } else { result = 0; } Tk_DeleteErrorHandler(handler); if (property != NULL) { XFree(property); } return result; } /* *---------------------------------------------------------------------- * * ServerSecure -- * * Check whether a server is secure enough for us to trust Tcl scripts * arriving via that server. * * Results: * The return value is 1 if the server is secure, which means that * host-style authentication is turned on but there are no hosts in the * enabled list. This means that some other form of authorization * (presumably more secure, such as xauth) is in use. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ServerSecure( TkDisplay *dispPtr) /* Display to check. */ { #ifdef TK_NO_SECURITY return 1; #else XHostAddress *addrPtr; int numHosts, secure; Bool enabled; addrPtr = XListHosts(dispPtr->display, &numHosts, &enabled); if (!enabled) { insecure: secure = 0; } else if (numHosts == 0) { secure = 1; } else { /* * Recent versions of X11 have the extra feature of allowing more * sophisticated authorization checks to be performed than the dozy * old ones that used to plague xhost usage. However, not all deployed * versions of Xlib know how to deal with this feature, so this code * is conditional on having the right #def in place. [Bug 1909931] * * Note that at this point we know that there's at least one entry in * the list returned by XListHosts. However there may be multiple * entries; as long as each is one of either 'SI:localhost:*' or * 'SI:localgroup:*' then we will claim to be secure enough. */ #ifdef FamilyServerInterpreted XServerInterpretedAddress *siPtr; int i; for (i=0 ; itypelength == 9 /* ==strlen("localuser") */ && !memcmp(siPtr->type, "localuser", 9)) && !(siPtr->typelength == 10 /* ==strlen("localgroup") */ && !memcmp(siPtr->type, "localgroup", 10))) { /* * The other defined types of server-interpreted controls * involve particular hosts. These are still insecure for the * same reasons that classic xhost access is insecure; there's * just no way to be sure that the users on those systems are * the ones who should be allowed to connect to this display. */ goto insecure; } } secure = 1; #else /* * We don't understand what the X server is letting in, so we err on * the side of safety. */ goto insecure; #endif /* FamilyServerInterpreted */ } if (addrPtr != NULL) { XFree((char *) addrPtr); } return secure; #endif /* TK_NO_SECURITY */ } /* *-------------------------------------------------------------- * * Tk_SetAppName -- * * This function is called to associate an ASCII name with a Tk * application. If the application has already been named, the name * replaces the old one. * * Results: * The return value is the name actually given to the application. This * will normally be the same as name, but if name was already in use for * an application then a name of the form "name #2" will be chosen, with * a high enough number to make the name unique. * * Side effects: * Registration info is saved, thereby allowing the "send" command to be * used later to invoke commands in the application. In addition, the * "send" command is created in the application's interpreter. The * registration will be removed automatically if the interpreter is * deleted or the "send" command is removed. * *-------------------------------------------------------------- */ CONST char * Tk_SetAppName( Tk_Window tkwin, /* Token for any window in the application to * be named: it is just used to identify the * application and the display. */ CONST char *name) /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ { RegisteredInterp *riPtr, *riPtr2; Window w; TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; NameRegistry *regPtr; Tcl_Interp *interp; CONST char *actualName; Tcl_DString dString; int offset, i; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); interp = winPtr->mainPtr->interp; if (dispPtr->commTkwin == NULL) { SendInit(interp, winPtr->dispPtr); } /* * See if the application is already registered; if so, remove its current * name from the registry. */ regPtr = RegOpen(interp, winPtr->dispPtr, 1); for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) { if (riPtr == NULL) { /* * This interpreter isn't currently registered; create the data * structure that will be used to register it locally, plus add * the "send" command to the interpreter. */ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->dispPtr = winPtr->dispPtr; riPtr->nextPtr = tsdPtr->interpListPtr; tsdPtr->interpListPtr = riPtr; riPtr->name = NULL; Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "send", "send"); } break; } if (riPtr->interp == interp) { /* * The interpreter is currently registered; remove it from the * name registry. */ if (riPtr->name) { RegDeleteName(regPtr, riPtr->name); ckfree(riPtr->name); } break; } } /* * Pick a name to use for the application. Use "name" if it's not already * in use. Otherwise add a suffix such as " #2", trying larger and larger * numbers until we eventually find one that is unique. */ actualName = name; offset = 0; /* Needed only to avoid "used before * set" compiler warnings. */ for (i = 1; ; i++) { if (i > 1) { if (i == 2) { Tcl_DStringInit(&dString); Tcl_DStringAppend(&dString, name, -1); Tcl_DStringAppend(&dString, " #", 2); offset = Tcl_DStringLength(&dString); Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE); actualName = Tcl_DStringValue(&dString); } sprintf(Tcl_DStringValue(&dString) + offset, "%d", i); } w = RegFindName(regPtr, actualName); if (w == None) { break; } /* * The name appears to be in use already, but double-check to be sure * (perhaps the application died without removing its name from the * registry?). */ if (w == Tk_WindowId(dispPtr->commTkwin)) { for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL; riPtr2 = riPtr2->nextPtr) { if ((riPtr2->interp != interp) && (strcmp(riPtr2->name, actualName) == 0)) { goto nextSuffix; } } RegDeleteName(regPtr, actualName); break; } else if (!ValidateName(winPtr->dispPtr, actualName, w, 1)) { RegDeleteName(regPtr, actualName); break; } nextSuffix: continue; } /* * We've now got a name to use. Store it in the name registry and in the * local entry for this application, plus put it in a property on the * commWindow. */ RegAddName(regPtr, actualName, Tk_WindowId(dispPtr->commTkwin)); RegClose(regPtr); riPtr->name = (char *) ckalloc((unsigned) (strlen(actualName) + 1)); strcpy(riPtr->name, actualName); if (actualName != name) { Tcl_DStringFree(&dString); } UpdateCommWindow(dispPtr); return riPtr->name; } /* *-------------------------------------------------------------- * * Tk_SendCmd -- * * This function is invoked to process the "send" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *-------------------------------------------------------------- */ int Tk_SendCmd( ClientData clientData, /* Information about sender (only dispPtr * field is used). */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ CONST char **argv) /* Argument strings. */ { TkWindow *winPtr; Window commWindow; PendingCommand pending; register RegisteredInterp *riPtr; CONST char *destName; int result, c, async, i, firstArg; size_t length; Tk_RestrictProc *prevRestrictProc; ClientData prevArg; TkDisplay *dispPtr; Tcl_Time timeout; NameRegistry *regPtr; Tcl_DString request; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_Interp *localInterp; /* Used when the interpreter to send the * command to is within the same process. */ /* * Process options, if any. */ async = 0; winPtr = (TkWindow *) Tk_MainWindow(interp); if (winPtr == NULL) { return TCL_ERROR; } for (i = 1; i < (argc-1); ) { if (argv[i][0] != '-') { break; } c = argv[i][1]; length = strlen(argv[i]); if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) { async = 1; i++; } else if ((c == 'd') && (strncmp(argv[i], "-displayof", length) == 0)) { winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1], (Tk_Window) winPtr); if (winPtr == NULL) { return TCL_ERROR; } i += 2; } else if (strcmp(argv[i], "--") == 0) { i++; break; } else { Tcl_AppendResult(interp, "bad option \"", argv[i], "\": must be -async, -displayof, or --", NULL); return TCL_ERROR; } } if (argc < (i+2)) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?options? interpName arg ?arg ...?\"", NULL); return TCL_ERROR; } destName = argv[i]; firstArg = i+1; dispPtr = winPtr->dispPtr; if (dispPtr->commTkwin == NULL) { SendInit(interp, winPtr->dispPtr); } /* * See if the target interpreter is local. If so, execute the command * directly without going through the X server. The only tricky thing is * passing the result from the target interpreter to the invoking * interpreter. Watch out: they could be the same! */ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if ((riPtr->dispPtr != dispPtr) || (strcmp(riPtr->name, destName) != 0)) { continue; } Tcl_Preserve((ClientData) riPtr); localInterp = riPtr->interp; Tcl_Preserve((ClientData) localInterp); if (firstArg == (argc-1)) { result = Tcl_EvalEx(localInterp, argv[firstArg], -1, TCL_EVAL_GLOBAL); } else { Tcl_DStringInit(&request); Tcl_DStringAppend(&request, argv[firstArg], -1); for (i = firstArg+1; i < argc; i++) { Tcl_DStringAppend(&request, " ", 1); Tcl_DStringAppend(&request, argv[i], -1); } result = Tcl_EvalEx(localInterp, Tcl_DStringValue(&request), -1, TCL_EVAL_GLOBAL); Tcl_DStringFree(&request); } if (interp != localInterp) { if (result == TCL_ERROR) { Tcl_Obj *errorObjPtr; /* * An error occurred, so transfer error information from the * destination interpreter back to our interpreter. Must clear * interp's result before calling Tcl_AddErrorInfo, since * Tcl_AddErrorInfo will store the interp's result in * errorInfo before appending riPtr's $errorInfo; we've * already got everything we need in riPtr's $errorInfo. */ Tcl_ResetResult(interp); Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY)); errorObjPtr = Tcl_GetVar2Ex(localInterp, "errorCode", NULL, TCL_GLOBAL_ONLY); Tcl_SetObjErrorCode(interp, errorObjPtr); } Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp)); Tcl_ResetResult(localInterp); } Tcl_Release((ClientData) riPtr); Tcl_Release((ClientData) localInterp); return result; } /* * Bind the interpreter name to a communication window. */ regPtr = RegOpen(interp, winPtr->dispPtr, 0); commWindow = RegFindName(regPtr, destName); RegClose(regPtr); if (commWindow == None) { Tcl_AppendResult(interp, "no application named \"",destName,"\"",NULL); return TCL_ERROR; } /* * Send the command to the target interpreter by appending it to the comm * window in the communication window. */ localData.sendSerial++; Tcl_DStringInit(&request); Tcl_DStringAppend(&request, "\0c\0-n ", 6); Tcl_DStringAppend(&request, destName, -1); if (!async) { char buffer[TCL_INTEGER_SPACE * 2]; sprintf(buffer, "%x %d", (unsigned int) Tk_WindowId(dispPtr->commTkwin), localData.sendSerial); Tcl_DStringAppend(&request, "\0-r ", 4); Tcl_DStringAppend(&request, buffer, -1); } Tcl_DStringAppend(&request, "\0-s ", 4); Tcl_DStringAppend(&request, argv[firstArg], -1); for (i = firstArg+1; i < argc; i++) { Tcl_DStringAppend(&request, " ", 1); Tcl_DStringAppend(&request, argv[i], -1); } (void) AppendPropCarefully(dispPtr->display, commWindow, dispPtr->commProperty, Tcl_DStringValue(&request), Tcl_DStringLength(&request) + 1, (async ? NULL : &pending)); Tcl_DStringFree(&request); if (async) { /* * This is an asynchronous send: return immediately without waiting * for a response. */ return TCL_OK; } /* * Register the fact that we're waiting for a command to complete (this is * needed by SendEventProc and by AppendErrorProc to pass back the * command's results). Set up a timeout handler so that we can check * during long sends to make sure that the destination application is * still alive. */ pending.serial = localData.sendSerial; pending.dispPtr = dispPtr; pending.target = destName; pending.commWindow = commWindow; pending.interp = interp; pending.result = NULL; pending.errorInfo = NULL; pending.errorCode = NULL; pending.gotResponse = 0; pending.nextPtr = tsdPtr->pendingCommands; tsdPtr->pendingCommands = &pending; /* * Enter a loop processing X events until the result comes in or the * target is declared to be dead. While waiting for a result, look only at * send-related events so that the send is synchronous with respect to * other events in the application. */ prevRestrictProc = Tk_RestrictEvents(SendRestrictProc, NULL, &prevArg); Tcl_GetTime(&timeout); timeout.sec += 2; while (!pending.gotResponse) { if (!TkUnixDoOneXEvent(&timeout)) { /* * An unusually long amount of time has elapsed during the * processing of a sent command. Check to make sure that the * target application still exists. If it does, reset the timeout. */ if (!ValidateName(pending.dispPtr, pending.target, pending.commWindow, 0)) { char *msg; if (ValidateName(pending.dispPtr, pending.target, pending.commWindow, 1)) { msg = "target application died or uses a Tk version before 4.0"; } else { msg = "target application died"; } pending.code = TCL_ERROR; pending.result = (char *) ckalloc((unsigned) (strlen(msg) + 1)); strcpy(pending.result, msg); pending.gotResponse = 1; } else { Tcl_GetTime(&timeout); timeout.sec += 2; } } } (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg); /* * Unregister the information about the pending command and return the * result. */ if (tsdPtr->pendingCommands != &pending) { Tcl_Panic("Tk_SendCmd: corrupted send stack"); } tsdPtr->pendingCommands = pending.nextPtr; if (pending.errorInfo != NULL) { /* * Special trick: must clear the interp's result before calling * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's * result in errorInfo before appending pending.errorInfo; we've * already got everything we need in pending.errorInfo. */ Tcl_ResetResult(interp); Tcl_AddErrorInfo(interp, pending.errorInfo); ckfree(pending.errorInfo); } if (pending.errorCode != NULL) { Tcl_Obj *errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1); Tcl_SetObjErrorCode(interp, errorObjPtr); ckfree(pending.errorCode); } Tcl_SetResult(interp, pending.result, TCL_DYNAMIC); return pending.code; } /* *---------------------------------------------------------------------- * * TkGetInterpNames -- * * This function is invoked to fetch a list of all the interpreter names * currently registered for the display of a particular window. * * Results: * A standard Tcl return value. The interp's result will be set to hold a * list of all the interpreter names defined for tkwin's display. If an * error occurs, then TCL_ERROR is returned and the interp's result will * hold an error message. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkGetInterpNames( Tcl_Interp *interp, /* Interpreter for returning a result. */ Tk_Window tkwin) /* Window whose display is to be used for the * lookup. */ { TkWindow *winPtr = (TkWindow *) tkwin; NameRegistry *regPtr; char *p; /* * Read the registry property, then scan through all of its entries. * Validate each entry to be sure that its application still exists. */ regPtr = RegOpen(interp, winPtr->dispPtr, 1); for (p=regPtr->property ; p-regPtr->property<(int)regPtr->propLength ;) { char *entry = p, *entryName; Window commWindow; unsigned int id; if (sscanf(p, "%x",(unsigned int *) &id) != 1) { commWindow = None; } else { commWindow = id; } while ((*p != 0) && (!isspace(UCHAR(*p)))) { p++; } if (*p != 0) { p++; } entryName = p; while (*p != 0) { p++; } p++; if (ValidateName(winPtr->dispPtr, entryName, commWindow, 1)) { /* * The application still exists; add its name to the result. */ Tcl_AppendElement(interp, entryName); } else { int count; /* * This name is bogus (perhaps the application died without * cleaning up its entry in the registry?). Delete the name. */ count = regPtr->propLength - (p - regPtr->property); if (count > 0) { char *src, *dst; for (src = p, dst = entry; count > 0; src++, dst++, count--) { *dst = *src; } } regPtr->propLength -= p - entry; regPtr->modified = 1; p = entry; } } RegClose(regPtr); return TCL_OK; } /* *-------------------------------------------------------------- * * TkSendCleanup -- * * This function is called to free resources used by the communication * channels for sending commands and receiving results. * * Results: * None. * * Side effects: * Frees various data structures and windows. * *-------------------------------------------------------------- */ void TkSendCleanup( TkDisplay *dispPtr) { if (dispPtr->commTkwin != NULL) { Tk_DeleteEventHandler(dispPtr->commTkwin, PropertyChangeMask, SendEventProc, (ClientData) dispPtr); Tk_DestroyWindow(dispPtr->commTkwin); Tcl_Release((ClientData) dispPtr->commTkwin); dispPtr->commTkwin = NULL; } } /* *-------------------------------------------------------------- * * SendInit -- * * This function is called to initialize the communication channels for * sending commands and receiving results. * * Results: * None. * * Side effects: * Sets up various data structures and windows. * *-------------------------------------------------------------- */ static int SendInit( Tcl_Interp *interp, /* Interpreter to use for error reporting (no * errors are ever returned, but the * interpreter is needed anyway). */ TkDisplay *dispPtr) /* Display to initialize. */ { XSetWindowAttributes atts; /* * Create the window used for communication, and set up an event handler * for it. */ dispPtr->commTkwin = (Tk_Window) TkAllocWindow(dispPtr, DefaultScreen(dispPtr->display), NULL); Tcl_Preserve((ClientData) dispPtr->commTkwin); ((TkWindow *) dispPtr->commTkwin)->flags |=TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; TkWmNewWindow((TkWindow *) dispPtr->commTkwin); atts.override_redirect = True; Tk_ChangeWindowAttributes(dispPtr->commTkwin, CWOverrideRedirect, &atts); Tk_CreateEventHandler(dispPtr->commTkwin, PropertyChangeMask, SendEventProc, (ClientData) dispPtr); Tk_MakeWindowExist(dispPtr->commTkwin); /* * Get atoms used as property names. */ dispPtr->commProperty = Tk_InternAtom(dispPtr->commTkwin, "Comm"); dispPtr->registryProperty = Tk_InternAtom(dispPtr->commTkwin, "InterpRegistry"); dispPtr->appNameProperty = Tk_InternAtom(dispPtr->commTkwin, "TK_APPLICATION"); return TCL_OK; } /* *-------------------------------------------------------------- * * SendEventProc -- * * This function is invoked automatically by the toolkit event manager * when a property changes on the communication window. This function * reads the property and handles command requests and responses. * * Results: * None. * * Side effects: * If there are command requests in the property, they are executed. If * there are responses in the property, their information is saved for * the (ostensibly waiting) "send" commands. The property is deleted. * *-------------------------------------------------------------- */ static void SendEventProc( ClientData clientData, /* Display information. */ XEvent *eventPtr) /* Information about event. */ { TkDisplay *dispPtr = (TkDisplay *) clientData; char *propInfo, **propInfoPtr = &propInfo; register char *p; int result, actualFormat; unsigned long numItems, bytesAfter; Atom actualType; Tcl_Interp *remoteInterp; /* Interp in which to execute the command. */ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if ((eventPtr->xproperty.atom != dispPtr->commProperty) || (eventPtr->xproperty.state != PropertyNewValue)) { return; } /* * Read the comm property and delete it. */ propInfo = NULL; result = XGetWindowProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin), dispPtr->commProperty, 0, MAX_PROP_WORDS, True, XA_STRING, &actualType, &actualFormat, &numItems, &bytesAfter, (unsigned char **) propInfoPtr); /* * If the property doesn't exist or is improperly formed then ignore it. */ if ((result != Success) || (actualType != XA_STRING) || (actualFormat != 8)) { if (propInfo != NULL) { XFree(propInfo); } return; } /* * Several commands and results could arrive in the property at one time; * each iteration through the outer loop handles a single command or * result. */ for (p = propInfo; (p-propInfo) < (int) numItems; ) { /* * Ignore leading NULLs; each command or result starts with a NULL so * that no matter how badly formed a preceding command is, we'll be * able to tell that a new command/result is starting. */ if (*p == 0) { p++; continue; } if ((*p == 'c') && (p[1] == 0)) { Window commWindow; char *interpName, *script, *serial, *end; Tcl_DString reply; RegisteredInterp *riPtr; /* *---------------------------------------------------------- * This is an incoming command from some other application. * Iterate over all of its options. Stop when we reach the end of * the property or something that doesn't look like an option. *---------------------------------------------------------- */ p += 2; interpName = NULL; commWindow = None; serial = ""; script = NULL; while (((p-propInfo) < (int) numItems) && (*p == '-')) { switch (p[1]) { case 'r': commWindow = (Window) strtoul(p+2, &end, 16); if ((end == p+2) || (*end != ' ')) { commWindow = None; } else { p = serial = end+1; } break; case 'n': if (p[2] == ' ') { interpName = p+3; } break; case 's': if (p[2] == ' ') { script = p+3; } break; } while (*p != 0) { p++; } p++; } if ((script == NULL) || (interpName == NULL)) { continue; } /* * Initialize the result property, so that we're ready at any time * if we need to return an error. */ if (commWindow != None) { Tcl_DStringInit(&reply); Tcl_DStringAppend(&reply, "\0r\0-s ", 6); Tcl_DStringAppend(&reply, serial, -1); Tcl_DStringAppend(&reply, "\0-r ", 4); } if (!ServerSecure(dispPtr)) { if (commWindow != None) { Tcl_DStringAppend(&reply, "X server insecure (must use xauth-style " "authorization); command ignored", -1); } result = TCL_ERROR; goto returnResult; } /* * Locate the application, then execute the script. */ for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) { if (riPtr == NULL) { if (commWindow != None) { Tcl_DStringAppend(&reply, "receiver never heard of interpreter \"", -1); Tcl_DStringAppend(&reply, interpName, -1); Tcl_DStringAppend(&reply, "\"", 1); } result = TCL_ERROR; goto returnResult; } if (strcmp(riPtr->name, interpName) == 0) { break; } } Tcl_Preserve((ClientData) riPtr); /* * We must protect the interpreter because the script may enter * another event loop, which might call Tcl_DeleteInterp. */ remoteInterp = riPtr->interp; Tcl_Preserve((ClientData) remoteInterp); result = Tcl_EvalEx(remoteInterp, script, -1, TCL_EVAL_GLOBAL); /* * The call to Tcl_Release may have released the interpreter which * will cause the "send" command for that interpreter to be * deleted. The command deletion callback will set the * riPtr->interp field to NULL, hence the check below for NULL. */ if (commWindow != None) { Tcl_DStringAppend(&reply, Tcl_GetStringResult(remoteInterp), -1); if (result == TCL_ERROR) { CONST char *varValue; varValue = Tcl_GetVar2(remoteInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (varValue != NULL) { Tcl_DStringAppend(&reply, "\0-i ", 4); Tcl_DStringAppend(&reply, varValue, -1); } varValue = Tcl_GetVar2(remoteInterp, "errorCode", NULL, TCL_GLOBAL_ONLY); if (varValue != NULL) { Tcl_DStringAppend(&reply, "\0-e ", 4); Tcl_DStringAppend(&reply, varValue, -1); } } } Tcl_Release((ClientData) remoteInterp); Tcl_Release((ClientData) riPtr); /* * Return the result to the sender if a commWindow was specified * (if none was specified then this is an asynchronous call). * Right now reply has everything but the completion code, but it * needs the NULL to terminate the current option. */ returnResult: if (commWindow != None) { if (result != TCL_OK) { char buffer[TCL_INTEGER_SPACE]; sprintf(buffer, "%d", result); Tcl_DStringAppend(&reply, "\0-c ", 4); Tcl_DStringAppend(&reply, buffer, -1); } (void) AppendPropCarefully(dispPtr->display, commWindow, dispPtr->commProperty, Tcl_DStringValue(&reply), Tcl_DStringLength(&reply) + 1, NULL); XFlush(dispPtr->display); Tcl_DStringFree(&reply); } } else if ((*p == 'r') && (p[1] == 0)) { int serial, code, gotSerial; char *errorInfo, *errorCode, *resultString; PendingCommand *pcPtr; /* *---------------------------------------------------------- * This is a reply to some command that we sent out. Iterate over * all of its options. Stop when we reach the end of the property * or something that doesn't look like an option. *---------------------------------------------------------- */ p += 2; code = TCL_OK; gotSerial = 0; errorInfo = NULL; errorCode = NULL; resultString = ""; while (((p-propInfo) < (int) numItems) && (*p == '-')) { switch (p[1]) { case 'c': if (sscanf(p+2, " %d", &code) != 1) { code = TCL_OK; } break; case 'e': if (p[2] == ' ') { errorCode = p+3; } break; case 'i': if (p[2] == ' ') { errorInfo = p+3; } break; case 'r': if (p[2] == ' ') { resultString = p+3; } break; case 's': if (sscanf(p+2, " %d", &serial) == 1) { gotSerial = 1; } break; } while (*p != 0) { p++; } p++; } if (!gotSerial) { continue; } /* * Give the result information to anyone who's waiting for it. */ for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL; pcPtr = pcPtr->nextPtr) { if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) { continue; } pcPtr->code = code; if (resultString != NULL) { pcPtr->result = (char *) ckalloc((unsigned) (strlen(resultString) + 1)); strcpy(pcPtr->result, resultString); } if (code == TCL_ERROR) { if (errorInfo != NULL) { pcPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(errorInfo) + 1)); strcpy(pcPtr->errorInfo, errorInfo); } if (errorCode != NULL) { pcPtr->errorCode = (char *) ckalloc((unsigned) (strlen(errorCode) + 1)); strcpy(pcPtr->errorCode, errorCode); } } pcPtr->gotResponse = 1; break; } } else { /* * Didn't recognize this thing. Just skip through the next null * character and try again. */ while (*p != 0) { p++; } p++; } } XFree(propInfo); } /* *-------------------------------------------------------------- * * AppendPropCarefully -- * * Append a given property to a given window, but set up an X error * handler so that if the append fails this function can return an error * code rather than having Xlib panic. * * Results: * None. * * Side effects: * The given property on the given window is appended to. If this * operation fails and if pendingPtr is non-NULL, then the pending * operation is marked as complete with an error. * *-------------------------------------------------------------- */ static void AppendPropCarefully( Display *display, /* Display on which to operate. */ Window window, /* Window whose property is to be modified. */ Atom property, /* Name of property. */ char *value, /* Characters to append to property. */ int length, /* Number of bytes to append. */ PendingCommand *pendingPtr) /* Pending command to mark complete if an * error occurs during the property op. NULL * means just ignore the error. */ { Tk_ErrorHandler handler; handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc, (ClientData) pendingPtr); XChangeProperty(display, window, property, XA_STRING, 8, PropModeAppend, (unsigned char *) value, length); Tk_DeleteErrorHandler(handler); } /* * The function below is invoked if an error occurs during the XChangeProperty * operation above. */ /* ARGSUSED */ static int AppendErrorProc( ClientData clientData, /* Command to mark complete, or NULL. */ XErrorEvent *errorPtr) /* Information about error. */ { PendingCommand *pendingPtr = (PendingCommand *) clientData; register PendingCommand *pcPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (pendingPtr == NULL) { return 0; } /* * Make sure this command is still pending. */ for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL; pcPtr = pcPtr->nextPtr) { if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) { pcPtr->result = (char *) ckalloc((unsigned) (strlen(pcPtr->target) + 50)); sprintf(pcPtr->result, "no application named \"%s\"", pcPtr->target); pcPtr->code = TCL_ERROR; pcPtr->gotResponse = 1; break; } } return 0; } /* *-------------------------------------------------------------- * * DeleteProc -- * * This function is invoked by Tcl when the "send" command is deleted in * an interpreter. It unregisters the interpreter. * * Results: * None. * * Side effects: * The interpreter given by riPtr is unregistered. * *-------------------------------------------------------------- */ static void DeleteProc( ClientData clientData) /* Info about registration, passed as * ClientData. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; register RegisteredInterp *riPtr2; NameRegistry *regPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1); RegDeleteName(regPtr, riPtr->name); RegClose(regPtr); if (tsdPtr->interpListPtr == riPtr) { tsdPtr->interpListPtr = riPtr->nextPtr; } else { for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL; riPtr2 = riPtr2->nextPtr) { if (riPtr2->nextPtr == riPtr) { riPtr2->nextPtr = riPtr->nextPtr; break; } } } ckfree((char *) riPtr->name); riPtr->interp = NULL; UpdateCommWindow(riPtr->dispPtr); Tcl_EventuallyFree((ClientData) riPtr, TCL_DYNAMIC); } /* *---------------------------------------------------------------------- * * SendRestrictProc -- * * This function filters incoming events when a "send" command is * outstanding. It defers all events except those containing send * commands and results. * * Results: * False is returned except for property-change events on a commWindow. * * Side effects: * None. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static Tk_RestrictAction SendRestrictProc( ClientData clientData, /* Not used. */ register XEvent *eventPtr) /* Event that just arrived. */ { TkDisplay *dispPtr; if (eventPtr->type != PropertyNotify) { return TK_DEFER_EVENT; } for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { if ((eventPtr->xany.display == dispPtr->display) && (eventPtr->xproperty.window == Tk_WindowId(dispPtr->commTkwin))) { return TK_PROCESS_EVENT; } } return TK_DEFER_EVENT; } /* *---------------------------------------------------------------------- * * UpdateCommWindow -- * * This function updates the list of application names stored on our * commWindow. It is typically called when interpreters are registered * and unregistered. * * Results: * None. * * Side effects: * The TK_APPLICATION property on the comm window is updated. * *---------------------------------------------------------------------- */ static void UpdateCommWindow( TkDisplay *dispPtr) /* Display whose commWindow is to be * updated. */ { Tcl_DString names; RegisteredInterp *riPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_DStringInit(&names); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { Tcl_DStringAppendElement(&names, riPtr->name); } XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin), dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace, (unsigned char *) Tcl_DStringValue(&names), Tcl_DStringLength(&names)); Tcl_DStringFree(&names); } /* *---------------------------------------------------------------------- * * TkpTestsendCmd -- * * This function implements the "testsend" command. It provides a set of * functions for testing the "send" command and support function in * tkSend.c. * * Results: * A standard Tcl result. * * Side effects: * Depends on option; see below. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int TkpTestsendCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ CONST char **argv) /* Argument strings. */ { TkWindow *winPtr = (TkWindow *) clientData; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], " option ?arg ...?\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "bogus") == 0) { XChangeProperty(winPtr->dispPtr->display, RootWindow(winPtr->dispPtr->display, 0), winPtr->dispPtr->registryProperty, XA_INTEGER, 32, PropModeReplace, (unsigned char *) "This is bogus information", 6); } else if (strcmp(argv[1], "prop") == 0) { int result, actualFormat; unsigned long length, bytesAfter; Atom actualType, propName; char *property, **propertyPtr = &property, *p, *end; Window w; if ((argc != 4) && (argc != 5)) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], " prop window name ?value ?\"", NULL); return TCL_ERROR; } if (strcmp(argv[2], "root") == 0) { w = RootWindow(winPtr->dispPtr->display, 0); } else if (strcmp(argv[2], "comm") == 0) { w = Tk_WindowId(winPtr->dispPtr->commTkwin); } else { w = strtoul(argv[2], &end, 0); } propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]); if (argc == 4) { property = NULL; result = XGetWindowProperty(winPtr->dispPtr->display, w, propName, 0, 100000, False, XA_STRING, &actualType, &actualFormat, &length, &bytesAfter, (unsigned char **) propertyPtr); if ((result == Success) && (actualType != None) && (actualFormat == 8) && (actualType == XA_STRING)) { for (p = property; (unsigned long)(p-property) < length; p++) { if (*p == 0) { *p = '\n'; } } Tcl_SetResult(interp, property, TCL_VOLATILE); } if (property != NULL) { XFree(property); } } else if (argv[4][0] == 0) { XDeleteProperty(winPtr->dispPtr->display, w, propName); } else { Tcl_DString tmp; Tcl_DStringInit(&tmp); for (p = Tcl_DStringAppend(&tmp, argv[4], (int) strlen(argv[4])); *p != 0; p++) { if (*p == '\n') { *p = 0; } } XChangeProperty(winPtr->dispPtr->display, w, propName, XA_STRING, 8, PropModeReplace, (unsigned char*)Tcl_DStringValue(&tmp), p-Tcl_DStringValue(&tmp)); Tcl_DStringFree(&tmp); } } else if (strcmp(argv[1], "serial") == 0) { char buf[TCL_INTEGER_SPACE]; sprintf(buf, "%d", localData.sendSerial+1); Tcl_SetResult(interp, buf, TCL_VOLATILE); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be bogus, prop, or serial", NULL); return TCL_ERROR; } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixColor.c0000644003604700454610000003171612612445655014204 0ustar dgp771div/* * tkUnixColor.c -- * * This file contains the platform specific color routines needed for X * support. * * Copyright (c) 1996 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" #include "tkColor.h" /* * If a colormap fills up, attempts to allocate new colors from that colormap * will fail. When that happens, we'll just choose the closest color from * those that are available in the colormap. One of the following structures * will be created for each "stressed" colormap to keep track of the colors * that are available in the colormap (otherwise we would have to re-query * from the server on each allocation, which would be very slow). These * entries are flushed after a few seconds, since other clients may release or * reallocate colors over time. */ struct TkStressedCmap { Colormap colormap; /* X's token for the colormap. */ int numColors; /* Number of entries currently active at * *colorPtr. */ XColor *colorPtr; /* Pointer to malloc'ed array of all colors * that seem to be available in the colormap. * Some may not actually be available, e.g. * because they are read-write for another * client; when we find this out, we remove * them from the array. */ struct TkStressedCmap *nextPtr; /* Next in list of all stressed colormaps for * the display. */ }; /* * Forward declarations for functions defined in this file: */ static void DeleteStressedCmap(Display *display, Colormap colormap); static void FindClosestColor(Tk_Window tkwin, XColor *desiredColorPtr, XColor *actualColorPtr); /* *---------------------------------------------------------------------- * * TkpFreeColor -- * * Release the specified color back to the system. * * Results: * None * * Side effects: * Invalidates the colormap cache for the colormap associated with the * given color. * *---------------------------------------------------------------------- */ void TkpFreeColor( TkColor *tkColPtr) /* Color to be released. Must have been * allocated by TkpGetColor or * TkpGetColorByValue. */ { Visual *visual; Screen *screen = tkColPtr->screen; /* * Careful! Don't free black or white, since this will make some servers * very unhappy. Also, there is a bug in some servers (such Sun's X11/NeWS * server) where reference counting is performed incorrectly, so that if a * color is allocated twice in different places and then freed twice, the * second free generates an error (this bug existed as of 10/1/92). To get * around this problem, ignore errors that occur during the free * operation. */ visual = tkColPtr->visual; if ((visual->class != StaticGray) && (visual->class != StaticColor) && (tkColPtr->color.pixel != BlackPixelOfScreen(screen)) && (tkColPtr->color.pixel != WhitePixelOfScreen(screen))) { Tk_ErrorHandler handler; handler = Tk_CreateErrorHandler(DisplayOfScreen(screen), -1, -1, -1, NULL, NULL); XFreeColors(DisplayOfScreen(screen), tkColPtr->colormap, &tkColPtr->color.pixel, 1, 0L); Tk_DeleteErrorHandler(handler); } DeleteStressedCmap(DisplayOfScreen(screen), tkColPtr->colormap); } /* *---------------------------------------------------------------------- * * TkpGetColor -- * * Allocate a new TkColor for the color with the given name. * * Results: * Returns a newly allocated TkColor, or NULL on failure. * * Side effects: * May invalidate the colormap cache associated with tkwin upon * allocating a new colormap entry. Allocates a new TkColor structure. * *---------------------------------------------------------------------- */ TkColor * TkpGetColor( Tk_Window tkwin, /* Window in which color will be used. */ Tk_Uid name) /* Name of color to allocated (in form * suitable for passing to XParseColor). */ { Display *display = Tk_Display(tkwin); Colormap colormap = Tk_Colormap(tkwin); XColor color; TkColor *tkColPtr; /* * Map from the name to a pixel value. Call XAllocNamedColor rather than * XParseColor for non-# names: this saves a server round-trip for those * names. */ if (*name != '#') { XColor screen; if (((*name - 'A') & 0xdf) < sizeof(tkWebColors)/sizeof(tkWebColors[0])) { const char *p = tkWebColors[((*name - 'A') & 0x1f)]; if (p) { const char *q = name; while (!((*p - *(++q)) & 0xdf)) { if (!*p++) { name = p; goto gotWebColor; } } } } if (strlen(name) > 99) { /* Don't bother to parse this. [Bug 2809525]*/ return (TkColor *) NULL; } else if (XAllocNamedColor(display, colormap, name, &screen, &color) != 0) { DeleteStressedCmap(display, colormap); } else { /* * Couldn't allocate the color. Try translating the name to a * color value, to see whether the problem is a bad color name or * a full colormap. If the colormap is full, then pick an * approximation to the desired color. */ if (XLookupColor(display, colormap, name, &color, &screen) == 0) { return NULL; } FindClosestColor(tkwin, &screen, &color); } } else { gotWebColor: if (TkParseColor(display, colormap, name, &color) == 0) { return NULL; } if (XAllocColor(display, colormap, &color) != 0) { DeleteStressedCmap(display, colormap); } else { FindClosestColor(tkwin, &color, &color); } } tkColPtr = (TkColor *) ckalloc(sizeof(TkColor)); tkColPtr->color = color; return tkColPtr; } /* *---------------------------------------------------------------------- * * TkpGetColorByValue -- * * Given a desired set of red-green-blue intensities for a color, locate * a pixel value to use to draw that color in a given window. * * Results: * The return value is a pointer to an TkColor structure that indicates * the closest red, blue, and green intensities available to those * specified in colorPtr, and also specifies a pixel value to use to draw * in that color. * * Side effects: * May invalidate the colormap cache for the specified window. Allocates * a new TkColor structure. * *---------------------------------------------------------------------- */ TkColor * TkpGetColorByValue( Tk_Window tkwin, /* Window in which color will be used. */ XColor *colorPtr) /* Red, green, and blue fields indicate * desired color. */ { Display *display = Tk_Display(tkwin); Colormap colormap = Tk_Colormap(tkwin); TkColor *tkColPtr = (TkColor *) ckalloc(sizeof(TkColor)); tkColPtr->color.red = colorPtr->red; tkColPtr->color.green = colorPtr->green; tkColPtr->color.blue = colorPtr->blue; if (XAllocColor(display, colormap, &tkColPtr->color) != 0) { DeleteStressedCmap(display, colormap); } else { FindClosestColor(tkwin, &tkColPtr->color, &tkColPtr->color); } return tkColPtr; } /* *---------------------------------------------------------------------- * * FindClosestColor -- * * When Tk can't allocate a color because a colormap has filled up, this * function is called to find and allocate the closest available color in * the colormap. * * Results: * There is no return value, but *actualColorPtr is filled in with * information about the closest available color in tkwin's colormap. * This color has been allocated via X, so it must be released by the * caller when the caller is done with it. * * Side effects: * A color is allocated. * *---------------------------------------------------------------------- */ static void FindClosestColor( Tk_Window tkwin, /* Window where color will be used. */ XColor *desiredColorPtr, /* RGB values of color that was wanted (but * unavailable). */ XColor *actualColorPtr) /* Structure to fill in with RGB and pixel for * closest available color. */ { TkStressedCmap *stressPtr; double tmp, distance, closestDistance; int i, closest, numFound; XColor *colorPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; Colormap colormap = Tk_Colormap(tkwin); XVisualInfo template, *visInfoPtr; /* * Find the TkStressedCmap structure for this colormap, or create a new * one if needed. */ for (stressPtr = dispPtr->stressPtr; ; stressPtr = stressPtr->nextPtr) { if (stressPtr == NULL) { stressPtr = (TkStressedCmap *) ckalloc(sizeof(TkStressedCmap)); stressPtr->colormap = colormap; template.visualid = XVisualIDFromVisual(Tk_Visual(tkwin)); visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualIDMask, &template, &numFound); if (numFound < 1) { Tcl_Panic("FindClosestColor couldn't lookup visual"); } stressPtr->numColors = visInfoPtr->colormap_size; XFree((char *) visInfoPtr); stressPtr->colorPtr = (XColor *) ckalloc((unsigned) (stressPtr->numColors * sizeof(XColor))); for (i = 0; i < stressPtr->numColors; i++) { stressPtr->colorPtr[i].pixel = (unsigned long) i; } XQueryColors(dispPtr->display, colormap, stressPtr->colorPtr, stressPtr->numColors); stressPtr->nextPtr = dispPtr->stressPtr; dispPtr->stressPtr = stressPtr; break; } if (stressPtr->colormap == colormap) { break; } } /* * Find the color that best approximates the desired one, then try to * allocate that color. If that fails, it must mean that the color was * read-write (so we can't use it, since it's owner might change it) or * else it was already freed. Try again, over and over again, until * something succeeds. */ while (1) { if (stressPtr->numColors == 0) { Tcl_Panic("FindClosestColor ran out of colors"); } closestDistance = 1e30; closest = 0; for (colorPtr = stressPtr->colorPtr, i = 0; i < stressPtr->numColors; colorPtr++, i++) { /* * Use Euclidean distance in RGB space, weighted by Y (of YIQ) as * the objective function; this accounts for differences in the * color sensitivity of the eye. */ tmp = .30*(((int) desiredColorPtr->red) - (int) colorPtr->red); distance = tmp*tmp; tmp = .61*(((int) desiredColorPtr->green) - (int) colorPtr->green); distance += tmp*tmp; tmp = .11*(((int) desiredColorPtr->blue) - (int) colorPtr->blue); distance += tmp*tmp; if (distance < closestDistance) { closest = i; closestDistance = distance; } } if (XAllocColor(dispPtr->display, colormap, &stressPtr->colorPtr[closest]) != 0) { *actualColorPtr = stressPtr->colorPtr[closest]; return; } /* * Couldn't allocate the color. Remove it from the table and go back * to look for the next best color. */ stressPtr->colorPtr[closest] = stressPtr->colorPtr[stressPtr->numColors-1]; stressPtr->numColors -= 1; } } /* *---------------------------------------------------------------------- * * DeleteStressedCmap -- * * This function releases the information cached for "colormap" so that * it will be refetched from the X server the next time it is needed. * * Results: * None. * * Side effects: * The TkStressedCmap structure for colormap is deleted; the colormap is * no longer considered to be "stressed". * * Note: * This function is invoked whenever a color in a colormap is freed, and * whenever a color allocation in a colormap succeeds. This guarantees * that TkStressedCmap structures are always deleted before the * corresponding Colormap is freed. * *---------------------------------------------------------------------- */ static void DeleteStressedCmap( Display *display, /* Xlib's handle for the display containing * the colormap. */ Colormap colormap) /* Colormap to flush. */ { TkStressedCmap *prevPtr, *stressPtr; TkDisplay *dispPtr = TkGetDisplay(display); for (prevPtr = NULL, stressPtr = dispPtr->stressPtr; stressPtr != NULL; prevPtr = stressPtr, stressPtr = stressPtr->nextPtr) { if (stressPtr->colormap == colormap) { if (prevPtr == NULL) { dispPtr->stressPtr = stressPtr->nextPtr; } else { prevPtr->nextPtr = stressPtr->nextPtr; } ckfree((char *) stressPtr->colorPtr); ckfree((char *) stressPtr); return; } } } /* *---------------------------------------------------------------------- * * TkpCmapStressed -- * * Check to see whether a given colormap is known to be out of entries. * * Results: * 1 is returned if "colormap" is stressed (i.e. it has run out of * entries recently), 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkpCmapStressed( Tk_Window tkwin, /* Window that identifies the display * containing the colormap. */ Colormap colormap) /* Colormap to check for stress. */ { TkStressedCmap *stressPtr; for (stressPtr = ((TkWindow *) tkwin)->dispPtr->stressPtr; stressPtr != NULL; stressPtr = stressPtr->nextPtr) { if (stressPtr->colormap == colormap) { return 1; } } return 0; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixEmbed.c0000644003604700454610000007516712627134671014151 0ustar dgp771div/* * tkUnixEmbed.c -- * * This file contains platform-specific functions for UNIX to provide * basic operations needed for application embedding (where one * application can use as its main window an internal window from some * other application). * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" /* * One of the following structures exists for each container in this * application. It keeps track of the container window and its associated * embedded window. */ typedef struct Container { Window parent; /* X's window id for the parent of the pair * (the container). */ Window parentRoot; /* Id for the root window of parent's * screen. */ TkWindow *parentPtr; /* Tk's information about the container, or * NULL if the container isn't in this * process. */ Window wrapper; /* X's window id for the wrapper window for * the embedded window. Starts off as None, * but gets filled in when the window is * eventually created. */ TkWindow *embeddedPtr; /* Tk's information about the embedded window, * or NULL if the embedded application isn't * in this process. Note that this is *not* * the same window as wrapper: wrapper is the * parent of embeddedPtr. */ struct Container *nextPtr; /* Next in list of all containers in this * process. */ } Container; typedef struct ThreadSpecificData { Container *firstContainerPtr; /* First in list of all containers managed by * this process. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Prototypes for static functions defined in this file: */ static void ContainerEventProc(ClientData clientData, XEvent *eventPtr); static void EmbeddedEventProc(ClientData clientData, XEvent *eventPtr); static int EmbedErrorProc(ClientData clientData, XErrorEvent *errEventPtr); static void EmbedFocusProc(ClientData clientData, XEvent *eventPtr); static void EmbedGeometryRequest(Container *containerPtr, int width, int height); static void EmbedSendConfigure(Container *containerPtr); static void EmbedStructureProc(ClientData clientData, XEvent *eventPtr); static void EmbedWindowDeleted(TkWindow *winPtr); /* *---------------------------------------------------------------------- * * TkpUseWindow -- * * This function causes a Tk window to use a given X window as its parent * window, rather than the root window for the screen. It is invoked by * an embedded application to specify the window in which it is embedded. * * Results: * The return value is normally TCL_OK. If an error occurs (such as * string not being a valid window spec), then the return value is * TCL_ERROR and an error message is left in the interp's result if * interp is non-NULL. * * Side effects: * Changes the colormap and other visual information to match that of the * parent window given by "string". * *---------------------------------------------------------------------- */ int TkpUseWindow( Tcl_Interp *interp, /* If not NULL, used for error reporting if * string is bogus. */ Tk_Window tkwin, /* Tk window that does not yet have an * associated X window. */ CONST char *string) /* String identifying an X window to use for * tkwin; must be an integer value. */ { TkWindow *winPtr = (TkWindow *) tkwin; TkWindow *usePtr; int anyError; Window parent; Tk_ErrorHandler handler; Container *containerPtr; XWindowAttributes parentAtts; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->window != None) { Tcl_AppendResult(interp, "can't modify container after widget is created", NULL); return TCL_ERROR; } if (TkpScanWindowId(interp, string, &parent) != TCL_OK) { return TCL_ERROR; } usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent); if (usePtr != NULL) { if (!(usePtr->flags & TK_CONTAINER)) { Tcl_AppendResult(interp, "window \"", usePtr->pathName, "\" doesn't have -container option set", NULL); return TCL_ERROR; } } /* * Tk sets the window colormap to the screen default colormap in * tkWindow.c:AllocWindow. This doesn't work well for embedded windows. So * we override the colormap and visual settings to be the same as the * parent window (which is in the container app). */ anyError = 0; handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, EmbedErrorProc, (ClientData) &anyError); if (!XGetWindowAttributes(winPtr->display, parent, &parentAtts)) { anyError = 1; } XSync(winPtr->display, False); Tk_DeleteErrorHandler(handler); if (anyError) { if (interp != NULL) { Tcl_AppendResult(interp, "couldn't create child of window \"", string, "\"", NULL); } return TCL_ERROR; } Tk_SetWindowVisual(tkwin, parentAtts.visual, parentAtts.depth, parentAtts.colormap); /* * Create an event handler to clean up the Container structure when tkwin * is eventually deleted. */ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc, (ClientData) winPtr); /* * Save information about the container and the embedded window in a * Container structure. If there is already an existing Container * structure, it means that both container and embedded app. are in the * same process. */ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->parent == parent) { winPtr->flags |= TK_BOTH_HALVES; containerPtr->parentPtr->flags |= TK_BOTH_HALVES; break; } } if (containerPtr == NULL) { containerPtr = (Container *) ckalloc(sizeof(Container)); containerPtr->parent = parent; containerPtr->parentRoot = parentAtts.root; containerPtr->parentPtr = NULL; containerPtr->wrapper = None; containerPtr->nextPtr = tsdPtr->firstContainerPtr; tsdPtr->firstContainerPtr = containerPtr; } containerPtr->embeddedPtr = winPtr; winPtr->flags |= TK_EMBEDDED; return TCL_OK; } /* *---------------------------------------------------------------------- * * TkpMakeWindow -- * * Create an actual window system window object based on the current * attributes of the specified TkWindow. * * Results: * Returns the handle to the new window, or None on failure. * * Side effects: * Creates a new X window. * *---------------------------------------------------------------------- */ Window TkpMakeWindow( TkWindow *winPtr, /* Tk's information about the window that is * to be instantiated. */ Window parent) /* Window system token for the parent in which * the window is to be created. */ { Container *containerPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->flags & TK_EMBEDDED) { /* * This window is embedded. Don't create the new window in the given * parent; instead, create it as a child of the root window of the * container's screen. The window will get reparented into a wrapper * window later. */ for (containerPtr = tsdPtr->firstContainerPtr; ; containerPtr = containerPtr->nextPtr) { if (containerPtr == NULL) { Tcl_Panic("TkMakeWindow couldn't find container for window"); } if (containerPtr->embeddedPtr == winPtr) { break; } } parent = containerPtr->parentRoot; } return XCreateWindow(winPtr->display, parent, winPtr->changes.x, winPtr->changes.y, (unsigned) winPtr->changes.width, (unsigned) winPtr->changes.height, (unsigned) winPtr->changes.border_width, winPtr->depth, InputOutput, winPtr->visual, winPtr->dirtyAtts, &winPtr->atts); } /* *---------------------------------------------------------------------- * * TkpMakeContainer -- * * This function is called to indicate that a particular window will be a * container for an embedded application. This changes certain aspects of * the window's behavior, such as whether it will receive events anymore. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TkpMakeContainer( Tk_Window tkwin) /* Token for a window that is about to become * a container. */ { TkWindow *winPtr = (TkWindow *) tkwin; Container *containerPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Register the window as a container so that, for example, we can find * out later if the embedded app. is in the same process. */ Tk_MakeWindowExist(tkwin); containerPtr = (Container *) ckalloc(sizeof(Container)); containerPtr->parent = Tk_WindowId(tkwin); containerPtr->parentRoot = RootWindowOfScreen(Tk_Screen(tkwin)); containerPtr->parentPtr = winPtr; containerPtr->wrapper = None; containerPtr->embeddedPtr = NULL; containerPtr->nextPtr = tsdPtr->firstContainerPtr; tsdPtr->firstContainerPtr = containerPtr; winPtr->flags |= TK_CONTAINER; /* * Request SubstructureNotify events so that we can find out when the * embedded application creates its window or attempts to resize it. Also * watch Configure events on the container so that we can resize the child * to match. */ winPtr->atts.event_mask |= SubstructureRedirectMask|SubstructureNotifyMask; XSelectInput(winPtr->display, winPtr->window, winPtr->atts.event_mask); Tk_CreateEventHandler(tkwin, SubstructureNotifyMask|SubstructureRedirectMask, ContainerEventProc, (ClientData) winPtr); Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbedStructureProc, (ClientData) containerPtr); Tk_CreateEventHandler(tkwin, FocusChangeMask, EmbedFocusProc, (ClientData) containerPtr); } /* *---------------------------------------------------------------------- * * EmbedErrorProc -- * * This function is invoked if an error occurs while creating an embedded * window. * * Results: * Always returns 0 to indicate that the error has been properly handled. * * Side effects: * The integer pointed to by the clientData argument is set to 1. * *---------------------------------------------------------------------- */ static int EmbedErrorProc( ClientData clientData, /* Points to integer to set. */ XErrorEvent *errEventPtr) /* Points to information about error (not * used). */ { int *iPtr = (int *) clientData; *iPtr = 1; return 0; } /* *---------------------------------------------------------------------- * * EmbeddedEventProc -- * * This function is invoked by the Tk event dispatcher when various * useful events are received for a window that is embedded in another * application. * * Results: * None. * * Side effects: * Our internal state gets cleaned up when an embedded window is * destroyed. * *---------------------------------------------------------------------- */ static void EmbeddedEventProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { TkWindow *winPtr = (TkWindow *) clientData; if (eventPtr->type == DestroyNotify) { EmbedWindowDeleted(winPtr); } } /* *---------------------------------------------------------------------- * * ContainerEventProc -- * * This function is invoked by the Tk event dispatcher when various * useful events are received for the children of a container window. It * forwards relevant information, such as geometry requests, from the * events into the container's application. * * Results: * None. * * Side effects: * Depends on the event. For example, when ConfigureRequest events occur, * geometry information gets set for the container window. * *---------------------------------------------------------------------- */ static void ContainerEventProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { TkWindow *winPtr = (TkWindow *) clientData; Container *containerPtr; Tk_ErrorHandler errHandler; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Ignore any X protocol errors that happen in this function (almost any * operation could fail, for example, if the embedded application has * deleted its window). */ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1, -1, -1, NULL, (ClientData) NULL); /* * Find the Container structure associated with the parent window. */ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr->parent != eventPtr->xmaprequest.parent; containerPtr = containerPtr->nextPtr) { if (containerPtr == NULL) { Tcl_Panic("ContainerEventProc couldn't find Container record"); } } if (eventPtr->type == CreateNotify) { /* * A new child window has been created in the container. Record its id * in the Container structure (if more than one child is created, just * remember the last one and ignore the earlier ones). Also set the * child's size to match the container. */ containerPtr->wrapper = eventPtr->xcreatewindow.window; XMoveResizeWindow(eventPtr->xcreatewindow.display, containerPtr->wrapper, 0, 0, (unsigned) Tk_Width((Tk_Window) containerPtr->parentPtr), (unsigned) Tk_Height((Tk_Window) containerPtr->parentPtr)); } else if (eventPtr->type == ConfigureRequest) { if ((eventPtr->xconfigurerequest.x != 0) || (eventPtr->xconfigurerequest.y != 0)) { /* * The embedded application is trying to move itself, which isn't * legal. At this point, the window hasn't actually moved, but we * need to send it a ConfigureNotify event to let it know that its * request has been denied. If the embedded application was also * trying to resize itself, a ConfigureNotify will be sent by the * geometry management code below, so we don't need to do * anything. Otherwise, generate a synthetic event. */ if ((eventPtr->xconfigurerequest.width == winPtr->changes.width) && (eventPtr->xconfigurerequest.height == winPtr->changes.height)) { EmbedSendConfigure(containerPtr); } } EmbedGeometryRequest(containerPtr, eventPtr->xconfigurerequest.width, eventPtr->xconfigurerequest.height); } else if (eventPtr->type == MapRequest) { /* * The embedded application's map request was ignored and simply * passed on to us, so we have to map the window for it to appear on * the screen. */ XMapWindow(eventPtr->xmaprequest.display, eventPtr->xmaprequest.window); } else if (eventPtr->type == DestroyNotify) { /* * The embedded application is gone. Destroy the container window. */ Tk_DestroyWindow((Tk_Window) winPtr); } Tk_DeleteErrorHandler(errHandler); } /* *---------------------------------------------------------------------- * * EmbedStructureProc -- * * This function is invoked by the Tk event dispatcher when a container * window owned by this application gets resized (and also at several * other times that we don't care about). This function reflects the size * change in the embedded window that corresponds to the container. * * Results: * None. * * Side effects: * The embedded window gets resized to match the container. * *---------------------------------------------------------------------- */ static void EmbedStructureProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { Container *containerPtr = (Container *) clientData; Tk_ErrorHandler errHandler; if (eventPtr->type == ConfigureNotify) { if (containerPtr->wrapper != None) { /* * Ignore errors, since the embedded application could have * deleted its window. */ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1, -1, -1, NULL, (ClientData) NULL); XMoveResizeWindow(eventPtr->xconfigure.display, containerPtr->wrapper, 0, 0, (unsigned) Tk_Width((Tk_Window) containerPtr->parentPtr), (unsigned) Tk_Height((Tk_Window) containerPtr->parentPtr)); Tk_DeleteErrorHandler(errHandler); } } else if (eventPtr->type == DestroyNotify) { EmbedWindowDeleted(containerPtr->parentPtr); } } /* *---------------------------------------------------------------------- * * EmbedFocusProc -- * * This function is invoked by the Tk event dispatcher when FocusIn and * FocusOut events occur for a container window owned by this * application. It is responsible for moving the focus back and forth * between a container application and an embedded application. * * Results: * None. * * Side effects: * The X focus may change. * *---------------------------------------------------------------------- */ static void EmbedFocusProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { Container *containerPtr = (Container *) clientData; Tk_ErrorHandler errHandler; Display *display; display = Tk_Display(containerPtr->parentPtr); if (eventPtr->type == FocusIn) { /* * The focus just arrived at the container. Change the X focus to move * it to the embedded application, if there is one. Ignore X errors * that occur during this operation (it's possible that the new focus * window isn't mapped). */ if (containerPtr->wrapper != None) { errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1, -1, -1, NULL, (ClientData) NULL); XSetInputFocus(display, containerPtr->wrapper, RevertToParent, CurrentTime); Tk_DeleteErrorHandler(errHandler); } } } /* *---------------------------------------------------------------------- * * EmbedGeometryRequest -- * * This function is invoked when an embedded application requests a * particular size. It processes the request (which may or may not * actually honor the request) and reflects the results back to the * embedded application. * * Results: * None. * * Side effects: * If we deny the child's size change request, a Configure event is * synthesized to let the child know how big it ought to be. Events get * processed while we're waiting for the geometry managers to do their * thing. * *---------------------------------------------------------------------- */ static void EmbedGeometryRequest( Container *containerPtr, /* Information about the embedding. */ int width, int height) /* Size that the child has requested. */ { TkWindow *winPtr = containerPtr->parentPtr; /* * Forward the requested size into our geometry management hierarchy via * the container window. We need to send a Configure event back to the * embedded application if we decide not to honor its request; to make * this happen, process all idle event handlers synchronously here (so * that the geometry managers have had a chance to do whatever they want * to do), and if the window's size didn't change then generate a * configure event. */ Tk_GeometryRequest((Tk_Window) winPtr, width, height); while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) { /* Empty loop body. */ } if ((winPtr->changes.width != width) || (winPtr->changes.height != height)) { EmbedSendConfigure(containerPtr); } } /* *---------------------------------------------------------------------- * * EmbedSendConfigure -- * * This function synthesizes a ConfigureNotify event to notify an * embedded application of its current size and location. This function * is called when the embedded application made a geometry request that * we did not grant, so that the embedded application knows that its * geometry didn't change after all. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void EmbedSendConfigure( Container *containerPtr) /* Information about the embedding. */ { TkWindow *winPtr = containerPtr->parentPtr; XEvent event; event.xconfigure.type = ConfigureNotify; event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display); event.xconfigure.send_event = True; event.xconfigure.display = winPtr->display; event.xconfigure.event = containerPtr->wrapper; event.xconfigure.window = containerPtr->wrapper; event.xconfigure.x = 0; event.xconfigure.y = 0; event.xconfigure.width = winPtr->changes.width; event.xconfigure.height = winPtr->changes.height; event.xconfigure.above = None; event.xconfigure.override_redirect = False; /* * Note: when sending the event below, the ButtonPressMask causes the * event to be sent only to applications that have selected for * ButtonPress events, which should be just the embedded application. */ XSendEvent(winPtr->display, containerPtr->wrapper, False, 0, &event); /* * The following needs to be done if the embedded window is not in the * same application as the container window. */ if (containerPtr->embeddedPtr == NULL) { XMoveResizeWindow(winPtr->display, containerPtr->wrapper, 0, 0, (unsigned) winPtr->changes.width, (unsigned) winPtr->changes.height); } } /* *---------------------------------------------------------------------- * * TkpGetOtherWindow -- * * If both the container and embedded window are in the same process, * this function will return either one, given the other. * * Results: * If winPtr is a container, the return value is the token for the * embedded window, and vice versa. If the "other" window isn't in this * process, NULL is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ TkWindow * TkpGetOtherWindow( TkWindow *winPtr) /* Tk's structure for a container or embedded * window. */ { Container *containerPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->embeddedPtr == winPtr) { return containerPtr->parentPtr; } else if (containerPtr->parentPtr == winPtr) { return containerPtr->embeddedPtr; } } return NULL; } /* *---------------------------------------------------------------------- * * TkpRedirectKeyEvent -- * * This function is invoked when a key press or release event arrives for * an application that does not believe it owns the input focus. This can * happen because of embedding; for example, X can send an event to an * embedded application when the real focus window is in the container * application and is an ancestor of the container. This function's job * is to forward the event back to the application where it really * belongs. * * Results: * None. * * Side effects: * The event may get sent to a different application. * *---------------------------------------------------------------------- */ void TkpRedirectKeyEvent( TkWindow *winPtr, /* Window to which the event was originally * reported. */ XEvent *eventPtr) /* X event to redirect (should be KeyPress or * KeyRelease). */ { Container *containerPtr; Window saved; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * First, find the top-level window corresponding to winPtr. */ while (1) { if (winPtr == NULL) { /* * This window is being deleted. This is too confusing a case to * handle so discard the event. */ return; } if (winPtr->flags & TK_TOP_HIERARCHY) { break; } winPtr = winPtr->parentPtr; } if (winPtr->flags & TK_EMBEDDED) { /* * This application is embedded. If we got a key event without * officially having the focus, it means that the focus is really in * the container, but the mouse was over the embedded application. * Send the event back to the container. */ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr->embeddedPtr != winPtr; containerPtr = containerPtr->nextPtr) { /* Empty loop body. */ } saved = eventPtr->xkey.window; eventPtr->xkey.window = containerPtr->parent; XSendEvent(eventPtr->xkey.display, eventPtr->xkey.window, False, KeyPressMask|KeyReleaseMask, eventPtr); eventPtr->xkey.window = saved; } } /* *---------------------------------------------------------------------- * * TkpClaimFocus -- * * This function is invoked when someone asks or the input focus to be * put on a window in an embedded application, but the application * doesn't currently have the focus. It requests the input focus from the * container application. * * Results: * None. * * Side effects: * The input focus may change. * *---------------------------------------------------------------------- */ void TkpClaimFocus( TkWindow *topLevelPtr, /* Top-level window containing desired focus * window; should be embedded. */ int force) /* One means that the container should claim * the focus if it doesn't currently have * it. */ { XEvent event; Container *containerPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!(topLevelPtr->flags & TK_EMBEDDED)) { return; } for (containerPtr = tsdPtr->firstContainerPtr; containerPtr->embeddedPtr != topLevelPtr; containerPtr = containerPtr->nextPtr) { /* Empty loop body. */ } event.xfocus.type = FocusIn; event.xfocus.serial = LastKnownRequestProcessed(topLevelPtr->display); event.xfocus.send_event = 1; event.xfocus.display = topLevelPtr->display; event.xfocus.window = containerPtr->parent; event.xfocus.mode = EMBEDDED_APP_WANTS_FOCUS; event.xfocus.detail = force; XSendEvent(event.xfocus.display, event.xfocus.window, False, 0, &event); } /* *---------------------------------------------------------------------- * * TkpTestembedCmd -- * * This function implements the "testembed" command. It returns some or * all of the information in the list pointed to by firstContainerPtr. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkpTestembedCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ CONST char **argv) /* Argument strings. */ { int all; Container *containerPtr; Tcl_DString dString; char buffer[50]; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if ((argc > 1) && (strcmp(argv[1], "all") == 0)) { all = 1; } else { all = 0; } Tcl_DStringInit(&dString); for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { Tcl_DStringStartSublist(&dString); if (containerPtr->parent == None) { Tcl_DStringAppendElement(&dString, ""); } else if (all) { sprintf(buffer, "0x%x", (int) containerPtr->parent); Tcl_DStringAppendElement(&dString, buffer); } else { Tcl_DStringAppendElement(&dString, "XXX"); } if (containerPtr->parentPtr == NULL) { Tcl_DStringAppendElement(&dString, ""); } else { Tcl_DStringAppendElement(&dString, containerPtr->parentPtr->pathName); } if (containerPtr->wrapper == None) { Tcl_DStringAppendElement(&dString, ""); } else if (all) { sprintf(buffer, "0x%x", (int) containerPtr->wrapper); Tcl_DStringAppendElement(&dString, buffer); } else { Tcl_DStringAppendElement(&dString, "XXX"); } if (containerPtr->embeddedPtr == NULL) { Tcl_DStringAppendElement(&dString, ""); } else { Tcl_DStringAppendElement(&dString, containerPtr->embeddedPtr->pathName); } Tcl_DStringEndSublist(&dString); } Tcl_DStringResult(interp, &dString); return TCL_OK; } /* *---------------------------------------------------------------------- * * EmbedWindowDeleted -- * * This function is invoked when a window involved in embedding (as * either the container or the embedded application) is destroyed. It * cleans up the Container structure for the window. * * Results: * None. * * Side effects: * A Container structure may be freed. * *---------------------------------------------------------------------- */ static void EmbedWindowDeleted( TkWindow *winPtr) /* Tk's information about window that was * deleted. */ { Container *containerPtr, *prevPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Find the Container structure for this window work. Delete the * information about the embedded application and free the container's * record. */ prevPtr = NULL; containerPtr = tsdPtr->firstContainerPtr; while (1) { if (containerPtr->embeddedPtr == winPtr) { containerPtr->wrapper = None; containerPtr->embeddedPtr = NULL; break; } if (containerPtr->parentPtr == winPtr) { containerPtr->parentPtr = NULL; break; } prevPtr = containerPtr; containerPtr = containerPtr->nextPtr; } if ((containerPtr->embeddedPtr == NULL) && (containerPtr->parentPtr == NULL)) { if (prevPtr == NULL) { tsdPtr->firstContainerPtr = containerPtr->nextPtr; } else { prevPtr->nextPtr = containerPtr->nextPtr; } ckfree((char *) containerPtr); } } /* *---------------------------------------------------------------------- * * TkUnixContainerId -- * * Given an embedded window, this function returns the X window * identifier for the associated container window. * * Results: * The return value is the X window identifier for winPtr's container * window. * * Side effects: * None. * *---------------------------------------------------------------------- */ Window TkUnixContainerId( TkWindow *winPtr) /* Tk's structure for an embedded window. */ { Container *containerPtr; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->embeddedPtr == winPtr) { return containerPtr->parent; } } Tcl_Panic("TkUnixContainerId couldn't find window"); return None; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixKey.c0000644003604700454610000003271412612445655013655 0ustar dgp771div/* * tkUnixKey.c -- * * This file contains routines for dealing with international keyboard * input. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" /* ** Bug [3607830]: Before using Xkb, it must be initialized. TkpOpenDisplay ** does this and sets the USE_XKB flag if xkb is supported. ** (should this be function ptr?) */ #ifdef HAVE_XKBKEYCODETOKEYSYM # include #else # define XkbKeycodeToKeysym(D,K,G,L) XKeycodeToKeysym(D,K,L) #endif #define TkKeycodeToKeysym(D,K,G,L) \ ((D)->flags & TK_DISPLAY_USE_XKB) ? \ XkbKeycodeToKeysym((D)->display,K,G,L) : \ XKeycodeToKeysym((D)->display,K,L) /* * Prototypes for local functions defined in this file: */ /* *---------------------------------------------------------------------- * * Tk_SetCaretPos -- * * This enables correct placement of the XIM caret. This is called by * widgets to indicate their cursor placement. This is currently only * used for over-the-spot XIM. * *---------------------------------------------------------------------- */ void Tk_SetCaretPos( Tk_Window tkwin, int x, int y, int height) { TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; if ( dispPtr->caret.winPtr == winPtr && dispPtr->caret.x == x && dispPtr->caret.y == y && dispPtr->caret.height == height) { return; } dispPtr->caret.winPtr = winPtr; dispPtr->caret.x = x; dispPtr->caret.y = y; dispPtr->caret.height = height; #ifdef TK_USE_INPUT_METHODS /* * Adjust the XIM caret position. */ if ( (dispPtr->flags & TK_DISPLAY_USE_IM) && (dispPtr->inputStyle & XIMPreeditPosition) && (winPtr->inputContext != NULL) ) { XVaNestedList preedit_attr; XPoint spot; spot.x = dispPtr->caret.x; spot.y = dispPtr->caret.y + dispPtr->caret.height; preedit_attr = XVaCreateNestedList(0, XNSpotLocation, &spot, NULL); XSetICValues(winPtr->inputContext, XNPreeditAttributes, preedit_attr, NULL); XFree(preedit_attr); } #endif } /* *---------------------------------------------------------------------- * * TkpGetString -- * * Retrieve the UTF string associated with a keyboard event. * * Results: * Returns the UTF string. * * Side effects: * Stores the input string in the specified Tcl_DString. Modifies the * internal input state. This routine can only be called once for a given * event. * *---------------------------------------------------------------------- */ char * TkpGetString( TkWindow *winPtr, /* Window where event occurred */ XEvent *eventPtr, /* X keyboard event. */ Tcl_DString *dsPtr) /* Initialized, empty string to hold result. */ { int len; Tcl_DString buf; TkKeyEvent *kePtr = (TkKeyEvent *) eventPtr; /* * If we have the value cached already, use it now. [Bug 1373712] */ if (kePtr->charValuePtr != NULL) { Tcl_DStringSetLength(dsPtr, kePtr->charValueLen); memcpy(Tcl_DStringValue(dsPtr), kePtr->charValuePtr, (unsigned) kePtr->charValueLen+1); return Tcl_DStringValue(dsPtr); } #ifdef TK_USE_INPUT_METHODS if ((winPtr->dispPtr->flags & TK_DISPLAY_USE_IM) && (winPtr->inputContext != NULL) && (eventPtr->type == KeyPress)) { Status status; #if X_HAVE_UTF8_STRING Tcl_DStringSetLength(dsPtr, TCL_DSTRING_STATIC_SIZE-1); len = Xutf8LookupString(winPtr->inputContext, &eventPtr->xkey, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr), &kePtr->keysym, &status); if (status == XBufferOverflow) { /* Expand buffer and try again */ Tcl_DStringSetLength(dsPtr, len); len = Xutf8LookupString(winPtr->inputContext, &eventPtr->xkey, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr), &kePtr->keysym, &status); } if ((status != XLookupChars) && (status != XLookupBoth)) { len = 0; } Tcl_DStringSetLength(dsPtr, len); #else /* !X_HAVE_UTF8_STRING */ /* * Overallocate the dstring to the maximum stack amount. */ Tcl_DStringInit(&buf); Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1); len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf), &kePtr->keysym, &status); /* * If the buffer wasn't big enough, grow the buffer and try again. */ if (status == XBufferOverflow) { Tcl_DStringSetLength(&buf, len); len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey, Tcl_DStringValue(&buf), len, &kePtr->keysym, &status); } if ((status != XLookupChars) && (status != XLookupBoth)) { len = 0; } Tcl_DStringSetLength(&buf, len); Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buf), len, dsPtr); Tcl_DStringFree(&buf); #endif /* X_HAVE_UTF8_STRING */ } else #endif /* TK_USE_INPUT_METHODS */ { /* * Fall back to convert a keyboard event to a UTF-8 string using * XLookupString. This is used when input methods are turned off and * for KeyRelease events. * * Note: XLookupString() normally returns a single ISO Latin 1 or * ASCII control character. */ Tcl_DStringInit(&buf); Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1); len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf), TCL_DSTRING_STATIC_SIZE, &kePtr->keysym, 0); Tcl_DStringValue(&buf)[len] = '\0'; if (len == 1) { len = Tcl_UniCharToUtf((unsigned char) Tcl_DStringValue(&buf)[0], Tcl_DStringValue(dsPtr)); Tcl_DStringSetLength(dsPtr, len); } else { /* * len > 1 should only happen if someone has called XRebindKeysym. * Assume UTF-8. */ Tcl_DStringSetLength(dsPtr, len); strncpy(Tcl_DStringValue(dsPtr), Tcl_DStringValue(&buf), len); } } /* * Cache the string in the event so that if/when we return to this * function, we will be able to produce it without asking X. This stops us * from having to reenter the XIM engine. [Bug 1373712] */ kePtr->charValuePtr = ckalloc((unsigned) len + 1); kePtr->charValueLen = len; memcpy(kePtr->charValuePtr, Tcl_DStringValue(dsPtr), (unsigned) len + 1); return Tcl_DStringValue(dsPtr); } /* * When mapping from a keysym to a keycode, need information about the * modifier state to be used so that when they call TkKeycodeToKeysym taking * into account the xkey.state, they will get back the original keysym. */ void TkpSetKeycodeAndState( Tk_Window tkwin, KeySym keySym, XEvent *eventPtr) { TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; int state; KeyCode keycode; if (keySym == NoSymbol) { keycode = 0; } else { keycode = XKeysymToKeycode(dispPtr->display, keySym); } eventPtr->xkey.keycode = keycode; if (keycode != 0) { for (state = 0; state < 4; state++) { if (XLookupKeysym(&eventPtr->xkey, state) == keySym) { if (state & 1) { eventPtr->xkey.state |= ShiftMask; } if (state & 2) { eventPtr->xkey.state |= dispPtr->modeModMask; } break; } } } eventPtr->xkey.keycode = keycode; } /* *---------------------------------------------------------------------- * * TkpGetKeySym -- * * Given an X KeyPress or KeyRelease event, map the keycode in the event * into a KeySym. * * Results: * The return value is the KeySym corresponding to eventPtr, or NoSymbol * if no matching Keysym could be found. * * Side effects: * In the first call for a given display, keycode-to-KeySym maps get * loaded. * *---------------------------------------------------------------------- */ KeySym TkpGetKeySym( TkDisplay *dispPtr, /* Display in which to map keycode. */ XEvent *eventPtr) /* Description of X event. */ { KeySym sym; int index; TkKeyEvent* kePtr = (TkKeyEvent*) eventPtr; /* * Refresh the mapping information if it's stale. This must happen before * we do any input method processing. [Bug 3599312] */ if (dispPtr->bindInfoStale) { TkpInitKeymapInfo(dispPtr); } #ifdef TK_USE_INPUT_METHODS /* * If input methods are active, we may already have determined a keysym. * Return it. */ if (eventPtr->type == KeyPress && dispPtr && (dispPtr->flags & TK_DISPLAY_USE_IM)) { if (kePtr->charValuePtr == NULL) { Tcl_DString ds; TkWindow *winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, eventPtr->xany.window); Tcl_DStringInit(&ds); (void) TkpGetString(winPtr, eventPtr, &ds); Tcl_DStringFree(&ds); } if (kePtr->charValuePtr != NULL) { return kePtr->keysym; } } #endif /* * Figure out which of the four slots in the keymap vector to use for this * key. Refer to Xlib documentation for more info on how this computation * works. */ index = 0; if (eventPtr->xkey.state & dispPtr->modeModMask) { index = 2; } if ((eventPtr->xkey.state & ShiftMask) || ((dispPtr->lockUsage != LU_IGNORE) && (eventPtr->xkey.state & LockMask))) { index += 1; } sym = TkKeycodeToKeysym(dispPtr, eventPtr->xkey.keycode, 0, index); /* * Special handling: if the key was shifted because of Lock, but lock is * only caps lock, not shift lock, and the shifted keysym isn't upper-case * alphabetic, then switch back to the unshifted keysym. */ if ((index & 1) && !(eventPtr->xkey.state & ShiftMask) && (dispPtr->lockUsage == LU_CAPS)) { if (!(((sym >= XK_A) && (sym <= XK_Z)) || ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis)) || ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) { index &= ~1; sym = TkKeycodeToKeysym(dispPtr, eventPtr->xkey.keycode, 0, index); } } /* * Another bit of special handling: if this is a shifted key and there is * no keysym defined, then use the keysym for the unshifted key. */ if ((index & 1) && (sym == NoSymbol)) { sym = TkKeycodeToKeysym(dispPtr, eventPtr->xkey.keycode, 0, index & ~1); } return sym; } /* *-------------------------------------------------------------- * * TkpInitKeymapInfo -- * * This function is invoked to scan keymap information to recompute stuff * that's important for binding, such as the modifier key (if any) that * corresponds to "mode switch". * * Results: * None. * * Side effects: * Keymap-related information in dispPtr is updated. * *-------------------------------------------------------------- */ void TkpInitKeymapInfo( TkDisplay *dispPtr) /* Display for which to recompute keymap * information. */ { XModifierKeymap *modMapPtr; KeyCode *codePtr; KeySym keysym; int count, i, j, max, arraySize; #define KEYCODE_ARRAY_SIZE 20 dispPtr->bindInfoStale = 0; modMapPtr = XGetModifierMapping(dispPtr->display); /* * Check the keycodes associated with the Lock modifier. If any of them is * associated with the XK_Shift_Lock modifier, then Lock has to be * interpreted as Shift Lock, not Caps Lock. */ dispPtr->lockUsage = LU_IGNORE; codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex; for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) { if (*codePtr == 0) { continue; } keysym = TkKeycodeToKeysym(dispPtr, *codePtr, 0, 0); if (keysym == XK_Shift_Lock) { dispPtr->lockUsage = LU_SHIFT; break; } if (keysym == XK_Caps_Lock) { dispPtr->lockUsage = LU_CAPS; break; } } /* * Look through the keycodes associated with modifiers to see if the the * "mode switch", "meta", or "alt" keysyms are associated with any * modifiers. If so, remember their modifier mask bits. */ dispPtr->modeModMask = 0; dispPtr->metaModMask = 0; dispPtr->altModMask = 0; codePtr = modMapPtr->modifiermap; max = 8*modMapPtr->max_keypermod; for (i = 0; i < max; i++, codePtr++) { if (*codePtr == 0) { continue; } keysym = TkKeycodeToKeysym(dispPtr, *codePtr, 0, 0); if (keysym == XK_Mode_switch) { dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod); } if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) { dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod); } if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) { dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod); } } /* * Create an array of the keycodes for all modifier keys. */ if (dispPtr->modKeyCodes != NULL) { ckfree((char *) dispPtr->modKeyCodes); } dispPtr->numModKeyCodes = 0; arraySize = KEYCODE_ARRAY_SIZE; dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned) (KEYCODE_ARRAY_SIZE * sizeof(KeyCode))); for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) { if (*codePtr == 0) { continue; } /* * Make sure that the keycode isn't already in the array. */ for (j = 0; j < dispPtr->numModKeyCodes; j++) { if (dispPtr->modKeyCodes[j] == *codePtr) { goto nextModCode; } } if (dispPtr->numModKeyCodes >= arraySize) { KeyCode *new; /* * Ran out of space in the array; grow it. */ arraySize *= 2; new = (KeyCode *) ckalloc((unsigned) (arraySize * sizeof(KeyCode))); memcpy(new, dispPtr->modKeyCodes, (dispPtr->numModKeyCodes * sizeof(KeyCode))); ckfree((char *) dispPtr->modKeyCodes); dispPtr->modKeyCodes = new; } dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr; dispPtr->numModKeyCodes++; nextModCode: continue; } XFreeModifiermap(modMapPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixRFont.c0000644003604700454610000005340612612445655014156 0ustar dgp771div/* * tkUnixRFont.c -- * * Alternate implementation of tkUnixFont.c using Xft. * * Copyright (c) 2002-2003 Keith Packard * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" #include "tkFont.h" #include #include typedef struct { XftFont *ftFont; FcPattern *source; FcCharSet *charset; } UnixFtFace; typedef struct { TkFont font; /* Stuff used by generic font package. Must be * first in structure. */ UnixFtFace *faces; int nfaces; FcFontSet *fontset; FcPattern *pattern; Display *display; int screen; XftDraw *ftDraw; XftColor color; } UnixFtFont; /* * Used to describe the current clipping box. Can't be passed normally because * the information isn't retrievable from the GC. */ typedef struct ThreadSpecificData { Region clipRegion; /* The clipping region, or None. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Package initialization: * Nothing to do here except register the fact that we're using Xft in * the TIP 59 configuration database. */ #ifndef TCL_CFGVAL_ENCODING #define TCL_CFGVAL_ENCODING "ascii" #endif void TkpFontPkgInit( TkMainInfo *mainPtr) /* The application being created. */ { static Tcl_Config cfg[] = { { "fontsystem", "xft" }, { 0,0 } }; Tcl_RegisterConfig(mainPtr->interp, "tk", cfg, TCL_CFGVAL_ENCODING); } static XftFont * GetFont( UnixFtFont *fontPtr, FcChar32 ucs4) { int i; if (ucs4) { for (i = 0; i < fontPtr->nfaces; i++) { FcCharSet *charset = fontPtr->faces[i].charset; if (charset && FcCharSetHasChar(charset, ucs4)) { break; } } if (i == fontPtr->nfaces) { i = 0; } } else { i = 0; } if (!fontPtr->faces[i].ftFont) { FcPattern *pat = FcFontRenderPrepare(0, fontPtr->pattern, fontPtr->faces[i].source); XftFont *ftFont = XftFontOpenPattern(fontPtr->display, pat); if (!ftFont) { /* * The previous call to XftFontOpenPattern() should not fail, * but sometimes does anyway. Usual cause appears to be * a misconfigured fontconfig installation; see [Bug 1090382]. * Try a fallback: */ ftFont = XftFontOpen(fontPtr->display, fontPtr->screen, FC_FAMILY, FcTypeString, "sans", FC_SIZE, FcTypeDouble, 12.0, NULL); } if (!ftFont) { /* * The previous call should definitely not fail. * Impossible to proceed at this point. */ Tcl_Panic("Cannot find a usable font."); } fontPtr->faces[i].ftFont = ftFont; } return fontPtr->faces[i].ftFont; } /* *--------------------------------------------------------------------------- * * GetTkFontAttributes -- * Fill in TkFontAttributes from an XftFont. */ static void GetTkFontAttributes( XftFont *ftFont, TkFontAttributes *faPtr) { char *family = "Unknown", **familyPtr = &family; int weight, slant, size, pxsize; double ptsize; (void)XftPatternGetString(ftFont->pattern, XFT_FAMILY, 0, familyPtr); if (XftPatternGetDouble(ftFont->pattern, XFT_SIZE, 0, &ptsize) == XftResultMatch) { size = (int)ptsize; } else if (XftPatternGetInteger(ftFont->pattern, XFT_PIXEL_SIZE, 0, &pxsize) == XftResultMatch) { size = -pxsize; } else { size = 12; } if (XftPatternGetInteger(ftFont->pattern, XFT_WEIGHT, 0, &weight) != XftResultMatch) { weight = XFT_WEIGHT_MEDIUM; } if (XftPatternGetInteger(ftFont->pattern, XFT_SLANT, 0, &slant) != XftResultMatch) { slant = XFT_SLANT_ROMAN; } #if DEBUG_FONTSEL printf("family %s size %d weight %d slant %d\n", family, size, weight, slant); #endif /* DEBUG_FONTSEL */ faPtr->family = Tk_GetUid(family); faPtr->size = size; faPtr->weight = (weight > XFT_WEIGHT_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL; faPtr->slant = (slant > XFT_SLANT_ROMAN) ? TK_FS_ITALIC : TK_FS_ROMAN; faPtr->underline = 0; faPtr->overstrike = 0; } /* *--------------------------------------------------------------------------- * * GetTkFontMetrics -- * Fill in TkFontMetrics from an XftFont. */ static void GetTkFontMetrics( XftFont *ftFont, TkFontMetrics *fmPtr) { int spacing; if (XftPatternGetInteger(ftFont->pattern, XFT_SPACING, 0, &spacing) != XftResultMatch) { spacing = XFT_PROPORTIONAL; } fmPtr->ascent = ftFont->ascent; fmPtr->descent = ftFont->descent; fmPtr->maxWidth = ftFont->max_advance_width; fmPtr->fixed = spacing != XFT_PROPORTIONAL; } /* *--------------------------------------------------------------------------- * * InitFont -- * * Initializes the fields of a UnixFtFont structure. If fontPtr is NULL, * also allocates a new UnixFtFont. * * Results: * On error, frees fontPtr and returns NULL, otherwise returns fontPtr. * *--------------------------------------------------------------------------- */ static UnixFtFont * InitFont( Tk_Window tkwin, FcPattern *pattern, UnixFtFont *fontPtr) { FcFontSet *set; FcCharSet *charset; FcResult result; XftFont *ftFont; int i; if (!fontPtr) { fontPtr = (UnixFtFont *) ckalloc(sizeof(UnixFtFont)); } FcConfigSubstitute(0, pattern, FcMatchPattern); XftDefaultSubstitute(Tk_Display(tkwin), Tk_ScreenNumber(tkwin), pattern); /* * Generate the list of fonts */ set = FcFontSort(0, pattern, FcTrue, NULL, &result); if (!set) { ckfree((char *)fontPtr); return NULL; } fontPtr->fontset = set; fontPtr->pattern = pattern; fontPtr->faces = (UnixFtFace *) ckalloc(set->nfont * sizeof(UnixFtFace)); fontPtr->nfaces = set->nfont; /* * Fill in information about each returned font */ for (i = 0; i < set->nfont; i++) { fontPtr->faces[i].ftFont = 0; fontPtr->faces[i].source = set->fonts[i]; if (FcPatternGetCharSet(set->fonts[i], FC_CHARSET, 0, &charset) == FcResultMatch) { fontPtr->faces[i].charset = FcCharSetCopy(charset); } else { fontPtr->faces[i].charset = 0; } } fontPtr->display = Tk_Display(tkwin); fontPtr->screen = Tk_ScreenNumber(tkwin); fontPtr->ftDraw = 0; fontPtr->color.color.red = 0; fontPtr->color.color.green = 0; fontPtr->color.color.blue = 0; fontPtr->color.color.alpha = 0xffff; fontPtr->color.pixel = 0xffffffff; /* * Fill in platform-specific fields of TkFont. */ ftFont = GetFont(fontPtr, 0); fontPtr->font.fid = XLoadFont(Tk_Display(tkwin), "fixed"); GetTkFontAttributes(ftFont, &fontPtr->font.fa); GetTkFontMetrics(ftFont, &fontPtr->font.fm); /* * Fontconfig can't report any information about the position or thickness * of underlines or overstrikes. Thus, we use some defaults that are * hacked around from backup defaults in tkUnixFont.c, which are in turn * based on recommendations in the X manual. The comments from that file * leading to these computations were: * * If the XA_UNDERLINE_POSITION property does not exist, the X manual * recommends using half the descent. * * If the XA_UNDERLINE_THICKNESS property does not exist, the X * manual recommends using the width of the stem on a capital letter. * I don't know of a way to get the stem width of a letter, so guess * and use 1/3 the width of a capital I. * * Note that nothing corresponding to *either* property is reported by * Fontconfig at all. [Bug 1961455] */ { TkFont *fPtr = &fontPtr->font; int iWidth; fPtr->underlinePos = fPtr->fm.descent / 2; Tk_MeasureChars((Tk_Font) fPtr, "I", 1, -1, 0, &iWidth); fPtr->underlineHeight = iWidth / 3; if (fPtr->underlineHeight == 0) { fPtr->underlineHeight = 1; } if (fPtr->underlineHeight + fPtr->underlinePos > fPtr->fm.descent) { fPtr->underlineHeight = fPtr->fm.descent - fPtr->underlinePos; if (fPtr->underlineHeight == 0) { fPtr->underlinePos--; fPtr->underlineHeight = 1; } } } return fontPtr; } static void FinishedWithFont( UnixFtFont *fontPtr) { Display *display = fontPtr->display; int i; Tk_ErrorHandler handler = Tk_CreateErrorHandler(display, -1, -1, -1, NULL, (ClientData) NULL); for (i = 0; i < fontPtr->nfaces; i++) { if (fontPtr->faces[i].ftFont) { XftFontClose(fontPtr->display, fontPtr->faces[i].ftFont); } if (fontPtr->faces[i].charset) { FcCharSetDestroy(fontPtr->faces[i].charset); } } if (fontPtr->faces) { ckfree((char *)fontPtr->faces); } if (fontPtr->pattern) { FcPatternDestroy(fontPtr->pattern); } if (fontPtr->ftDraw) { XftDrawDestroy(fontPtr->ftDraw); } if (fontPtr->font.fid) { XUnloadFont(fontPtr->display, fontPtr->font.fid); } if (fontPtr->fontset) { FcFontSetDestroy(fontPtr->fontset); } Tk_DeleteErrorHandler(handler); } TkFont * TkpGetNativeFont( Tk_Window tkwin, /* For display where font will be used. */ CONST char *name) /* Platform-specific font name. */ { UnixFtFont *fontPtr; FcPattern *pattern; #if DEBUG_FONTSEL printf("TkpGetNativeFont %s\n", name); #endif /* DEBUG_FONTSEL */ pattern = XftXlfdParse(name, FcFalse, FcFalse); if (!pattern) { return NULL; } /* * Should also try: pattern = FcNameParse(name); but generic/tkFont.c * expects TkpGetNativeFont() to only work on XLFD names under Unix. */ fontPtr = InitFont(tkwin, pattern, NULL); if (!fontPtr) { FcPatternDestroy(pattern); return NULL; } return &fontPtr->font; } TkFont * TkpGetFontFromAttributes( TkFont *tkFontPtr, /* If non-NULL, store the information in this * existing TkFont structure, rather than * allocating a new structure to hold the * font; the existing contents of the font * will be released. If NULL, a new TkFont * structure is allocated. */ Tk_Window tkwin, /* For display where font will be used. */ CONST TkFontAttributes *faPtr) /* Set of attributes to match. */ { XftPattern *pattern; int weight, slant; UnixFtFont *fontPtr; #if DEBUG_FONTSEL printf("TkpGetFontFromAttributes %s-%d %d %d\n", faPtr->family, faPtr->size, faPtr->weight, faPtr->slant); #endif /* DEBUG_FONTSEL */ pattern = XftPatternCreate(); if (faPtr->family) { XftPatternAddString(pattern, XFT_FAMILY, faPtr->family); } if (faPtr->size > 0) { XftPatternAddDouble(pattern, XFT_SIZE, (double)faPtr->size); } else if (faPtr->size < 0) { XftPatternAddInteger(pattern, XFT_PIXEL_SIZE, -faPtr->size); } else { XftPatternAddDouble(pattern, XFT_SIZE, 12.0); } switch (faPtr->weight) { case TK_FW_NORMAL: default: weight = XFT_WEIGHT_MEDIUM; break; case TK_FW_BOLD: weight = XFT_WEIGHT_BOLD; break; } XftPatternAddInteger(pattern, XFT_WEIGHT, weight); switch (faPtr->slant) { case TK_FS_ROMAN: default: slant = XFT_SLANT_ROMAN; break; case TK_FS_ITALIC: slant = XFT_SLANT_ITALIC; break; case TK_FS_OBLIQUE: slant = XFT_SLANT_OBLIQUE; break; } XftPatternAddInteger(pattern, XFT_SLANT, slant); fontPtr = (UnixFtFont *) tkFontPtr; if (fontPtr != NULL) { FinishedWithFont(fontPtr); } fontPtr = InitFont(tkwin, pattern, fontPtr); /* * Hack to work around issues with weird issues with Xft/Xrender * connection. For details, see comp.lang.tcl thread starting from * */ if (!fontPtr) { XftPatternAddBool(pattern, XFT_RENDER, FcFalse); fontPtr = InitFont(tkwin, pattern, fontPtr); } if (!fontPtr) { FcPatternDestroy(pattern); return NULL; } fontPtr->font.fa.underline = faPtr->underline; fontPtr->font.fa.overstrike = faPtr->overstrike; return &fontPtr->font; } void TkpDeleteFont( TkFont *tkFontPtr) /* Token of font to be deleted. */ { UnixFtFont *fontPtr = (UnixFtFont *) tkFontPtr; FinishedWithFont(fontPtr); /* XXX tkUnixFont.c doesn't free tkFontPtr... */ } /* *--------------------------------------------------------------------------- * * TkpGetFontFamilies -- * * Return information about the font families that are available on the * display of the given window. * * Results: * Modifies interp's result object to hold a list of all the available * font families. * *--------------------------------------------------------------------------- */ void TkpGetFontFamilies( Tcl_Interp *interp, /* Interp to hold result. */ Tk_Window tkwin) /* For display to query. */ { Tcl_Obj *resultPtr; XftFontSet *list; int i; resultPtr = Tcl_NewListObj(0, NULL); list = XftListFonts(Tk_Display(tkwin), Tk_ScreenNumber(tkwin), (char*)0, /* pattern elements */ XFT_FAMILY, (char*)0); /* fields */ for (i = 0; i < list->nfont; i++) { char *family, **familyPtr = &family; if (XftPatternGetString(list->fonts[i], XFT_FAMILY, 0, familyPtr) == XftResultMatch) { Tcl_Obj *strPtr = Tcl_NewStringObj(family, -1); Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } } XftFontSetDestroy(list); Tcl_SetObjResult(interp, resultPtr); } /* *------------------------------------------------------------------------- * * TkpGetSubFonts -- * * Called by [testfont subfonts] in the Tk testing package. * * Results: * Sets interp's result to a list of the faces used by tkfont * *------------------------------------------------------------------------- */ void TkpGetSubFonts( Tcl_Interp *interp, Tk_Font tkfont) { Tcl_Obj *objv[3], *listPtr, *resultPtr; UnixFtFont *fontPtr = (UnixFtFont *) tkfont; FcPattern *pattern; char *family = "Unknown", **familyPtr = &family; char *foundry = "Unknown", **foundryPtr = &foundry; char *encoding = "Unknown", **encodingPtr = &encoding; int i; resultPtr = Tcl_NewListObj(0, NULL); for (i = 0; i < fontPtr->nfaces ; ++i) { pattern = FcFontRenderPrepare(0, fontPtr->pattern, fontPtr->faces[i].source); XftPatternGetString(pattern, XFT_FAMILY, 0, familyPtr); XftPatternGetString(pattern, XFT_FOUNDRY, 0, foundryPtr); XftPatternGetString(pattern, XFT_ENCODING, 0, encodingPtr); objv[0] = Tcl_NewStringObj(family, -1); objv[1] = Tcl_NewStringObj(foundry, -1); objv[2] = Tcl_NewStringObj(encoding, -1); listPtr = Tcl_NewListObj(3, objv); Tcl_ListObjAppendElement(NULL, resultPtr, listPtr); } Tcl_SetObjResult(interp, resultPtr); } /* *---------------------------------------------------------------------- * * TkpGetFontAttrsForChar -- * * Retrieve the font attributes of the actual font used to render a given * character. * *---------------------------------------------------------------------- */ void TkpGetFontAttrsForChar( Tk_Window tkwin, /* Window on the font's display */ Tk_Font tkfont, /* Font to query */ Tcl_UniChar c, /* Character of interest */ TkFontAttributes *faPtr) /* Output: Font attributes */ { UnixFtFont *fontPtr = (UnixFtFont *) tkfont; /* Structure describing the logical font */ FcChar32 ucs4 = (FcChar32) c; /* UCS-4 character to map */ XftFont *ftFont = GetFont(fontPtr, ucs4); /* Actual font used to render the character */ GetTkFontAttributes(ftFont, faPtr); faPtr->underline = fontPtr->font.fa.underline; faPtr->overstrike = fontPtr->font.fa.overstrike; } int Tk_MeasureChars( Tk_Font tkfont, /* Font in which characters will be drawn. */ CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string. */ int maxLength, /* If >= 0, maxLength specifies the longest * permissible line length in pixels; don't * consider any character that would cross * this x-position. If < 0, then line length * is unbounded and the flags argument is * ignored. */ int flags, /* Various flag bits OR-ed together: * TK_PARTIAL_OK means include the last char * which only partially fit on this line. * TK_WHOLE_WORDS means stop on a word * boundary, if possible. TK_AT_LEAST_ONE * means return at least one character even if * no characters fit. */ int *lengthPtr) /* Filled with x-location just after the * terminating character. */ { UnixFtFont *fontPtr = (UnixFtFont *) tkfont; XftFont *ftFont; FcChar32 c; XGlyphInfo extents; int clen, curX, newX, curByte, newByte, sawNonSpace; int termByte = 0, termX = 0; #if DEBUG_FONTSEL char string[256]; int len = 0; #endif /* DEBUG_FONTSEL */ curX = 0; curByte = 0; sawNonSpace = 0; while (numBytes > 0) { Tcl_UniChar unichar; clen = Tcl_UtfToUniChar(source, &unichar); c = (FcChar32)unichar; if (clen <= 0) { /* * This can't happen (but see #1185640) */ *lengthPtr = curX; return curByte; } source += clen; numBytes -= clen; if (c < 256 && isspace(c)) { /* I18N: ??? */ if (sawNonSpace) { termByte = curByte; termX = curX; sawNonSpace = 0; } } else { sawNonSpace = 1; } #if DEBUG_FONTSEL string[len++] = (char) c; #endif /* DEBUG_FONTSEL */ ftFont = GetFont(fontPtr, c); XftTextExtents32(fontPtr->display, ftFont, &c, 1, &extents); newX = curX + extents.xOff; newByte = curByte + clen; if (maxLength >= 0 && newX > maxLength) { if (flags & TK_PARTIAL_OK || (flags & TK_AT_LEAST_ONE && curByte == 0)) { curX = newX; curByte = newByte; } else if (flags & TK_WHOLE_WORDS && termX != 0) { curX = termX; curByte = termByte; } break; } curX = newX; curByte = newByte; } #if DEBUG_FONTSEL string[len] = '\0'; printf("MeasureChars %s length %d bytes %d\n", string, curX, curByte); #endif /* DEBUG_FONTSEL */ *lengthPtr = curX; return curByte; } int TkpMeasureCharsInContext( Tk_Font tkfont, CONST char *source, int numBytes, int rangeStart, int rangeLength, int maxLength, int flags, int *lengthPtr) { (void) numBytes; /*unused*/ return Tk_MeasureChars(tkfont, source + rangeStart, rangeLength, maxLength, flags, lengthPtr); } #define NUM_SPEC 1024 void Tk_DrawChars( Display *display, /* Display on which to draw. */ Drawable drawable, /* Window or pixmap in which to draw. */ GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ CONST char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that * is passed to this function. If they are not * stripped out, they will be displayed as * regular printing characters. */ int numBytes, /* Number of bytes in string. */ int x, int y) /* Coordinates at which to place origin of * string when drawing. */ { const int maxCoord = 0x7FFF;/* Xft coordinates are 16 bit values */ UnixFtFont *fontPtr = (UnixFtFont *) tkfont; XGCValues values; XColor xcolor; int clen, nspec, xStart = x; XftGlyphFontSpec specs[NUM_SPEC]; XGlyphInfo metrics; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (fontPtr->ftDraw == 0) { #if DEBUG_FONTSEL printf("Switch to drawable 0x%x\n", drawable); #endif /* DEBUG_FONTSEL */ fontPtr->ftDraw = XftDrawCreate(display, drawable, DefaultVisual(display, fontPtr->screen), DefaultColormap(display, fontPtr->screen)); } else { Tk_ErrorHandler handler = Tk_CreateErrorHandler(display, -1, -1, -1, NULL, (ClientData) NULL); XftDrawChange(fontPtr->ftDraw, drawable); Tk_DeleteErrorHandler(handler); } XGetGCValues(display, gc, GCForeground, &values); if (values.foreground != fontPtr->color.pixel) { xcolor.pixel = values.foreground; XQueryColor(display, DefaultColormap(display, fontPtr->screen), &xcolor); fontPtr->color.color.red = xcolor.red; fontPtr->color.color.green = xcolor.green; fontPtr->color.color.blue = xcolor.blue; fontPtr->color.color.alpha = 0xffff; fontPtr->color.pixel = values.foreground; } if (tsdPtr->clipRegion != None) { XftDrawSetClip(fontPtr->ftDraw, tsdPtr->clipRegion); } nspec = 0; while (numBytes > 0 && x <= maxCoord && y <= maxCoord) { XftFont *ftFont; FcChar32 c; clen = FcUtf8ToUcs4((FcChar8 *) source, &c, numBytes); if (clen <= 0) { /* * This should not happen, but it can. */ goto doUnderlineStrikeout; } source += clen; numBytes -= clen; ftFont = GetFont(fontPtr, c); if (ftFont) { specs[nspec].font = ftFont; specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); specs[nspec].x = x; specs[nspec].y = y; XftGlyphExtents(fontPtr->display, ftFont, &specs[nspec].glyph, 1, &metrics); x += metrics.xOff; y += metrics.yOff; nspec++; if (nspec == NUM_SPEC) { XftDrawGlyphFontSpec(fontPtr->ftDraw, &fontPtr->color, specs, nspec); nspec = 0; } } } if (nspec) { XftDrawGlyphFontSpec(fontPtr->ftDraw, &fontPtr->color, specs, nspec); } if (tsdPtr->clipRegion != None) { XftDrawSetClip(fontPtr->ftDraw, None); } doUnderlineStrikeout: if (fontPtr->font.fa.underline != 0) { XFillRectangle(display, drawable, gc, xStart, y + fontPtr->font.underlinePos, (unsigned) (x - xStart), (unsigned) fontPtr->font.underlineHeight); } if (fontPtr->font.fa.overstrike != 0) { y -= fontPtr->font.fm.descent + (fontPtr->font.fm.ascent) / 10; XFillRectangle(display, drawable, gc, xStart, y, (unsigned) (x - xStart), (unsigned) fontPtr->font.underlineHeight); } } void TkUnixSetXftClipRegion( TkRegion clipRegion) /* The clipping region to install. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->clipRegion = (Region) clipRegion; } tk8.5.19/unix/tkUnixSelect.c0000644003604700454610000012754112612445655014347 0ustar dgp771div/* * tkUnixSelect.c -- * * This file contains X specific routines for manipulating selections. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" #include "tkSelect.h" typedef struct ConvertInfo { int offset; /* The starting byte offset into the selection * for the next chunk; -1 means all data has * been transferred for this conversion. -2 * means only the final zero-length transfer * still has to be done. Otherwise it is the * offset of the next chunk of data to * transfer. */ Tcl_EncodingState state; /* The encoding state needed across chunks. */ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character * that is split across chunks.*/ } ConvertInfo; /* * When handling INCR-style selection retrievals, the selection owner uses the * following data structure to communicate between the ConvertSelection * function and TkSelPropProc. */ typedef struct IncrInfo { TkWindow *winPtr; /* Window that owns selection. */ Atom selection; /* Selection that is being retrieved. */ Atom *multAtoms; /* Information about conversions to perform: * one or more pairs of (target, property). * This either points to a retrieved property * (for MULTIPLE retrievals) or to a static * array. */ unsigned long numConversions; /* Number of entries in converts (same as # of * pairs in multAtoms). */ ConvertInfo *converts; /* One entry for each pair in multAtoms. This * array is malloc-ed. */ char **tempBufs; /* One pointer for each pair in multAtoms; * each pointer is either NULL, or it points * to a small bit of character data that was * left over from the previous chunk. */ Tcl_EncodingState *state; /* One state info per pair in multAtoms: State * info for encoding conversions that span * multiple buffers. */ int *flags; /* One state flag per pair in multAtoms: * Encoding flags, set to TCL_ENCODING_START * at the beginning of an INCR transfer. */ int numIncrs; /* Number of entries in converts that aren't * -1 (i.e. # of INCR-mode transfers not yet * completed). */ Tcl_TimerToken timeout; /* Token for timer function. */ int idleTime; /* Number of seconds since we heard anything * from the selection requestor. */ Window reqWindow; /* Requestor's window id. */ Time time; /* Timestamp corresponding to selection at * beginning of request; used to abort * transfer if selection changes. */ struct IncrInfo *nextPtr; /* Next in list of all INCR-style retrievals * currently pending. */ } IncrInfo; typedef struct ThreadSpecificData { IncrInfo *pendingIncrs; /* List of all incr structures currently * active. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Largest property that we'll accept when sending or receiving the selection: */ #define MAX_PROP_WORDS 100000 static TkSelRetrievalInfo *pendingRetrievals = NULL; /* List of all retrievals currently being * waited for. */ /* * Forward declarations for functions defined in this file: */ static void ConvertSelection(TkWindow *winPtr, XSelectionRequestEvent *eventPtr); static void IncrTimeoutProc(ClientData clientData); static void SelCvtFromX32(long *propPtr, int numValues, Atom type, Tk_Window tkwin, Tcl_DString *dsPtr); static void SelCvtFromX8(char *propPtr, int numValues, Atom type, Tk_Window tkwin, Tcl_DString *dsPtr); static long * SelCvtToX(char *string, Atom type, Tk_Window tkwin, int *numLongsPtr); static int SelectionSize(TkSelHandler *selPtr); static void SelRcvIncrProc(ClientData clientData, XEvent *eventPtr); static void SelTimeoutProc(ClientData clientData); /* *---------------------------------------------------------------------- * * TkSelGetSelection -- * * Retrieve the specified selection from another process. * * Results: * The return value is a standard Tcl return value. If an error occurs * (such as no selection exists) then an error message is left in the * interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkSelGetSelection( Tcl_Interp *interp, /* Interpreter to use for reporting errors. */ Tk_Window tkwin, /* Window on whose behalf to retrieve the * selection (determines display from which to * retrieve). */ Atom selection, /* Selection to retrieve. */ Atom target, /* Desired form in which selection is to be * returned. */ Tk_GetSelProc *proc, /* Function to call to process the selection, * once it has been retrieved. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { TkSelRetrievalInfo retr; TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; /* * The selection is owned by some other process. To retrieve it, first * record information about the retrieval in progress. Use an internal * window as the requestor. */ retr.interp = interp; if (dispPtr->clipWindow == NULL) { int result; result = TkClipInit(interp, dispPtr); if (result != TCL_OK) { return result; } } retr.winPtr = (TkWindow *) dispPtr->clipWindow; retr.selection = selection; retr.property = selection; retr.target = target; retr.proc = proc; retr.clientData = clientData; retr.result = -1; retr.idleTime = 0; retr.encFlags = TCL_ENCODING_START; retr.nextPtr = pendingRetrievals; Tcl_DStringInit(&retr.buf); pendingRetrievals = &retr; /* * Initiate the request for the selection. Note: can't use TkCurrentTime * for the time. If we do, and this application hasn't received any X * events in a long time, the current time will be way in the past and * could even predate the time when the selection was made; if this * happens, the request will be rejected. */ XConvertSelection(winPtr->display, retr.selection, retr.target, retr.property, retr.winPtr->window, CurrentTime); /* * Enter a loop processing X events until the selection has been retrieved * and processed. If no response is received within a few seconds, then * timeout. */ retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc, (ClientData) &retr); while (retr.result == -1) { Tcl_DoOneEvent(0); } Tcl_DeleteTimerHandler(retr.timeout); /* * Unregister the information about the selection retrieval in progress. */ if (pendingRetrievals == &retr) { pendingRetrievals = retr.nextPtr; } else { TkSelRetrievalInfo *retrPtr; for (retrPtr = pendingRetrievals; retrPtr != NULL; retrPtr = retrPtr->nextPtr) { if (retrPtr->nextPtr == &retr) { retrPtr->nextPtr = retr.nextPtr; break; } } } Tcl_DStringFree(&retr.buf); return retr.result; } /* *---------------------------------------------------------------------- * * TkSelPropProc -- * * This function is invoked when property-change events occur on windows * not known to the toolkit. Its function is to implement the sending * side of the INCR selection retrieval protocol when the selection * requestor deletes the property containing a part of the selection. * * Results: * None. * * Side effects: * If the property that is receiving the selection was just deleted, then * a new piece of the selection is fetched and placed in the property, * until eventually there's no more selection to fetch. * *---------------------------------------------------------------------- */ void TkSelPropProc( register XEvent *eventPtr) /* X PropertyChange event. */ { register IncrInfo *incrPtr; register TkSelHandler *selPtr; int length, numItems; unsigned long i; Atom target, formatType; long buffer[TK_SEL_WORDS_AT_ONCE]; TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display); Tk_ErrorHandler errorHandler; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * See if this event announces the deletion of a property being used for * an INCR transfer. If so, then add the next chunk of data to the * property. */ if (eventPtr->xproperty.state != PropertyDelete) { return; } for (incrPtr = tsdPtr->pendingIncrs; incrPtr != NULL; incrPtr = incrPtr->nextPtr) { if (incrPtr->reqWindow != eventPtr->xproperty.window) { continue; } /* * For each conversion that has been requested, handle any chunks that * haven't been transmitted yet. */ for (i = 0; i < incrPtr->numConversions; i++) { if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1]) || (incrPtr->converts[i].offset == -1)) { continue; } target = incrPtr->multAtoms[2*i]; incrPtr->idleTime = 0; /* * Look for a matching selection handler. */ for (selPtr = incrPtr->winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) { if (selPtr == NULL) { /* * No handlers match, so mark the conversion as done. */ incrPtr->multAtoms[2*i + 1] = None; incrPtr->converts[i].offset = -1; incrPtr->numIncrs --; return; } if ((selPtr->target == target) && (selPtr->selection == incrPtr->selection)) { break; } } /* * We found a handler, so get the next chunk from it. */ formatType = selPtr->format; if (incrPtr->converts[i].offset == -2) { /* * We already got the last chunk, so send a null chunk to * indicate that we are finished. */ numItems = 0; length = 0; } else { TkSelInProgress ip; ip.selPtr = selPtr; ip.nextPtr = TkSelGetInProgress(); TkSelSetInProgress(&ip); /* * Copy any bytes left over from a partial character at the * end of the previous chunk into the beginning of the buffer. * Pass the rest of the buffer space into the selection * handler. */ length = strlen(incrPtr->converts[i].buffer); strcpy((char *)buffer, incrPtr->converts[i].buffer); numItems = (*selPtr->proc)(selPtr->clientData, incrPtr->converts[i].offset, ((char *) buffer) + length, TK_SEL_BYTES_AT_ONCE - length); TkSelSetInProgress(ip.nextPtr); if (ip.selPtr == NULL) { /* * The selection handler deleted itself. */ return; } if (numItems < 0) { numItems = 0; } numItems += length; if (numItems > TK_SEL_BYTES_AT_ONCE) { Tcl_Panic("selection handler returned too many bytes"); } } ((char *) buffer)[numItems] = 0; errorHandler = Tk_CreateErrorHandler(eventPtr->xproperty.display, -1, -1, -1, (int (*)()) NULL, NULL); /* * Encode the data using the proper format for each type. */ if ((formatType == XA_STRING) || (dispPtr && formatType==dispPtr->utf8Atom) || (dispPtr && formatType==dispPtr->compoundTextAtom)) { Tcl_DString ds; int encodingCvtFlags; int srcLen, dstLen, result, srcRead, dstWrote, soFar; char *src, *dst; Tcl_Encoding encoding; /* * Set up the encoding state based on the format and whether * this is the first and/or last chunk. */ encodingCvtFlags = 0; if (incrPtr->converts[i].offset == 0) { encodingCvtFlags |= TCL_ENCODING_START; } if (numItems < TK_SEL_BYTES_AT_ONCE) { encodingCvtFlags |= TCL_ENCODING_END; } if (formatType == XA_STRING) { encoding = Tcl_GetEncoding(NULL, "iso8859-1"); } else if (dispPtr && formatType==dispPtr->utf8Atom) { encoding = Tcl_GetEncoding(NULL, "utf-8"); } else { encoding = Tcl_GetEncoding(NULL, "iso2022"); } /* * Now convert the data. */ src = (char *)buffer; srcLen = numItems; Tcl_DStringInit(&ds); dst = Tcl_DStringValue(&ds); dstLen = ds.spaceAvl - 1; /* * Now convert the data, growing the destination buffer as * needed. */ while (1) { result = Tcl_UtfToExternal(NULL, encoding, src, srcLen, encodingCvtFlags, &incrPtr->converts[i].state, dst, dstLen, &srcRead, &dstWrote, NULL); soFar = dst + dstWrote - Tcl_DStringValue(&ds); encodingCvtFlags &= ~TCL_ENCODING_START; src += srcRead; srcLen -= srcRead; if (result != TCL_CONVERT_NOSPACE) { Tcl_DStringSetLength(&ds, soFar); break; } if (Tcl_DStringLength(&ds) == 0) { Tcl_DStringSetLength(&ds, dstLen); } Tcl_DStringSetLength(&ds, 2 * Tcl_DStringLength(&ds) + 1); dst = Tcl_DStringValue(&ds) + soFar; dstLen = Tcl_DStringLength(&ds) - soFar - 1; } Tcl_DStringSetLength(&ds, soFar); if (encoding) { Tcl_FreeEncoding(encoding); } /* * Set the property to the encoded string value. */ XChangeProperty(eventPtr->xproperty.display, eventPtr->xproperty.window, eventPtr->xproperty.atom, formatType, 8, PropModeReplace, (unsigned char *) Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); /* * Preserve any left-over bytes. */ if (srcLen > TCL_UTF_MAX) { Tcl_Panic("selection conversion left too many bytes unconverted"); } memcpy(incrPtr->converts[i].buffer, src, (size_t) srcLen+1); Tcl_DStringFree(&ds); } else { /* * Set the property to the encoded string value. */ char *propPtr = (char *) SelCvtToX((char *) buffer, formatType, (Tk_Window) incrPtr->winPtr, &numItems); if (propPtr == NULL) { numItems = 0; } XChangeProperty(eventPtr->xproperty.display, eventPtr->xproperty.window, eventPtr->xproperty.atom, formatType, 32, PropModeReplace, (unsigned char *) propPtr, numItems); if (propPtr != NULL) { ckfree(propPtr); } } Tk_DeleteErrorHandler(errorHandler); /* * Compute the next offset value. If this was the last chunk, then * set the offset to -2. If this was an empty chunk, then set the * offset to -1 to indicate we are done. */ if (numItems < TK_SEL_BYTES_AT_ONCE) { if (numItems <= 0) { incrPtr->converts[i].offset = -1; incrPtr->numIncrs--; } else { incrPtr->converts[i].offset = -2; } } else { /* * Advance over the selection data that was consumed this * time. */ incrPtr->converts[i].offset += numItems - length; } return; } } } /* *-------------------------------------------------------------- * * TkSelEventProc -- * * This function is invoked whenever a selection-related event occurs. * It does the lion's share of the work in implementing the selection * protocol. * * Results: * None. * * Side effects: * Lots: depends on the type of event. * *-------------------------------------------------------------- */ void TkSelEventProc( Tk_Window tkwin, /* Window for which event was targeted. */ register XEvent *eventPtr) /* X event: either SelectionClear, * SelectionRequest, or SelectionNotify. */ { register TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; Tcl_Interp *interp; /* * Case #1: SelectionClear events. */ if (eventPtr->type == SelectionClear) { TkSelClearSelection(tkwin, eventPtr); } /* * Case #2: SelectionNotify events. Call the relevant function to handle * the incoming selection. */ if (eventPtr->type == SelectionNotify) { register TkSelRetrievalInfo *retrPtr; char *propInfo, **propInfoPtr = &propInfo; Atom type; int format, result; unsigned long numItems, bytesAfter; Tcl_DString ds; for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) { if (retrPtr == NULL) { return; } if ((retrPtr->winPtr == winPtr) && (retrPtr->selection == eventPtr->xselection.selection) && (retrPtr->target == eventPtr->xselection.target) && (retrPtr->result == -1)) { if (retrPtr->property == eventPtr->xselection.property) { break; } if (eventPtr->xselection.property == None) { Tcl_SetResult(retrPtr->interp, NULL, TCL_STATIC); Tcl_AppendResult(retrPtr->interp, Tk_GetAtomName(tkwin, retrPtr->selection), " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, retrPtr->target), "\" not defined", NULL); retrPtr->result = TCL_ERROR; return; } } } propInfo = NULL; result = XGetWindowProperty(eventPtr->xselection.display, eventPtr->xselection.requestor, retrPtr->property, 0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType, &type, &format, &numItems, &bytesAfter, (unsigned char **) propInfoPtr); if ((result != Success) || (type == None)) { return; } if (bytesAfter != 0) { Tcl_SetResult(retrPtr->interp, "selection property too large", TCL_STATIC); retrPtr->result = TCL_ERROR; XFree(propInfo); return; } if ((type == XA_STRING) || (type == dispPtr->textAtom) || (type == dispPtr->compoundTextAtom)) { Tcl_Encoding encoding; 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; } interp = retrPtr->interp; Tcl_Preserve((ClientData) interp); /* * Convert the X selection data into UTF before passing it to the * selection callback. Note that the COMPOUND_TEXT uses a modified * iso2022 encoding, not the current system encoding. For now * we'll just blindly apply the iso2022 encoding. This is probably * wrong, but it's a placeholder until we figure out what we're * really supposed to do. For STRING, we need to use Latin-1 * instead. Again, it's not really the full iso8859-1 space, but * this is close enough. */ if (type == dispPtr->compoundTextAtom) { encoding = Tcl_GetEncoding(NULL, "iso2022"); } else { encoding = Tcl_GetEncoding(NULL, "iso8859-1"); } Tcl_ExternalToUtfDString(encoding, propInfo, (int)numItems, &ds); if (encoding) { Tcl_FreeEncoding(encoding); } retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, 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) { /* * It's a !?#@!?!! INCR-style reception. Arrange to receive the * selection in pieces, using the ICCCM protocol, then hang around * until either the selection is all here or a timeout occurs. */ retrPtr->idleTime = 0; Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc, (ClientData) retrPtr); XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin), retrPtr->property); while (retrPtr->result == -1) { Tcl_DoOneEvent(0); } Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc, (ClientData) retrPtr); } else { Tcl_DString ds; if (format != 32 && format != 8) { char buf[64 + TCL_INTEGER_SPACE]; sprintf(buf, "bad format for selection: wanted \"32\" or " "\"8\", got \"%d\"", format); Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); retrPtr->result = TCL_ERROR; return; } Tcl_DStringInit(&ds); if (format == 32) { SelCvtFromX32((long *) propInfo, (int) numItems, type, (Tk_Window) winPtr, &ds); } else { SelCvtFromX8((char *) propInfo, (int) numItems, type, (Tk_Window) winPtr, &ds); } interp = retrPtr->interp; Tcl_Preserve((ClientData) interp); retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, interp, Tcl_DStringValue(&ds)); Tcl_Release((ClientData) interp); Tcl_DStringFree(&ds); } XFree(propInfo); return; } /* * Case #3: SelectionRequest events. Call ConvertSelection to do the dirty * work. */ if (eventPtr->type == SelectionRequest) { ConvertSelection(winPtr, &eventPtr->xselectionrequest); return; } } /* *---------------------------------------------------------------------- * * SelTimeoutProc -- * * This function is invoked once every second while waiting for the * selection to be returned. After a while it gives up and aborts the * selection retrieval. * * Results: * None. * * Side effects: * A new timer callback is created to call us again in another second, * unless time has expired, in which case an error is recorded for the * retrieval. * *---------------------------------------------------------------------- */ static void SelTimeoutProc( ClientData clientData) /* Information about retrieval in progress. */ { register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; /* * Make sure that the retrieval is still in progress. Then see how long * it's been since any sort of response was received from the other side. */ if (retrPtr->result != -1) { return; } retrPtr->idleTime++; if (retrPtr->idleTime >= 5) { /* * Use a careful function to store the error message, because the * result could already be partially filled in with a partial * selection return. */ Tcl_SetResult(retrPtr->interp, "selection owner didn't respond", TCL_STATIC); retrPtr->result = TCL_ERROR; } else { retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc, (ClientData) retrPtr); } } /* *---------------------------------------------------------------------- * * ConvertSelection -- * * This function is invoked to handle SelectionRequest events. It * responds to the requests, obeying the ICCCM protocols. * * Results: * None. * * Side effects: * Properties are created for the selection requestor, and a * SelectionNotify event is generated for the selection requestor. In the * event of long selections, this function implements INCR-mode * transfers, using the ICCCM protocol. * *---------------------------------------------------------------------- */ static void ConvertSelection( TkWindow *winPtr, /* Window that received the conversion * request; may not be selection's current * owner, be we set it to the current * owner. */ register XSelectionRequestEvent *eventPtr) /* Event describing request. */ { XSelectionEvent reply; /* Used to notify requestor that selection * info is ready. */ int multiple; /* Non-zero means a MULTIPLE request is being * handled. */ IncrInfo incr; /* State of selection conversion. */ Atom singleInfo[2]; /* incr.multAtoms points here except for * multiple conversions. */ unsigned long i; Tk_ErrorHandler errorHandler; TkSelectionInfo *infoPtr; TkSelInProgress ip; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1, (int (*)()) NULL, NULL); /* * Initialize the reply event. */ reply.type = SelectionNotify; reply.serial = 0; reply.send_event = True; reply.display = eventPtr->display; reply.requestor = eventPtr->requestor; reply.selection = eventPtr->selection; reply.target = eventPtr->target; reply.property = eventPtr->property; if (reply.property == None) { reply.property = reply.target; } reply.time = eventPtr->time; for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->selection == eventPtr->selection) { break; } } if (infoPtr == NULL) { goto refuse; } winPtr = (TkWindow *) infoPtr->owner; /* * Figure out which kind(s) of conversion to perform. If handling a * MULTIPLE conversion, then read the property describing which * conversions to perform. */ incr.winPtr = winPtr; incr.selection = eventPtr->selection; if (eventPtr->target != winPtr->dispPtr->multipleAtom) { multiple = 0; singleInfo[0] = reply.target; singleInfo[1] = reply.property; incr.multAtoms = singleInfo; incr.numConversions = 1; } else { Atom type, **multAtomsPtr = &incr.multAtoms; int format, result; unsigned long bytesAfter; multiple = 1; incr.multAtoms = NULL; if (eventPtr->property == None) { goto refuse; } result = XGetWindowProperty(eventPtr->display, eventPtr->requestor, eventPtr->property, 0, MAX_PROP_WORDS, False, XA_ATOM, &type, &format, &incr.numConversions, &bytesAfter, (unsigned char **) multAtomsPtr); if ((result != Success) || (bytesAfter != 0) || (format != 32) || (type == None)) { if (incr.multAtoms != NULL) { XFree((char *) incr.multAtoms); } goto refuse; } incr.numConversions /= 2; /* Two atoms per conversion. */ } /* * Loop through all of the requested conversions, and either return the * entire converted selection, if it can be returned in a single bunch, or * return INCR information only (the actual selection will be returned * below). */ incr.converts = (ConvertInfo *) ckalloc((unsigned) incr.numConversions * sizeof(ConvertInfo)); incr.numIncrs = 0; for (i = 0; i < incr.numConversions; i++) { Atom target, property, type; long buffer[TK_SEL_WORDS_AT_ONCE]; register TkSelHandler *selPtr; int numItems, format; char *propPtr; target = incr.multAtoms[2*i]; property = incr.multAtoms[2*i + 1]; incr.converts[i].offset = -1; incr.converts[i].buffer[0] = '\0'; for (selPtr = winPtr->selHandlerList; selPtr != NULL; selPtr = selPtr->nextPtr) { if ((selPtr->target == target) && (selPtr->selection == eventPtr->selection)) { break; } } if (selPtr == NULL) { /* * Nobody seems to know about this kind of request. If it's of a * sort that we can handle without any help, do it. Otherwise mark * the request as an errror. */ numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer, TK_SEL_BYTES_AT_ONCE, &type); if (numItems < 0) { incr.multAtoms[2*i + 1] = None; continue; } } else { ip.selPtr = selPtr; ip.nextPtr = TkSelGetInProgress(); TkSelSetInProgress(&ip); type = selPtr->format; numItems = (*selPtr->proc)(selPtr->clientData, 0, (char *) buffer, TK_SEL_BYTES_AT_ONCE); TkSelSetInProgress(ip.nextPtr); if ((ip.selPtr == NULL) || (numItems < 0)) { incr.multAtoms[2*i + 1] = None; continue; } if (numItems > TK_SEL_BYTES_AT_ONCE) { Tcl_Panic("selection handler returned too many bytes"); } ((char *) buffer)[numItems] = '\0'; } /* * Got the selection; store it back on the requestor's property. */ if (numItems == TK_SEL_BYTES_AT_ONCE) { /* * Selection is too big to send at once; start an INCR-mode * transfer. */ incr.numIncrs++; type = winPtr->dispPtr->incrAtom; buffer[0] = SelectionSize(selPtr); if (buffer[0] == 0) { incr.multAtoms[2*i + 1] = None; continue; } numItems = 1; propPtr = (char *) buffer; format = 32; incr.converts[i].offset = 0; 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; Tcl_Encoding encoding; /* * STRING is Latin-1, COMPOUND_TEXT is an iso2022 variant. We need * to convert the selection text into these external forms before * modifying the property. */ if (type == XA_STRING) { encoding = Tcl_GetEncoding(NULL, "iso8859-1"); } else { encoding = Tcl_GetEncoding(NULL, "iso2022"); } Tcl_UtfToExternalDString(encoding, (char *) buffer, -1, &ds); XChangeProperty(reply.display, reply.requestor, property, type, 8, PropModeReplace, (unsigned char *) Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); if (encoding) { Tcl_FreeEncoding(encoding); } Tcl_DStringFree(&ds); } else { propPtr = (char *) SelCvtToX((char *) buffer, type, (Tk_Window) winPtr, &numItems); if (propPtr == NULL) { goto refuse; } format = 32; XChangeProperty(reply.display, reply.requestor, property, type, format, PropModeReplace, (unsigned char *) propPtr, numItems); ckfree(propPtr); } } /* * Send an event back to the requestor to indicate that the first stage of * conversion is complete (everything is done except for long conversions * that have to be done in INCR mode). */ if (incr.numIncrs > 0) { XSelectInput(reply.display, reply.requestor, PropertyChangeMask); incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, (ClientData) &incr); incr.idleTime = 0; incr.reqWindow = reply.requestor; incr.time = infoPtr->time; incr.nextPtr = tsdPtr->pendingIncrs; tsdPtr->pendingIncrs = &incr; } if (multiple) { XChangeProperty(reply.display, reply.requestor, reply.property, XA_ATOM, 32, PropModeReplace, (unsigned char *) incr.multAtoms, (int) incr.numConversions*2); } else { /* * Not a MULTIPLE request. The first property in "multAtoms" got set * to None if there was an error in conversion. */ reply.property = incr.multAtoms[1]; } XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply); Tk_DeleteErrorHandler(errorHandler); /* * Handle any remaining INCR-mode transfers. This all happens in callbacks * to TkSelPropProc, so just wait until the number of uncompleted INCR * transfers drops to zero. */ if (incr.numIncrs > 0) { IncrInfo *incrPtr2; while (incr.numIncrs > 0) { Tcl_DoOneEvent(0); } Tcl_DeleteTimerHandler(incr.timeout); errorHandler = Tk_CreateErrorHandler(winPtr->display, -1, -1,-1, (int (*)()) NULL, NULL); XSelectInput(reply.display, reply.requestor, 0L); Tk_DeleteErrorHandler(errorHandler); if (tsdPtr->pendingIncrs == &incr) { tsdPtr->pendingIncrs = incr.nextPtr; } else { for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL; incrPtr2 = incrPtr2->nextPtr) { if (incrPtr2->nextPtr == &incr) { incrPtr2->nextPtr = incr.nextPtr; break; } } } } /* * All done. Cleanup and return. */ ckfree((char *) incr.converts); if (multiple) { XFree((char *) incr.multAtoms); } return; /* * An error occurred. Send back a refusal message. */ refuse: reply.property = None; XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply); Tk_DeleteErrorHandler(errorHandler); return; } /* *---------------------------------------------------------------------- * * SelRcvIncrProc -- * * This function handles the INCR protocol on the receiving side. It is * invoked in response to property changes on the requestor's window * (which hopefully are because a new chunk of the selection arrived). * * Results: * None. * * Side effects: * If a new piece of selection has arrived, a function is invoked to deal * with that piece. When the whole selection is here, a flag is left for * the higher-level function that initiated the selection retrieval. * *---------------------------------------------------------------------- */ static void SelRcvIncrProc( ClientData clientData, /* Information about retrieval. */ register XEvent *eventPtr) /* X PropertyChange event. */ { register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; char *propInfo, **propInfoPtr = &propInfo; Atom type; int format, result; unsigned long numItems, bytesAfter; Tcl_Interp *interp; if ((eventPtr->xproperty.atom != retrPtr->property) || (eventPtr->xproperty.state != PropertyNewValue) || (retrPtr->result != -1)) { return; } propInfo = NULL; result = XGetWindowProperty(eventPtr->xproperty.display, eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS, True, (Atom) AnyPropertyType, &type, &format, &numItems, &bytesAfter, (unsigned char **) propInfoPtr); if ((result != Success) || (type == None)) { return; } if (bytesAfter != 0) { Tcl_SetResult(retrPtr->interp, "selection property too large", TCL_STATIC); retrPtr->result = TCL_ERROR; goto done; } if ((type == XA_STRING) || (type == retrPtr->winPtr->dispPtr->textAtom) || (type == retrPtr->winPtr->dispPtr->utf8Atom) || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) { char *dst, *src; int srcLen, dstLen, srcRead, dstWrote, soFar; Tcl_Encoding encoding; Tcl_DString *dstPtr, temp; 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; goto done; } interp = retrPtr->interp; Tcl_Preserve((ClientData) interp); if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) { encoding = Tcl_GetEncoding(NULL, "iso2022"); } else if (type == retrPtr->winPtr->dispPtr->utf8Atom) { encoding = Tcl_GetEncoding(NULL, "utf-8"); } else { encoding = Tcl_GetEncoding(NULL, "iso8859-1"); } /* * Check to see if there is any data left over from the previous * chunk. If there is, copy the old data and the new data into a new * buffer. */ Tcl_DStringInit(&temp); if (Tcl_DStringLength(&retrPtr->buf) > 0) { Tcl_DStringAppend(&temp, Tcl_DStringValue(&retrPtr->buf), Tcl_DStringLength(&retrPtr->buf)); if (numItems > 0) { Tcl_DStringAppend(&temp, propInfo, (int)numItems); } src = Tcl_DStringValue(&temp); srcLen = Tcl_DStringLength(&temp); } else if (numItems == 0) { /* * There is no new data, so we're done. */ retrPtr->result = TCL_OK; Tcl_Release((ClientData) interp); goto done; } else { src = propInfo; srcLen = numItems; } /* * Set up the destination buffer so we can use as much space as is * available. */ dstPtr = &retrPtr->buf; dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; /* * Now convert the data, growing the destination buffer as needed. */ while (1) { result = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, retrPtr->encFlags, &retrPtr->encState, dst, dstLen, &srcRead, &dstWrote, NULL); soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); retrPtr->encFlags &= ~TCL_ENCODING_START; src += srcRead; srcLen -= srcRead; if (result != TCL_CONVERT_NOSPACE) { Tcl_DStringSetLength(dstPtr, soFar); break; } if (Tcl_DStringLength(dstPtr) == 0) { Tcl_DStringSetLength(dstPtr, dstLen); } Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1); dst = Tcl_DStringValue(dstPtr) + soFar; dstLen = Tcl_DStringLength(dstPtr) - soFar - 1; } Tcl_DStringSetLength(dstPtr, soFar); result = (*retrPtr->proc)(retrPtr->clientData, interp, Tcl_DStringValue(dstPtr)); Tcl_Release((ClientData) interp); /* * Copy any unused data into the destination buffer so we can pick it * up next time around. */ Tcl_DStringSetLength(dstPtr, 0); Tcl_DStringAppend(dstPtr, src, srcLen); Tcl_DStringFree(&temp); if (encoding) { Tcl_FreeEncoding(encoding); } if (result != TCL_OK) { retrPtr->result = result; } } else if (numItems == 0) { retrPtr->result = TCL_OK; } else { Tcl_DString ds; if (format != 32 && format != 8) { char buf[64 + TCL_INTEGER_SPACE]; sprintf(buf, "bad format for selection: wanted \"32\" or " "\"8\", got \"%d\"", format); Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); retrPtr->result = TCL_ERROR; goto done; } Tcl_DStringInit(&ds); if (format == 32) { SelCvtFromX32((long *) propInfo, (int) numItems, type, (Tk_Window) retrPtr->winPtr, &ds); } else { SelCvtFromX8((char *) propInfo, (int) numItems, type, (Tk_Window) retrPtr->winPtr, &ds); } interp = retrPtr->interp; Tcl_Preserve((ClientData) interp); result = (*retrPtr->proc)(retrPtr->clientData, interp, Tcl_DStringValue(&ds)); Tcl_Release((ClientData) interp); Tcl_DStringFree(&ds); if (result != TCL_OK) { retrPtr->result = result; } } done: XFree(propInfo); retrPtr->idleTime = 0; } /* *---------------------------------------------------------------------- * * SelectionSize -- * * This function is called when the selection is too large to send in a * single buffer; it computes the total length of the selection in bytes. * * Results: * The return value is the number of bytes in the selection given by * selPtr. * * Side effects: * The selection is retrieved from its current owner (this is the only * way to compute its size). * *---------------------------------------------------------------------- */ static int SelectionSize( TkSelHandler *selPtr) /* Information about how to retrieve the * selection whose size is wanted. */ { char buffer[TK_SEL_BYTES_AT_ONCE+1]; int size, chunkSize; TkSelInProgress ip; size = TK_SEL_BYTES_AT_ONCE; ip.selPtr = selPtr; ip.nextPtr = TkSelGetInProgress(); TkSelSetInProgress(&ip); do { chunkSize = (*selPtr->proc)(selPtr->clientData, size, (char *) buffer, TK_SEL_BYTES_AT_ONCE); if (ip.selPtr == NULL) { size = 0; break; } size += chunkSize; } while (chunkSize == TK_SEL_BYTES_AT_ONCE); TkSelSetInProgress(ip.nextPtr); return size; } /* *---------------------------------------------------------------------- * * IncrTimeoutProc -- * * This function is invoked once a second while sending the selection to * a requestor in INCR mode. After a while it gives up and aborts the * selection operation. * * Results: * None. * * Side effects: * A new timeout gets registered so that this function gets called again * in another second, unless too many seconds have elapsed, in which case * incrPtr is marked as "all done". * *---------------------------------------------------------------------- */ static void IncrTimeoutProc( ClientData clientData) /* Information about INCR-mode selection * retrieval for which we are selection * owner. */ { register IncrInfo *incrPtr = (IncrInfo *) clientData; incrPtr->idleTime++; if (incrPtr->idleTime >= 5) { incrPtr->numIncrs = 0; } else { incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, (ClientData) incrPtr); } } /* *---------------------------------------------------------------------- * * SelCvtToX -- * * Given a selection represented as a string (the normal Tcl form), * convert it to the ICCCM-mandated format for X, depending on the type * argument. This function and SelCvtFromX are inverses. * * Results: * The return value is a malloc'ed buffer holding a value equivalent to * "string", but formatted as for "type". It is the caller's * responsibility to free the string when done with it. The word at * *numLongsPtr is filled in with the number of 32-bit words returned in * the result. If NULL is returned, the input list was not actually a * list. * * Side effects: * None. * *---------------------------------------------------------------------- */ static long * SelCvtToX( char *string, /* String representation of selection. */ Atom type, /* Atom specifying the X format that is * desired for the selection. Should not be * XA_STRING (if so, don't bother calling this * function at all). */ Tk_Window tkwin, /* Window that governs atom conversion. */ int *numLongsPtr) /* Number of 32-bit words contained in the * result. */ { const char **field; int numFields, i; long *propPtr; /* * The string is assumed to consist of fields separated by spaces. The * property gets generated by converting each field to an integer number, * in one of two ways: * 1. If type is XA_ATOM, convert each field to its corresponding atom. * 2. If type is anything else, convert each field from an ASCII number to * a 32-bit binary number. */ if (Tcl_SplitList(NULL, string, &numFields, &field) != TCL_OK) { return NULL; } propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long)); /* * Convert the fields one-by-one. */ for (i=0 ; i 0; propPtr++, numValues--) { if (type == XA_ATOM) { Tcl_DStringAppendElement(dsPtr, Tk_GetAtomName(tkwin, (Atom) *propPtr)); } else { char buf[12]; sprintf(buf, "0x%x", (unsigned int) *propPtr); Tcl_DStringAppendElement(dsPtr, buf); } } Tcl_DStringAppend(dsPtr, " ", 1); } static void SelCvtFromX8( register char *propPtr, /* Property value from X. */ int numValues, /* Number of 8-bit values in property. */ Atom type, /* Type of property Should not be XA_STRING * (if so, don't bother calling this function * at all). */ Tk_Window tkwin, /* Window to use for atom conversion. */ Tcl_DString *dsPtr) /* Where to store the converted string. */ { /* * Convert each long in the property to a string value, which is a * hexadecimal string. We build the list in a Tcl_DString because this is * easier than trying to get the quoting correct ourselves. */ for ( ; numValues > 0; propPtr++, numValues--) { char buf[12]; sprintf(buf, "0x%x", (unsigned char) *propPtr); Tcl_DStringAppendElement(dsPtr, buf); } Tcl_DStringAppend(dsPtr, " ", 1); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/install-sh0000755003604700454610000003305412656405252013555 0ustar dgp771div#!/bin/sh # install - install a program, script, or datafile scriptversion=2011-04-20.01; # UTC # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the # following copyright and license. # # Copyright (C) 1994 X Consortium # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to # deal in the Software without restriction, including without limitation the # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or # sell copies of the Software, and to permit persons to whom the Software is # furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be included in # all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the name of the X Consortium shall not # be used in advertising or otherwise to promote the sale, use or other deal- # ings in this Software without prior written authorization from the X Consor- # tium. # # # FSF changes to this file are in the public domain. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. nl=' ' IFS=" "" $nl" # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit=${DOITPROG-} if test -z "$doit"; then doit_exec=exec else doit_exec=$doit fi # Put in absolute file names if you don't have them in your path; # or use environment vars. chgrpprog=${CHGRPPROG-chgrp} chmodprog=${CHMODPROG-chmod} chownprog=${CHOWNPROG-chown} cmpprog=${CMPPROG-cmp} cpprog=${CPPROG-cp} mkdirprog=${MKDIRPROG-mkdir} mvprog=${MVPROG-mv} rmprog=${RMPROG-rm} stripprog=${STRIPPROG-strip} posix_glob='?' initialize_posix_glob=' test "$posix_glob" != "?" || { if (set -f) 2>/dev/null; then posix_glob= else posix_glob=: fi } ' posix_mkdir= # Desired mode of installed file. mode=0755 chgrpcmd= chmodcmd=$chmodprog chowncmd= mvcmd=$mvprog rmcmd="$rmprog -f" stripcmd= src= dst= dir_arg= dst_arg= copy_on_change=false no_target_directory= usage="\ Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE or: $0 [OPTION]... SRCFILES... DIRECTORY or: $0 [OPTION]... -t DIRECTORY SRCFILES... or: $0 [OPTION]... -d DIRECTORIES... In the 1st form, copy SRCFILE to DSTFILE. In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. In the 4th, create DIRECTORIES. Options: --help display this help and exit. --version display version info and exit. -c (ignored) -C install only if different (preserve the last data modification time) -d create directories instead of installing files. -g GROUP $chgrpprog installed files to GROUP. -m MODE $chmodprog installed files to MODE. -o USER $chownprog installed files to USER. -s $stripprog installed files. -S $stripprog installed files. -t DIRECTORY install into DIRECTORY. -T report an error if DSTFILE is a directory. Environment variables override the default commands: CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG " while test $# -ne 0; do case $1 in -c) ;; -C) copy_on_change=true;; -d) dir_arg=true;; -g) chgrpcmd="$chgrpprog $2" shift;; --help) echo "$usage"; exit $?;; -m) mode=$2 case $mode in *' '* | *' '* | *' '* | *'*'* | *'?'* | *'['*) echo "$0: invalid mode: $mode" >&2 exit 1;; esac shift;; -o) chowncmd="$chownprog $2" shift;; -s) stripcmd=$stripprog;; -S) stripcmd="$stripprog $2" shift;; -t) dst_arg=$2 shift;; -T) no_target_directory=true;; --version) echo "$0 $scriptversion"; exit $?;; --) shift break;; -*) echo "$0: invalid option: $1" >&2 exit 1;; *) break;; esac shift done if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then # When -d is used, all remaining arguments are directories to create. # When -t is used, the destination is already specified. # Otherwise, the last argument is the destination. Remove it from $@. for arg do if test -n "$dst_arg"; then # $@ is not empty: it contains at least $arg. set fnord "$@" "$dst_arg" shift # fnord fi shift # arg dst_arg=$arg done fi if test $# -eq 0; then if test -z "$dir_arg"; then echo "$0: no input file specified." >&2 exit 1 fi # It's OK to call `install-sh -d' without argument. # This can happen when creating conditional directories. exit 0 fi if test -z "$dir_arg"; then do_exit='(exit $ret); exit $ret' trap "ret=129; $do_exit" 1 trap "ret=130; $do_exit" 2 trap "ret=141; $do_exit" 13 trap "ret=143; $do_exit" 15 # Set umask so as not to create temps with too-generous modes. # However, 'strip' requires both read and write access to temps. case $mode in # Optimize common cases. *644) cp_umask=133;; *755) cp_umask=22;; *[0-7]) if test -z "$stripcmd"; then u_plus_rw= else u_plus_rw='% 200' fi cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; *) if test -z "$stripcmd"; then u_plus_rw= else u_plus_rw=,u+rw fi cp_umask=$mode$u_plus_rw;; esac fi for src do # Protect names starting with `-'. case $src in -*) src=./$src;; esac if test -n "$dir_arg"; then dst=$src dstdir=$dst test -d "$dstdir" dstdir_status=$? else # Waiting for this to be detected by the "$cpprog $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if test ! -f "$src" && test ! -d "$src"; then echo "$0: $src does not exist." >&2 exit 1 fi if test -z "$dst_arg"; then echo "$0: no destination specified." >&2 exit 1 fi dst=$dst_arg # Protect names starting with `-'. case $dst in -*) dst=./$dst;; esac # If destination is a directory, append the input filename; won't work # if double slashes aren't ignored. if test -d "$dst"; then if test -n "$no_target_directory"; then echo "$0: $dst_arg: Is a directory" >&2 exit 1 fi dstdir=$dst dst=$dstdir/`basename "$src"` dstdir_status=0 else # Prefer dirname, but fall back on a substitute if dirname fails. dstdir=` (dirname "$dst") 2>/dev/null || expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$dst" : 'X\(//\)[^/]' \| \ X"$dst" : 'X\(//\)$' \| \ X"$dst" : 'X\(/\)' \| . 2>/dev/null || echo X"$dst" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q' ` test -d "$dstdir" dstdir_status=$? fi fi obsolete_mkdir_used=false if test $dstdir_status != 0; then case $posix_mkdir in '') # Create intermediate dirs using mode 755 as modified by the umask. # This is like FreeBSD 'install' as of 1997-10-28. umask=`umask` case $stripcmd.$umask in # Optimize common cases. *[2367][2367]) mkdir_umask=$umask;; .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; *[0-7]) mkdir_umask=`expr $umask + 22 \ - $umask % 100 % 40 + $umask % 20 \ - $umask % 10 % 4 + $umask % 2 `;; *) mkdir_umask=$umask,go-w;; esac # With -d, create the new directory with the user-specified mode. # Otherwise, rely on $mkdir_umask. if test -n "$dir_arg"; then mkdir_mode=-m$mode else mkdir_mode= fi posix_mkdir=false case $umask in *[123567][0-7][0-7]) # POSIX mkdir -p sets u+wx bits regardless of umask, which # is incompatible with FreeBSD 'install' when (umask & 300) != 0. ;; *) tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 if (umask $mkdir_umask && exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 then if test -z "$dir_arg" || { # Check for POSIX incompatibilities with -m. # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or # other-writeable bit of parent directory when it shouldn't. # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. ls_ld_tmpdir=`ls -ld "$tmpdir"` case $ls_ld_tmpdir in d????-?r-*) different_mode=700;; d????-?--*) different_mode=755;; *) false;; esac && $mkdirprog -m$different_mode -p -- "$tmpdir" && { ls_ld_tmpdir_1=`ls -ld "$tmpdir"` test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" } } then posix_mkdir=: fi rmdir "$tmpdir/d" "$tmpdir" else # Remove any dirs left behind by ancient mkdir implementations. rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null fi trap '' 0;; esac;; esac if $posix_mkdir && ( umask $mkdir_umask && $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" ) then : else # The umask is ridiculous, or mkdir does not conform to POSIX, # or it failed possibly due to a race condition. Create the # directory the slow way, step by step, checking for races as we go. case $dstdir in /*) prefix='/';; -*) prefix='./';; *) prefix='';; esac eval "$initialize_posix_glob" oIFS=$IFS IFS=/ $posix_glob set -f set fnord $dstdir shift $posix_glob set +f IFS=$oIFS prefixes= for d do test -z "$d" && continue prefix=$prefix$d if test -d "$prefix"; then prefixes= else if $posix_mkdir; then (umask=$mkdir_umask && $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break # Don't fail if two instances are running concurrently. test -d "$prefix" || exit 1 else case $prefix in *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; *) qprefix=$prefix;; esac prefixes="$prefixes '$qprefix'" fi fi prefix=$prefix/ done if test -n "$prefixes"; then # Don't fail if two instances are running concurrently. (umask $mkdir_umask && eval "\$doit_exec \$mkdirprog $prefixes") || test -d "$dstdir" || exit 1 obsolete_mkdir_used=true fi fi fi if test -n "$dir_arg"; then { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 else # Make a couple of temp file names in the proper directory. dsttmp=$dstdir/_inst.$$_ rmtmp=$dstdir/_rm.$$_ # Trap to clean up those temp files at exit. trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 # Copy the file name to the temp name. (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && # and set any options; do chmod last to preserve setuid bits. # # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $cpprog $src $dsttmp" command. # { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && # If -C, don't bother to copy if it wouldn't change the file. if $copy_on_change && old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && eval "$initialize_posix_glob" && $posix_glob set -f && set X $old && old=:$2:$4:$5:$6 && set X $new && new=:$2:$4:$5:$6 && $posix_glob set +f && test "$old" = "$new" && $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 then rm -f "$dsttmp" else # Rename the file to the real destination. $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || # The rename failed, perhaps because mv can't rename something else # to itself, or perhaps because mv is so ancient that it does not # support -f. { # Now remove or move aside any old file at destination location. # We try this two ways since rm can't unlink itself on some # systems and the destination file might be busy for other # reasons. In this case, the final cleanup might fail but the new # file should still install successfully. { test ! -f "$dst" || $doit $rmcmd -f "$dst" 2>/dev/null || { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } } || { echo "$0: cannot unlink or rename $dst" >&2 (exit 1); exit 1 } } && # Now rename the file to the real destination. $doit $mvcmd "$dsttmp" "$dst" } fi || exit 1 trap '' 0 fi done # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-time-zone: "UTC" # time-stamp-end: "; # UTC" # End: tk8.5.19/unix/tkUnixEvent.c0000644003604700454610000004436412612445655014212 0ustar dgp771div/* * tkUnixEvent.c -- * * This file implements an event source for X displays for the UNIX * version of Tk. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" #include #ifdef HAVE_XKBKEYCODETOKEYSYM # include #else # define XkbOpenDisplay(D,V,E,M,m,R) ((V),(E),(M),(m),(R),(NULL)) #endif /* * The following static indicates whether this module has been initialized in * the current thread. */ typedef struct ThreadSpecificData { int initialized; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Prototypes for functions that are referenced only in this file: */ static void DisplayCheckProc(ClientData clientData, int flags); static void DisplayExitHandler(ClientData clientData); static void DisplayFileProc(ClientData clientData, int flags); static void DisplaySetupProc(ClientData clientData, int flags); static void TransferXEventsToTcl(Display *display); #ifdef TK_USE_INPUT_METHODS static void OpenIM(TkDisplay *dispPtr); #endif /* *---------------------------------------------------------------------- * * TkCreateXEventSource -- * * This function is called during Tk initialization to create the event * source for X Window events. * * Results: * None. * * Side effects: * A new event source is created. * *---------------------------------------------------------------------- */ void TkCreateXEventSource(void) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { tsdPtr->initialized = 1; Tcl_CreateEventSource(DisplaySetupProc, DisplayCheckProc, NULL); TkCreateExitHandler(DisplayExitHandler, NULL); } } /* *---------------------------------------------------------------------- * * DisplayExitHandler -- * * This function is called during finalization to clean up the display * module. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void DisplayExitHandler( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL); tsdPtr->initialized = 0; } /* *---------------------------------------------------------------------- * * TkpOpenDisplay -- * * Allocates a new TkDisplay, opens the X display, and establishes the * file handler for the connection. * * Results: * A pointer to a Tk display structure. * * Side effects: * Opens a display. * *---------------------------------------------------------------------- */ TkDisplay * TkpOpenDisplay( CONST char *displayNameStr) { TkDisplay *dispPtr; Display *display; int event = 0; int error = 0; int major = 1; int minor = 0; int reason = 0; unsigned int use_xkb = 0; /* ** Bug [3607830]: Before using Xkb, it must be initialized and confirmed ** that the serve supports it. The XkbOpenDisplay call ** will perform this check and return NULL if the extension ** is not supported. ** ** Work around un-const-ified Xkb headers using (char *) cast. */ display = XkbOpenDisplay((char *)displayNameStr, &event, &error, &major, &minor, &reason); if (display == NULL) { /*fprintf(stderr,"event=%d error=%d major=%d minor=%d reason=%d\nDisabling xkb\n", event, error, major, minor, reason);*/ display = XOpenDisplay(displayNameStr); } else { use_xkb = TK_DISPLAY_USE_XKB; /*fprintf(stderr, "Using xkb %d.%d\n", major, minor);*/ } if (display == NULL) { return NULL; } dispPtr = (TkDisplay *) ckalloc(sizeof(TkDisplay)); memset(dispPtr, 0, sizeof(TkDisplay)); dispPtr->display = display; dispPtr->flags |= use_xkb; #ifdef TK_USE_INPUT_METHODS OpenIM(dispPtr); #endif Tcl_CreateFileHandler(ConnectionNumber(display), TCL_READABLE, DisplayFileProc, (ClientData) dispPtr); return dispPtr; } /* *---------------------------------------------------------------------- * * TkpCloseDisplay -- * * Cancels notifier callbacks and closes a display. * * Results: * None. * * Side effects: * Deallocates the displayPtr and unix-specific resources. * *---------------------------------------------------------------------- */ void TkpCloseDisplay( TkDisplay *dispPtr) { TkSendCleanup(dispPtr); TkFreeXId(dispPtr); TkWmCleanup(dispPtr); #ifdef TK_USE_INPUT_METHODS if (dispPtr->inputXfs) { XFreeFontSet(dispPtr->display, dispPtr->inputXfs); } if (dispPtr->inputMethod) { XCloseIM(dispPtr->inputMethod); } #endif if (dispPtr->display != 0) { Tcl_DeleteFileHandler(ConnectionNumber(dispPtr->display)); (void) XSync(dispPtr->display, False); (void) XCloseDisplay(dispPtr->display); } } /* *---------------------------------------------------------------------- * * TkClipCleanup -- * * This function is called to cleanup resources associated with claiming * clipboard ownership and for receiving selection get results. This * function is called in tkWindow.c. This has to be called by the display * cleanup function because we still need the access display elements. * * Results: * None. * * Side effects: * Resources are freed - the clipboard may no longer be used. * *---------------------------------------------------------------------- */ void TkClipCleanup( TkDisplay *dispPtr) /* Display associated with clipboard */ { if (dispPtr->clipWindow != NULL) { Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, dispPtr->applicationAtom); Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, dispPtr->windowAtom); Tk_DestroyWindow(dispPtr->clipWindow); Tcl_Release((ClientData) dispPtr->clipWindow); dispPtr->clipWindow = NULL; } } /* *---------------------------------------------------------------------- * * DisplaySetupProc -- * * This function implements the setup part of the UNIX X display event * source. It is invoked by Tcl_DoOneEvent before entering the notifier * to check for events on all displays. * * Results: * None. * * Side effects: * If data is queued on a display inside Xlib, then the maximum block * time will be set to 0 to ensure that the notifier returns control to * Tcl even if there is no more data on the X connection. * *---------------------------------------------------------------------- */ static void DisplaySetupProc( ClientData clientData, /* Not used. */ int flags) { TkDisplay *dispPtr; static Tcl_Time blockTime = { 0, 0 }; if (!(flags & TCL_WINDOW_EVENTS)) { return; } for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { /* * Flush the display. If data is pending on the X queue, set the block * time to zero. This ensures that we won't block in the notifier if * there is data in the X queue, but not on the server socket. */ XFlush(dispPtr->display); if (QLength(dispPtr->display) > 0) { Tcl_SetMaxBlockTime(&blockTime); } } } /* *---------------------------------------------------------------------- * * TransferXEventsToTcl -- * * Transfer events from the X event queue to the Tk event queue. * * Results: * None. * * Side effects: * Moves queued X events onto the Tcl event queue. * *---------------------------------------------------------------------- */ static void TransferXEventsToTcl( Display *display) { union { int type; XEvent x; TkKeyEvent k; } event; Window w; TkDisplay *dispPtr = NULL; /* * Transfer events from the X event queue to the Tk event queue after XIM * event filtering. KeyPress and KeyRelease events need special treatment * so that they get directed according to Tk's focus rules during XIM * handling. Theoretically they can go to the wrong place still (if * there's a focus change in the queue) but if we push the handling off * until Tk_HandleEvent then many input methods actually cease to work * correctly. Most of the time, Tk processes its event queue fast enough * for this to not be an issue anyway. [Bug 1924761] */ while (QLength(display) > 0) { XNextEvent(display, &event.x); w = None; if (event.type == KeyPress || event.type == KeyRelease) { for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) { if (dispPtr == NULL) { break; } else if (dispPtr->display == event.x.xany.display) { if (dispPtr->focusPtr != NULL) { w = dispPtr->focusPtr->window; } break; } } } if (XFilterEvent(&event.x, w)) { continue; } if (event.type == KeyPress || event.type == KeyRelease) { event.k.charValuePtr = NULL; event.k.charValueLen = 0; event.k.keysym = NoSymbol; /* * Force the calling of the input method engine now. The results * from it will be cached in the event so that they don't get lost * (to a race condition with other XIM-handled key events) between * entering the event queue and getting serviced. [Bug 1924761] */ #ifdef TK_USE_INPUT_METHODS if (event.type == KeyPress && dispPtr && (dispPtr->flags & TK_DISPLAY_USE_IM)) { if (dispPtr->focusPtr && dispPtr->focusPtr->inputContext) { Tcl_DString ds; Tcl_DStringInit(&ds); (void) TkpGetString(dispPtr->focusPtr, &event.x, &ds); Tcl_DStringFree(&ds); } } #endif } Tk_QueueWindowEvent(&event.x, TCL_QUEUE_TAIL); } } /* *---------------------------------------------------------------------- * * DisplayCheckProc -- * * This function checks for events sitting in the X event queue. * * Results: * None. * * Side effects: * Moves queued events onto the Tcl event queue. * *---------------------------------------------------------------------- */ static void DisplayCheckProc( ClientData clientData, /* Not used. */ int flags) { TkDisplay *dispPtr; if (!(flags & TCL_WINDOW_EVENTS)) { return; } for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XFlush(dispPtr->display); TransferXEventsToTcl(dispPtr->display); } } /* *---------------------------------------------------------------------- * * DisplayFileProc -- * * This function implements the file handler for the X connection. * * Results: * None. * * Side effects: * Makes entries on the Tcl event queue for all the events available from * all the displays. * *---------------------------------------------------------------------- */ static void DisplayFileProc( ClientData clientData, /* The display pointer. */ int flags) /* Should be TCL_READABLE. */ { TkDisplay *dispPtr = (TkDisplay *) clientData; Display *display = dispPtr->display; int numFound; XFlush(display); numFound = XEventsQueued(display, QueuedAfterReading); if (numFound == 0) { /* * Things are very tricky if there aren't any events readable at this * point (after all, there was supposedly data available on the * connection). A couple of things could have occurred: * * One possibility is that there were only error events in the input * from the server. If this happens, we should return (we don't want * to go to sleep in XNextEvent below, since this would block out * other sources of input to the process). * * Another possibility is that our connection to the server has been * closed. This will not necessarily be detected in XEventsQueued (!!) * so if we just return then there will be an infinite loop. To detect * such an error, generate a NoOp protocol request to exercise the * connection to the server, then return. However, must disable * SIGPIPE while sending the request, or else the process will die * from the signal and won't invoke the X error function to print a * nice (?!) message. */ void (*oldHandler)(); oldHandler = (void (*)()) signal(SIGPIPE, SIG_IGN); XNoOp(display); XFlush(display); (void) signal(SIGPIPE, oldHandler); } TransferXEventsToTcl(display); } /* *---------------------------------------------------------------------- * * TkUnixDoOneXEvent -- * * This routine waits for an X event to be processed or for a timeout to * occur. The timeout is specified as an absolute time. This routine is * called when Tk needs to wait for a particular X event without letting * arbitrary events be processed. The caller will typically call * Tk_RestrictEvents to set up an event filter before calling this * routine. This routine will service at most one event per invocation. * * Results: * Returns 0 if the timeout has expired, otherwise returns 1. * * Side effects: * Can invoke arbitrary Tcl scripts. * *---------------------------------------------------------------------- */ int TkUnixDoOneXEvent( Tcl_Time *timePtr) /* Specifies the absolute time when the call * should time out. */ { TkDisplay *dispPtr; static fd_mask readMask[MASK_SIZE]; struct timeval blockTime, *timeoutPtr; Tcl_Time now; int fd, index, numFound, numFdBits = 0; fd_mask bit, *readMaskPtr = readMask; /* * Look for queued events first. */ if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) { return 1; } /* * Compute the next block time and check to see if we have timed out. Note * that HP-UX defines tv_sec to be unsigned so we have to be careful in * our arithmetic. */ if (timePtr) { Tcl_GetTime(&now); blockTime.tv_sec = timePtr->sec; blockTime.tv_usec = timePtr->usec - now.usec; if (blockTime.tv_usec < 0) { now.sec += 1; blockTime.tv_usec += 1000000; } if (blockTime.tv_sec < now.sec) { blockTime.tv_sec = 0; blockTime.tv_usec = 0; } else { blockTime.tv_sec -= now.sec; } timeoutPtr = &blockTime; } else { timeoutPtr = NULL; } /* * Set up the select mask for all of the displays. If a display has data * pending, then we want to poll instead of blocking. */ memset(readMask, 0, MASK_SIZE*sizeof(fd_mask)); for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XFlush(dispPtr->display); if (QLength(dispPtr->display) > 0) { blockTime.tv_sec = 0; blockTime.tv_usec = 0; } fd = ConnectionNumber(dispPtr->display); index = fd/(NBBY*sizeof(fd_mask)); bit = ((fd_mask)1) << (fd%(NBBY*sizeof(fd_mask))); readMask[index] |= bit; if (numFdBits <= fd) { numFdBits = fd+1; } } numFound = select(numFdBits, (SELECT_MASK *) readMaskPtr, NULL, NULL, timeoutPtr); if (numFound <= 0) { /* * Some systems don't clear the masks after an error, so we have to do * it here. */ memset(readMask, 0, MASK_SIZE*sizeof(fd_mask)); } /* * Process any new events on the display connections. */ for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { fd = ConnectionNumber(dispPtr->display); index = fd/(NBBY*sizeof(fd_mask)); bit = ((fd_mask)1) << (fd%(NBBY*sizeof(fd_mask))); if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) { DisplayFileProc((ClientData)dispPtr, TCL_READABLE); } } if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) { return 1; } /* * Check to see if we timed out. */ if (timePtr) { Tcl_GetTime(&now); if ((now.sec > timePtr->sec) || ((now.sec == timePtr->sec) && (now.usec > timePtr->usec))) { return 0; } } /* * We had an event but we did not generate a Tcl event from it. Behave as * though we dealt with it. (JYL&SS) */ return 1; } /* *---------------------------------------------------------------------- * * TkpSync -- * * This routine ensures that all pending X requests have been seen by the * server, and that any pending X events have been moved onto the Tk * event queue. * * Results: * None. * * Side effects: * Places new events on the Tk event queue. * *---------------------------------------------------------------------- */ void TkpSync( Display *display) /* Display to sync. */ { XSync(display, False); /* * Transfer events from the X event queue to the Tk event queue. */ TransferXEventsToTcl(display); } #ifdef TK_USE_INPUT_METHODS /* *-------------------------------------------------------------- * * OpenIM -- * * Tries to open an X input method associated with the given display. * * Results: * Stores the input method in dispPtr->inputMethod; if there isn't a * suitable input method, then NULL is stored in dispPtr->inputMethod. * * Side effects: * An input method gets opened. * *-------------------------------------------------------------- */ static void OpenIM( TkDisplay *dispPtr) /* Tk's structure for the display. */ { int i; XIMStyles *stylePtr; XIMStyle bestStyle = 0; if (XSetLocaleModifiers("") == NULL) { return; } dispPtr->inputMethod = XOpenIM(dispPtr->display, NULL, NULL, NULL); if (dispPtr->inputMethod == NULL) { return; } if ((XGetIMValues(dispPtr->inputMethod, XNQueryInputStyle, &stylePtr, NULL) != NULL) || (stylePtr == NULL)) { goto error; } /* * Select the best input style supported by both the IM and Tk. */ for (i = 0; i < stylePtr->count_styles; i++) { XIMStyle thisStyle = stylePtr->supported_styles[i]; if (thisStyle == (XIMPreeditPosition | XIMStatusNothing)) { bestStyle = thisStyle; break; } else if (thisStyle == (XIMPreeditNothing | XIMStatusNothing)) { bestStyle = thisStyle; } } XFree(stylePtr); if (bestStyle == 0) { goto error; } dispPtr->inputStyle = bestStyle; /* * Create an XFontSet for preedit area. */ if (dispPtr->inputStyle & XIMPreeditPosition) { char **missing_list; int missing_count; char *def_string; dispPtr->inputXfs = XCreateFontSet(dispPtr->display, "-*-*-*-R-Normal--14-130-75-75-*-*", &missing_list, &missing_count, &def_string); if (missing_count > 0) { XFreeStringList(missing_list); } } return; error: if (dispPtr->inputMethod) { XCloseIM(dispPtr->inputMethod); dispPtr->inputMethod = NULL; } } #endif /* TK_USE_INPUT_METHODS */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixInit.c0000644003604700454610000000721012612445655014021 0ustar dgp771div/* * tkUnixInit.c -- * * This file contains Unix-specific interpreter initialization functions. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkUnixInt.h" #ifdef HAVE_COREFOUNDATION static int GetLibraryPath(Tcl_Interp *interp); #else #define GetLibraryPath(dummy) (void)0 #endif /* HAVE_COREFOUNDATION */ /* *---------------------------------------------------------------------- * * TkpInit -- * * Performs Unix-specific interpreter initialization related to the * tk_library variable. * * Results: * Returns a standard Tcl result. Leaves an error message or result in * the interp's result. * * Side effects: * Sets "tk_library" Tcl variable, runs "tk.tcl" script. * *---------------------------------------------------------------------- */ int TkpInit( Tcl_Interp *interp) { TkCreateXEventSource(); GetLibraryPath(interp); return TCL_OK; } /* *---------------------------------------------------------------------- * * TkpGetAppName -- * * Retrieves the name of the current application from a platform specific * location. For Unix, the application name is the tail of the path * contained in the tcl variable argv0. * * Results: * Returns the application name in the given Tcl_DString. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TkpGetAppName( Tcl_Interp *interp, Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */ { CONST char *p, *name; name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); if ((name == NULL) || (*name == 0)) { name = "tk"; } else { p = strrchr(name, '/'); if (p != NULL) { name = p+1; } } Tcl_DStringAppend(namePtr, name, -1); } /* *---------------------------------------------------------------------- * * TkpDisplayWarning -- * * This routines is called from Tk_Main to display warning messages that * occur during startup. * * Results: * None. * * Side effects: * Generates messages on stdout. * *---------------------------------------------------------------------- */ void TkpDisplayWarning( CONST char *msg, /* Message to be displayed. */ CONST char *title) /* Title of warning. */ { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_WriteChars(errChannel, title, -1); Tcl_WriteChars(errChannel, ": ", 2); Tcl_WriteChars(errChannel, msg, -1); Tcl_WriteChars(errChannel, "\n", 1); } } #ifdef HAVE_COREFOUNDATION /* *---------------------------------------------------------------------- * * GetLibraryPath -- * * If we have a bundle structure for the Tk installation, then check * there first to see if we can find the libraries there. * * Results: * TCL_OK if we have found the tk library; TCL_ERROR otherwise. * * Side effects: * Same as for Tcl_MacOSXOpenVersionedBundleResources. * *---------------------------------------------------------------------- */ static int GetLibraryPath( Tcl_Interp *interp) { #ifdef TK_FRAMEWORK int foundInFramework = TCL_ERROR; char tkLibPath[PATH_MAX + 1]; foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, "com.tcltk.tklibrary", TK_FRAMEWORK_VERSION, 0, PATH_MAX, tkLibPath); if (tkLibPath[0] != '\0') { Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY); } return foundInFramework; #else return TCL_ERROR; #endif } #endif /* HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/unix/tkUnixButton.c0000644003604700454610000007245612612445655014407 0ustar dgp771div/* * tkUnixButton.c -- * * This file implements the Unix specific portion of the button widgets. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" #include "tkButton.h" #include "tk3d.h" /* * Shared with menu widget. */ MODULE_SCOPE void TkpDrawCheckIndicator(Tk_Window tkwin, Display *display, Drawable d, int x, int y, Tk_3DBorder bgBorder, XColor *indicatorColor, XColor *selectColor, XColor *disColor, int on, int disabled, int mode); /* * Declaration of Unix specific button structure. */ typedef struct UnixButton { TkButton info; /* Generic button info. */ } UnixButton; /* * The class function table for the button widgets. */ Tk_ClassProcs tkpButtonProcs = { sizeof(Tk_ClassProcs), /* size */ TkButtonWorldChanged, /* worldChangedProc */ }; /* * The button image. * The header info here is ignored, it's the image that's important. The * colors will be applied as follows: * A = Background * B = Background * C = 3D light * D = selectColor * E = 3D dark * F = Background * G = Indicator Color * H = disabled Indicator Color */ /* XPM */ static char *button_images[] = { /* width height ncolors chars_per_pixel */ "52 26 7 1", /* colors */ "A c #808000000000", "B c #000080800000", "C c #808080800000", "D c #000000008080", "E c #808000008080", "F c #000080808080", "G c #000000000000", "H c #000080800000", /* pixels */ "AAAAAAAAAAAABAAAAAAAAAAAABAAAAAAAAAAAABAAAAAAAAAAAAB", "AEEEEEEEEEECBAEEEEEEEEEECBAEEEEEEEEEECBAEEEEEEEEEECB", "AEDDDDDDDDDCBAEDDDDDDDDDCBAEFFFFFFFFFCBAEFFFFFFFFFCB", "AEDDDDDDDDDCBAEDDDDDDDGDCBAEFFFFFFFFFCBAEFFFFFFFHFCB", "AEDDDDDDDDDCBAEDDDDDDGGDCBAEFFFFFFFFFCBAEFFFFFFHHFCB", "AEDDDDDDDDDCBAEDGDDDGGGDCBAEFFFFFFFFFCBAEFHFFFHHHFCB", "AEDDDDDDDDDCBAEDGGDGGGDDCBAEFFFFFFFFFCBAEFHHFHHHFFCB", "AEDDDDDDDDDCBAEDGGGGGDDDCBAEFFFFFFFFFCBAEFHHHHHFFFCB", "AEDDDDDDDDDCBAEDDGGGDDDDCBAEFFFFFFFFFCBAEFFHHHFFFFCB", "AEDDDDDDDDDCBAEDDDGDDDDDCBAEFFFFFFFFFCBAEFFFHFFFFFCB", "AEDDDDDDDDDCBAEDDDDDDDDDCBAEFFFFFFFFFCBAEFFFFFFFFFCB", "ACCCCCCCCCCCBACCCCCCCCCCCBACCCCCCCCCCCBACCCCCCCCCCCB", "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB", "FFFFAAAAFFFFFFFFFAAAAFFFFFFFFFAAAAFFFFFFFFFAAAAFFFFF", "FFAAEEEEAAFFFFFAAEEEEAAFFFFFAAEEEEAAFFFFFAAEEEEAAFFF", "FAEEDDDDEEBFFFAEEDDDDEEBFFFAEEFFFFEEBFFFAEEFFFFEEBFF", "FAEDDDDDDCBFFFAEDDDDDDCBFFFAEFFFFFFCBFFFAEFFFFFFCBFF", "AEDDDDDDDDCBFAEDDDGGDDDCBFAEFFFFFFFFCBFAEFFFHHFFFCBF", "AEDDDDDDDDCBFAEDDGGGGDDCBFAEFFFFFFFFCBFAEFFHHHHFFCBF", "AEDDDDDDDDCBFAEDDGGGGDDCBFAEFFFFFFFFCBFAEFFHHHHFFCBF", "AEDDDDDDDDCBFAEDDDGGDDDCBFAEFFFFFFFFCBFAEFFFHHFFFCBF", "FAEDDDDDDCBFFFAEDDDDDDCBFFFAEFFFFFFCBFFFAEFFFFFFCBFF", "FACCDDDDCCBFFFACCDDDDCCBFFFACCFFFFCCBFFFACCFFFFCCBFF", "FFBBCCCCBBFFFFFBBCCCCBBFFFFFBBCCCCBBFFFFFBBCCCCBBFFF", "FFFFBBBBFFFFFFFFFBBBBFFFFFFFFFBBBBFFFFFFFFFBBBBFFFFF", "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF", }; /* * Sizes and offsets into above XPM file. */ #define CHECK_BUTTON_DIM 13 #define CHECK_MENU_DIM 9 #define CHECK_START 9 #define CHECK_ON_OFFSET 13 #define CHECK_OFF_OFFSET 0 #define CHECK_DISON_OFFSET 39 #define CHECK_DISOFF_OFFSET 26 #define RADIO_BUTTON_DIM 12 #define RADIO_MENU_DIM 6 #define RADIO_WIDTH 13 #define RADIO_START 22 #define RADIO_ON_OFFSET 13 #define RADIO_OFF_OFFSET 0 #define RADIO_DISON_OFFSET 39 #define RADIO_DISOFF_OFFSET 26 /* * Indicator Draw Modes */ #define CHECK_BUTTON 0 #define CHECK_MENU 1 #define RADIO_BUTTON 2 #define RADIO_MENU 3 /* *---------------------------------------------------------------------- * * TkpDrawCheckIndicator - * * Draws the checkbox image in the drawable at the (x,y) location, value, * and state given. This routine is use by the button and menu widgets * * Results: * None. * * Side effects: * An image is drawn in the drawable at the location given. * *---------------------------------------------------------------------- */ void TkpDrawCheckIndicator( Tk_Window tkwin, /* handle for resource alloc */ Display *display, Drawable d, /* what to draw on */ int x, int y, /* where to draw */ Tk_3DBorder bgBorder, /* colors of the border */ XColor *indicatorColor, /* color of the indicator */ XColor *selectColor, /* color when selected */ XColor *disableColor, /* color when disabled */ int on, /* are we on? */ int disabled, /* are we disabled? */ int mode) /* kind of indicator to draw */ { int ix, iy; int dim; int imgsel, imgstart; TkBorder *bg_brdr = (TkBorder*)bgBorder; XGCValues gcValues; GC copyGC; unsigned long imgColors[8]; XImage *img; Pixmap pixmap; int depth; /* * Sanity check. */ if (tkwin == NULL || display == None || d == None || bgBorder == NULL || indicatorColor == NULL) { return; } if (disableColor == NULL) { disableColor = bg_brdr->bgColorPtr; } if (selectColor == NULL) { selectColor = bg_brdr->bgColorPtr; } depth = Tk_Depth(tkwin); /* * Compute starting point and dimensions of image inside button_images to * be used. */ switch (mode) { default: case CHECK_BUTTON: imgsel = on == 2 ? CHECK_DISON_OFFSET : on == 1 ? CHECK_ON_OFFSET : CHECK_OFF_OFFSET; imgsel += disabled && on != 2 ? CHECK_DISOFF_OFFSET : 0; imgstart = CHECK_START; dim = CHECK_BUTTON_DIM; break; case CHECK_MENU: imgsel = on == 2 ? CHECK_DISOFF_OFFSET : on == 1 ? CHECK_ON_OFFSET : CHECK_OFF_OFFSET; imgsel += disabled && on != 2 ? CHECK_DISOFF_OFFSET : 0; imgstart = CHECK_START + 2; imgsel += 2; dim = CHECK_MENU_DIM; break; case RADIO_BUTTON: imgsel = on == 2 ? RADIO_DISON_OFFSET : on==1 ? RADIO_ON_OFFSET : RADIO_OFF_OFFSET; imgsel += disabled && on != 2 ? RADIO_DISOFF_OFFSET : 0; imgstart = RADIO_START; dim = RADIO_BUTTON_DIM; break; case RADIO_MENU: imgsel = on == 2 ? RADIO_DISOFF_OFFSET : on==1 ? RADIO_ON_OFFSET : RADIO_OFF_OFFSET; imgsel += disabled && on != 2 ? RADIO_DISOFF_OFFSET : 0; imgstart = RADIO_START + 3; imgsel += 3; dim = RADIO_MENU_DIM; break; } /* * Allocate the drawing areas to use. Note that we use double-buffering * here because not all code paths leading to this function do so. */ pixmap = Tk_GetPixmap(display, d, dim, dim, depth); if (pixmap == None) { return; } x -= dim/2; y -= dim/2; img = XGetImage(display, pixmap, 0, 0, (unsigned int)dim, (unsigned int)dim, AllPlanes, ZPixmap); if (img == NULL) { return; } /* * Set up the color mapping table. */ TkpGetShadows(bg_brdr, tkwin); imgColors[0 /*A*/] = Tk_GetColorByValue(tkwin, bg_brdr->bgColorPtr)->pixel; imgColors[1 /*B*/] = Tk_GetColorByValue(tkwin, bg_brdr->bgColorPtr)->pixel; imgColors[2 /*C*/] = (bg_brdr->lightColorPtr != NULL) ? Tk_GetColorByValue(tkwin, bg_brdr->lightColorPtr)->pixel : WhitePixelOfScreen(bg_brdr->screen); imgColors[3 /*D*/] = Tk_GetColorByValue(tkwin, selectColor)->pixel; imgColors[4 /*E*/] = (bg_brdr->darkColorPtr != NULL) ? Tk_GetColorByValue(tkwin, bg_brdr->darkColorPtr)->pixel : BlackPixelOfScreen(bg_brdr->screen); imgColors[5 /*F*/] = Tk_GetColorByValue(tkwin, bg_brdr->bgColorPtr)->pixel; imgColors[6 /*G*/] = Tk_GetColorByValue(tkwin, indicatorColor)->pixel; imgColors[7 /*H*/] = Tk_GetColorByValue(tkwin, disableColor)->pixel; /* * Create the image, painting it into an XImage one pixel at a time. */ for (iy=0 ; iybgColorPtr->pixel; gcValues.graphics_exposures = False; copyGC = Tk_GetGC(tkwin, 0, &gcValues); XPutImage(display, pixmap, copyGC, img, 0, 0, 0, 0, (unsigned int)dim, (unsigned int)dim); XCopyArea(display, pixmap, d, copyGC, 0, 0, (unsigned int)dim, (unsigned int)dim, x, y); /* * Tidy up. */ Tk_FreeGC(display, copyGC); XDestroyImage(img); Tk_FreePixmap(display, pixmap); } /* *---------------------------------------------------------------------- * * TkpCreateButton -- * * Allocate a new TkButton structure. * * Results: * Returns a newly allocated TkButton structure. * * Side effects: * Registers an event handler for the widget. * *---------------------------------------------------------------------- */ TkButton * TkpCreateButton( Tk_Window tkwin) { UnixButton *butPtr = (UnixButton *) ckalloc(sizeof(UnixButton)); return (TkButton *) butPtr; } /* *---------------------------------------------------------------------- * * TkpDisplayButton -- * * This function is invoked to display a button widget. It is normally * invoked as an idle handler. * * Results: * None. * * Side effects: * Commands are output to X to display the button in its current mode. * The REDRAW_PENDING flag is cleared. * *---------------------------------------------------------------------- */ void TkpDisplayButton( ClientData clientData) /* Information about widget. */ { register TkButton *butPtr = (TkButton *) clientData; GC gc; Tk_3DBorder border; Pixmap pixmap; int x = 0; /* Initialization only needed to stop compiler * warning. */ int y, relief; Tk_Window tkwin = butPtr->tkwin; int width = 0, height = 0, fullWidth, fullHeight; int textXOffset, textYOffset; int haveImage = 0, haveText = 0; int offset; /* 1 means this is a button widget, so we * offset the text to make the button appear * to move up and down as the relief * changes. */ int imageWidth, imageHeight; int imageXOffset = 0, imageYOffset = 0; /* image information that will be used to * restrict disabled pixmap as well */ butPtr->flags &= ~REDRAW_PENDING; if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { return; } border = butPtr->normalBorder; if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { gc = butPtr->disabledGC; } else if ((butPtr->state == STATE_ACTIVE) && !Tk_StrictMotif(butPtr->tkwin)) { gc = butPtr->activeTextGC; border = butPtr->activeBorder; } else { gc = butPtr->normalTextGC; } if ((butPtr->flags & SELECTED) && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) { border = butPtr->selectBorder; } /* * Override the relief specified for the button if this is a checkbutton * or radiobutton and there's no indicator. The new relief is as follows: * If the button is select --> "sunken" * If relief==overrelief --> relief * Otherwise --> overrelief * * The effect we are trying to achieve is as follows: * * value mouse-over? --> relief * ------- ------------ -------- * off no flat * off yes raised * on no sunken * on yes sunken * * This is accomplished by configuring the checkbutton or radiobutton like * this: * * -indicatoron 0 -overrelief raised -offrelief flat * * Bindings (see library/button.tcl) will copy the -overrelief into * -relief on mouseover. Hence, we can tell if we are in mouse-over by * comparing relief against overRelief. This is an aweful kludge, but it * gives use the desired behavior while keeping the code backwards * compatible. */ relief = butPtr->relief; if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) { if (butPtr->flags & SELECTED) { relief = TK_RELIEF_SUNKEN; } else if (butPtr->overRelief != relief) { relief = butPtr->offRelief; } } offset = (butPtr->type == TYPE_BUTTON) && !Tk_StrictMotif(butPtr->tkwin); /* * In order to avoid screen flashes, this function redraws the button in a * pixmap, then copies the pixmap to the screen in a single operation. * This means that there's no point in time where the on-screen image has * been cleared. */ pixmap = Tk_GetPixmap(butPtr->display, Tk_WindowId(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); 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. */ if (butPtr->image != NULL) { Tk_SizeOfImage(butPtr->image, &width, &height); haveImage = 1; } else if (butPtr->bitmap != None) { Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); haveImage = 1; } imageWidth = width; imageHeight = height; haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0); if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { textXOffset = 0; textYOffset = 0; fullWidth = 0; fullHeight = 0; switch ((enum compound) butPtr->compound) { case COMPOUND_TOP: case COMPOUND_BOTTOM: /* * Image is above or below text. */ if (butPtr->compound == COMPOUND_TOP) { textYOffset = height + butPtr->padY; } else { imageYOffset = butPtr->textHeight + butPtr->padY; } fullHeight = height + butPtr->textHeight + butPtr->padY; fullWidth = (width > butPtr->textWidth ? width : butPtr->textWidth); textXOffset = (fullWidth - butPtr->textWidth)/2; imageXOffset = (fullWidth - width)/2; break; case COMPOUND_LEFT: case COMPOUND_RIGHT: /* * Image is left or right of text. */ if (butPtr->compound == COMPOUND_LEFT) { textXOffset = width + butPtr->padX; } else { imageXOffset = butPtr->textWidth + butPtr->padX; } fullWidth = butPtr->textWidth + butPtr->padX + width; fullHeight = (height > butPtr->textHeight ? height : butPtr->textHeight); textYOffset = (fullHeight - butPtr->textHeight)/2; imageYOffset = (fullHeight - height)/2; break; case COMPOUND_CENTER: /* * Image and text are superimposed. */ fullWidth = (width > butPtr->textWidth ? width : butPtr->textWidth); fullHeight = (height > butPtr->textHeight ? height : butPtr->textHeight); textXOffset = (fullWidth - butPtr->textWidth)/2; imageXOffset = (fullWidth - width)/2; textYOffset = (fullHeight - butPtr->textHeight)/2; imageYOffset = (fullHeight - height)/2; break; case COMPOUND_NONE: break; } TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY, butPtr->indicatorSpace + fullWidth, fullHeight, &x, &y); x += butPtr->indicatorSpace; x += offset; y += offset; if (relief == TK_RELIEF_RAISED) { x -= offset; y -= offset; } else if (relief == TK_RELIEF_SUNKEN) { x += offset; y += offset; } imageXOffset += x; imageYOffset += y; if (butPtr->image != NULL) { /* * Do boundary clipping, so that Tk_RedrawImage is passed valid * coordinates. [Bug 979239] */ if (imageXOffset < 0) { imageXOffset = 0; } if (imageYOffset < 0) { imageYOffset = 0; } if (width > Tk_Width(tkwin)) { width = Tk_Width(tkwin); } if (height > Tk_Height(tkwin)) { height = Tk_Height(tkwin); } if ((width + imageXOffset) > Tk_Width(tkwin)) { imageXOffset = Tk_Width(tkwin) - width; } if ((height + imageYOffset) > Tk_Height(tkwin)) { imageYOffset = Tk_Height(tkwin) - height; } if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) { Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } else if ((butPtr->tristateImage != NULL) && (butPtr->flags & TRISTATED)) { Tk_RedrawImage(butPtr->tristateImage, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } else { Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } } else { XSetClipOrigin(butPtr->display, gc, imageXOffset, imageYOffset); XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0, (unsigned int) width, (unsigned int) height, imageXOffset, imageYOffset, 1); XSetClipOrigin(butPtr->display, gc, 0, 0); } Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout, x + textXOffset, y + textYOffset, 0, -1); Tk_UnderlineTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout, x + textXOffset, y + textYOffset, butPtr->underline); y += fullHeight/2; } else { if (haveImage) { TkComputeAnchor(butPtr->anchor, tkwin, 0, 0, butPtr->indicatorSpace + width, height, &x, &y); x += butPtr->indicatorSpace; x += offset; y += offset; if (relief == TK_RELIEF_RAISED) { x -= offset; y -= offset; } else if (relief == TK_RELIEF_SUNKEN) { x += offset; y += offset; } imageXOffset += x; imageYOffset += y; if (butPtr->image != NULL) { /* * Do boundary clipping, so that Tk_RedrawImage is passed * valid coordinates. [Bug 979239] */ if (imageXOffset < 0) { imageXOffset = 0; } if (imageYOffset < 0) { imageYOffset = 0; } if (width > Tk_Width(tkwin)) { width = Tk_Width(tkwin); } if (height > Tk_Height(tkwin)) { height = Tk_Height(tkwin); } if ((width + imageXOffset) > Tk_Width(tkwin)) { imageXOffset = Tk_Width(tkwin) - width; } if ((height + imageYOffset) > Tk_Height(tkwin)) { imageYOffset = Tk_Height(tkwin) - height; } if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) { Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } else if ((butPtr->tristateImage != NULL) && (butPtr->flags & TRISTATED)) { Tk_RedrawImage(butPtr->tristateImage, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } else { Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); } } else { XSetClipOrigin(butPtr->display, gc, x, y); XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0, (unsigned int) width, (unsigned int) height, x, y, 1); XSetClipOrigin(butPtr->display, gc, 0, 0); } y += height/2; } else { TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY, butPtr->indicatorSpace + butPtr->textWidth, butPtr->textHeight, &x, &y); x += butPtr->indicatorSpace; x += offset; y += offset; if (relief == TK_RELIEF_RAISED) { x -= offset; y -= offset; } else if (relief == TK_RELIEF_SUNKEN) { x += offset; y += offset; } Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout, x, y, 0, -1); Tk_UnderlineTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout, x, y, butPtr->underline); y += butPtr->textHeight/2; } } /* * Draw the indicator for check buttons and radio buttons. At this point, * x and y refer to the top-left corner of the text or image or bitmap. */ if ((butPtr->type == TYPE_CHECK_BUTTON) && butPtr->indicatorOn) { if (butPtr->indicatorDiameter > 2*butPtr->borderWidth) { TkBorder *selBorder = (TkBorder *) butPtr->selectBorder; XColor *selColor = NULL; if (selBorder != NULL) { selColor = selBorder->bgColorPtr; } x -= butPtr->indicatorSpace/2; y = Tk_Height(tkwin)/2; TkpDrawCheckIndicator(tkwin, butPtr->display, pixmap, x, y, border, butPtr->normalFg, selColor, butPtr->disabledFg, ((butPtr->flags & SELECTED) ? 1 : (butPtr->flags & TRISTATED) ? 2 : 0), (butPtr->state == STATE_DISABLED), CHECK_BUTTON); } } else if ((butPtr->type == TYPE_RADIO_BUTTON) && butPtr->indicatorOn) { if (butPtr->indicatorDiameter > 2*butPtr->borderWidth) { TkBorder *selBorder = (TkBorder *) butPtr->selectBorder; XColor *selColor = NULL; if (selBorder != NULL) { selColor = selBorder->bgColorPtr; } x -= butPtr->indicatorSpace/2; y = Tk_Height(tkwin)/2; TkpDrawCheckIndicator(tkwin, butPtr->display, pixmap, x, y, border, butPtr->normalFg, selColor, butPtr->disabledFg, ((butPtr->flags & SELECTED) ? 1 : (butPtr->flags & TRISTATED) ? 2 : 0), (butPtr->state == STATE_DISABLED), RADIO_BUTTON); } } /* * If the button is disabled with a stipple rather than a special * foreground color, generate the stippled effect. If the widget is * selected and we use a different background color when selected, must * temporarily modify the GC so the stippling is the right color. */ if ((butPtr->state == STATE_DISABLED) && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) { if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn && (butPtr->selectBorder != NULL)) { XSetForeground(butPtr->display, butPtr->stippleGC, Tk_3DBorderColor(butPtr->selectBorder)->pixel); } /* * Stipple the whole button if no disabledFg was specified, otherwise * restrict stippling only to displayed image */ if (butPtr->disabledFg == NULL) { XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin)); } else { XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC, imageXOffset, imageYOffset, (unsigned) imageWidth, (unsigned) imageHeight); } if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn && (butPtr->selectBorder != NULL)) { XSetForeground(butPtr->display, butPtr->stippleGC, Tk_3DBorderColor(butPtr->normalBorder)->pixel); } } /* * Draw the border and traversal highlight last. This way, if the button's * contents overflow they'll be covered up by the border. This code is * complicated by the possible combinations of focus highlight and default * rings. We draw the focus and highlight rings using the highlight border * and highlight foreground color. */ if (relief != TK_RELIEF_FLAT) { int inset = butPtr->highlightWidth; if (butPtr->defaultState == DEFAULT_ACTIVE) { /* * Draw the default ring with 2 pixels of space between the * default ring and the button and the default ring and the focus * ring. Note that we need to explicitly draw the space in the * highlightBorder color to ensure that we overwrite any overflow * text and/or a different button background color. */ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset, inset, Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT); inset += 2; Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset, inset, Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset, 1, TK_RELIEF_SUNKEN); inset++; Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset, inset, Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT); inset += 2; } else if (butPtr->defaultState == DEFAULT_NORMAL) { /* * Leave room for the default ring and write over any text or * background color. */ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 5, TK_RELIEF_FLAT); inset += 5; } /* * Draw the button border. */ Tk_Draw3DRectangle(tkwin, pixmap, border, inset, inset, Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset, butPtr->borderWidth, relief); } if (butPtr->highlightWidth > 0) { GC gc; if (butPtr->flags & GOT_FOCUS) { gc = Tk_GCForColor(butPtr->highlightColorPtr, pixmap); } else { gc = Tk_GCForColor(Tk_3DBorderColor(butPtr->highlightBorder), pixmap); } /* * Make sure the focus ring shrink-wraps the actual button, not the * padding space left for a default ring. */ if (butPtr->defaultState == DEFAULT_NORMAL) { TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap, 5); } else { Tk_DrawFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap); } } /* * Copy the information from the off-screen pixmap onto the screen, then * delete the pixmap. */ XCopyArea(butPtr->display, pixmap, Tk_WindowId(tkwin), butPtr->copyGC, 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0); Tk_FreePixmap(butPtr->display, pixmap); } /* *---------------------------------------------------------------------- * * TkpComputeButtonGeometry -- * * After changes in a button's text or bitmap, this function recomputes * the button's geometry and passes this information along to the * geometry manager for the window. * * Results: * None. * * Side effects: * The button's window may change size. * *---------------------------------------------------------------------- */ void TkpComputeButtonGeometry( register TkButton *butPtr) /* Button whose geometry may have changed. */ { int width, height, avgWidth, txtWidth, txtHeight; int haveImage = 0, haveText = 0; Tk_FontMetrics fm; butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth; /* * Leave room for the default ring if needed. */ if (butPtr->defaultState != DEFAULT_DISABLED) { butPtr->inset += 5; } butPtr->indicatorSpace = 0; width = 0; height = 0; txtWidth = 0; txtHeight = 0; avgWidth = 0; if (butPtr->image != NULL) { Tk_SizeOfImage(butPtr->image, &width, &height); haveImage = 1; } else if (butPtr->bitmap != None) { Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height); haveImage = 1; } if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) { Tk_FreeTextLayout(butPtr->textLayout); butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont, Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength, butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight); txtWidth = butPtr->textWidth; txtHeight = butPtr->textHeight; avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1); Tk_GetFontMetrics(butPtr->tkfont, &fm); haveText = (txtWidth != 0 && txtHeight != 0); } /* * If the button is compound (i.e., 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 button has both text and an image, * because otherwise it is not really a compound button. */ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { switch ((enum compound) butPtr->compound) { case COMPOUND_TOP: case COMPOUND_BOTTOM: /* * Image is above or below text. */ height += txtHeight + butPtr->padY; width = (width > txtWidth ? width : txtWidth); break; case COMPOUND_LEFT: case COMPOUND_RIGHT: /* * Image is left or right of text. */ width += txtWidth + butPtr->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 (butPtr->width > 0) { width = butPtr->width; } if (butPtr->height > 0) { height = butPtr->height; } if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) { butPtr->indicatorSpace = height; if (butPtr->type == TYPE_CHECK_BUTTON) { butPtr->indicatorDiameter = (65*height)/100; } else { butPtr->indicatorDiameter = (75*height)/100; } } width += 2*butPtr->padX; height += 2*butPtr->padY; } else { if (haveImage) { if (butPtr->width > 0) { width = butPtr->width; } if (butPtr->height > 0) { height = butPtr->height; } if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) { butPtr->indicatorSpace = height; if (butPtr->type == TYPE_CHECK_BUTTON) { butPtr->indicatorDiameter = (65*height)/100; } else { butPtr->indicatorDiameter = (75*height)/100; } } } else { width = txtWidth; height = txtHeight; if (butPtr->width > 0) { width = butPtr->width * avgWidth; } if (butPtr->height > 0) { height = butPtr->height * fm.linespace; } if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) { butPtr->indicatorDiameter = fm.linespace; if (butPtr->type == TYPE_CHECK_BUTTON) { butPtr->indicatorDiameter = (80*butPtr->indicatorDiameter)/100; } butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth; } } } /* * When issuing the geometry request, add extra space for the indicator, * if any, and for the border and padding, plus two extra pixels so the * display can be offset by 1 pixel in either direction for the raised or * lowered effect. */ if ((butPtr->image == NULL) && (butPtr->bitmap == None)) { width += 2*butPtr->padX; height += 2*butPtr->padY; } if ((butPtr->type == TYPE_BUTTON) && !Tk_StrictMotif(butPtr->tkwin)) { width += 2; height += 2; } Tk_GeometryRequest(butPtr->tkwin, (int) (width + butPtr->indicatorSpace + 2*butPtr->inset), (int) (height + 2*butPtr->inset)); Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ tk8.5.19/tests/0000755003604700454610000000000012656405252011723 5ustar dgp771divtk8.5.19/tests/clrpick.test0000644003604700454610000001405012612445655014256 0ustar dgp771div# This file is a Tcl script to test out Tk's "tk_chooseColor" command. # It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands if {[testConstraint defaultPseudocolor8]} { # let's soak up a bunch of colors...so that # machines with small color palettes still fail. # some tests will be skipped if there are no more colors set numcolors 32 testConstraint colorsLeftover 1 set i 0 canvas .c pack .c -expand 1 -fill both while {$i<$numcolors} { set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]] .c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color incr i } set i 0 while {$i<$numcolors} { set color [.c itemcget $i -fill] if {$color != ""} { foreach {r g b} [winfo rgb . $color] {} set r [expr $r/256] set g [expr $g/256] set b [expr $b/256] if {"$color" != "#[format %02x%02x%02x $r $g $b]"} { testConstraint colorsLeftover 0 } } .c delete $i incr i } destroy .c } else { testConstraint colorsLeftover 0 } test clrpick-1.1 {tk_chooseColor command} { list [catch {tk_chooseColor -foo} msg] $msg } {1 {bad option "-foo": must be -initialcolor, -parent, or -title}} catch {tk_chooseColor -foo 1} msg regsub -all , $msg "" options regsub \"-foo\" $options "" options foreach option $options { if {[string index $option 0] eq "-"} { test clrpick-1.2$option {tk_chooseColor command} -body { tk_chooseColor $option } -returnCodes error -result "value for \"$option\" missing" } } test clrpick-1.3 {tk_chooseColor command} { list [catch {tk_chooseColor -foo bar} msg] $msg } {1 {bad option "-foo": must be -initialcolor, -parent, or -title}} test clrpick-1.4 {tk_chooseColor command} { list [catch {tk_chooseColor -initialcolor} msg] $msg } {1 {value for "-initialcolor" missing}} test clrpick-1.5 {tk_chooseColor command} { list [catch {tk_chooseColor -parent foo.bar} msg] $msg } {1 {bad window path name "foo.bar"}} test clrpick-1.6 {tk_chooseColor command} { list [catch {tk_chooseColor -initialcolor badbadbaadcolor} msg] $msg } {1 {unknown color name "badbadbaadcolor"}} test clrpick-1.7 {tk_chooseColor command} { list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg } {1 {invalid color name "##badbadbaadcolor"}} set isNative [expr {[info commands tk::dialog::color::] eq ""}] proc ToPressButton {parent btn} { global isNative if {!$isNative} { after 200 "SendButtonPress $parent $btn mouse" } } proc ToChooseColorByKey {parent r g b} { global isNative if {!$isNative} { after 200 ChooseColorByKey $parent $r $g $b } } proc PressButton {btn} { event generate $btn event generate $btn <1> -x 5 -y 5 event generate $btn -x 5 -y 5 } proc ChooseColorByKey {parent r g b} { set w .__tk__color upvar ::tk::dialog::color::[winfo name $w] data update $data(red,entry) delete 0 end $data(green,entry) delete 0 end $data(blue,entry) delete 0 end $data(red,entry) insert 0 $r $data(green,entry) insert 0 $g $data(blue,entry) insert 0 $b # Manually force the refresh of the color values instead # of counting on the timing of the event stream to change # the values for us. tk::dialog::color::HandleRGBEntry $w SendButtonPress $parent ok mouse } proc SendButtonPress {parent btn type} { set w .__tk__color upvar ::tk::dialog::color::[winfo name $w] data set button $data($btn\Btn) if ![winfo ismapped $button] { update } if {$type == "mouse"} { PressButton $button } else { event generate $w focus $w event generate $button event generate $w -keysym Return } } set parent . set verylongstring longstring: set verylongstring $verylongstring$verylongstring set verylongstring $verylongstring$verylongstring set verylongstring $verylongstring$verylongstring set verylongstring $verylongstring$verylongstring #set verylongstring $verylongstring$verylongstring # Interesting thing...when this is too long, the # delay caused in processing it kills the automated testing, # and makes a lot of the test cases fail. #set verylongstring $verylongstring$verylongstring #set verylongstring $verylongstring$verylongstring #set verylongstring $verylongstring$verylongstring #set verylongstring $verylongstring$verylongstring set color #404040 test clrpick-2.1 {tk_chooseColor command} \ {nonUnixUserInteraction colorsLeftover} { ToPressButton $parent ok tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \ -parent $parent } "$color" set color #808040 test clrpick-2.2 {tk_chooseColor command} \ {nonUnixUserInteraction colorsLeftover} { set colors "128 128 64" ToChooseColorByKey $parent 128 128 64 tk_chooseColor -parent $parent -title "choose $colors" } "$color" test clrpick-2.3 {tk_chooseColor command} \ {nonUnixUserInteraction colorsLeftover} { ToPressButton $parent ok tk_chooseColor -parent $parent -title "Press OK" } "$color" test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} { ToPressButton $parent cancel tk_chooseColor -parent $parent -title "Press Cancel" } "" set color "#000000" test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} { after 1 {set x 53} ToPressButton $parent ok tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color } "#000000" test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} { after 1 {set x 53} ToPressButton $parent cancel tk_chooseColor -parent $parent -title "Press Cancel" } "" test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} {unix notAqua} { after 50 {set ::scr [winfo screen .__tk__color]} ToPressButton $parent cancel tk_chooseColor -parent $parent set ::scr } [winfo screen $parent] # cleanup cleanupTests return tk8.5.19/tests/canvText.test0000644003604700454610000004325212612445655014431 0ustar dgp771div# This file is a Tcl script to test out the procedures in tkCanvText.c, # which implement canvas "text" items. It is organized in the standard # fashion for Tcl tests. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands canvas .c -width 400 -height 300 -bd 2 -relief sunken pack .c update set i 1 .c create text 20 20 -tag test set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" set ay [font metrics $font -linespace] set ax [font measure $font 0] foreach test { {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}} {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}} {-fill {} {} {} {}} {-font {Times 40} {Times 40} {} {font "" doesn't exist}} {-justify left left xyz {bad justification "xyz": must be left, right, or center}} {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}} {-tags {test a b c} {test a b c} {} {}} {-text xyz xyz {} {}} {-underline 0 0 xyz {expected integer but got "xyz"}} {-width 6 6 xyz {bad screen distance "xyz"}} } { lassign $test name goodValue goodResult badValue badResult test canvText-1.$i "configuration options: good value for $name" { .c itemconfigure test $name $goodValue list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name] } [list $goodResult $goodResult] incr i if {$badValue ne ""} { test canvText-1.$i "configuration options: bad value for $name" -body { .c itemconfigure test $name $badValue } -returnCodes error -result $badResult } incr i } test canvText-1.$i {configuration options} { .c itemconfigure test -tags {test xyz} .c itemcget xyz -tags } {test xyz} .c delete test .c create text 20 20 -tag test test canvText-2.1 {CreateText procedure: args} { list [catch {.c create text} msg] $msg } {1 {wrong # args: should be ".c create text coords ?arg arg ...?"}} test canvText-2.2 {CreateText procedure: args} { list [catch {.c create text xyz 0} msg] $msg } {1 {bad screen distance "xyz"}} test canvText-2.3 {CreateText procedure: args} { list [catch {.c create text 0 xyz} msg] $msg } {1 {bad screen distance "xyz"}} test canvText-2.4 {CreateText procedure: args} { list [catch {.c create text 0 0 -xyz xyz} msg] $msg } {1 {unknown option "-xyz"}} test canvText-2.5 {CreateText procedure} { .c create text 0 0 -tags x set x [.c coords x] .c delete x set x } {0.0 0.0} focus -force .c .c focus test .c coords test 0 0 update test canvText-3.1 {TextCoords procedure} { .c coords test } {0.0 0.0} test canvText-3.2 {TextCoords procedure} { list [catch {.c coords test xyz 0} msg] $msg } {1 {bad screen distance "xyz"}} test canvText-3.3 {TextCoords procedure} { list [catch {.c coords test 0 xyz} msg] $msg } {1 {bad screen distance "xyz"}} test canvText-3.4 {TextCoords procedure} { .c coords test 10 10 set result {} foreach element [.c coords test] { lappend result [format %.1f $element] } set result } {10.0 10.0} test canvText-3.5 {TextCoords procedure} { list [catch {.c coords test 10} msg] $msg } {1 {wrong # coordinates: expected 2, got 1}} test canvText-3.6 {TextCoords procedure} { list [catch {.c coords test 10 10 10} msg] $msg } {1 {wrong # coordinates: expected 0 or 2, got 3}} test canvText-4.1 {ConfigureText procedure} { list [catch {.c itemconfig test -fill xyz} msg] $msg } {1 {unknown color name "xyz"}} test canvText-4.2 {ConfigureText procedure} { .c itemconfig test -fill blue .c itemcget test -fill } {blue} test canvText-4.3 {ConfigureText procedure: construct font gcs} { .c itemconfig test -font "times 20" -fill black -stipple gray50 list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple] } {{times 20} black gray50} test canvText-4.4 {ConfigureText procedure: construct cursor gc} { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c icursor test 3 # Both black -> cursor becomes white. .c config -insertbackground black .c config -selectbackground black .c itemconfig test -just left update # Both same color (and not black) -> cursor becomes black. .c config -insertbackground red .c config -selectbackground red .c itemconfig test -just left update } {} test canvText-4.5 {ConfigureText procedure: adjust selection} { set x {} .c itemconfig test -text "abcdefghi" .c select from test 2 .c select to test 6 lappend x [selection get] .c dchars test 1 end lappend x [catch {selection get}] .c insert test end "bcdefghi" .c select from test 2 .c select to test 6 lappend x [selection get] .c dchars test 4 end lappend x [selection get] .c insert test end "efghi" .c select from test 6 .c select to test 2 lappend x [selection get] .c dchars test 4 end lappend x [selection get] } {cdefg 1 cdefg cd cdef cd} test canvText-4.6 {ConfigureText procedure: adjust cursor} { .c itemconfig test -text "abcdefghi" set x {} .c icursor test 6 .c dchars test 4 end .c index test insert } {4} test canvText-5.1 {ConfigureText procedure: adjust cursor} { .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz" .c delete x } {} test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} { .c itemconfig test -font $font -text 0 .c coords test 0 0 set x {} lappend x [.c itemconfig test -anchor n; .c bbox test] lappend x [.c itemconfig test -anchor nw; .c bbox test] lappend x [.c itemconfig test -anchor w; .c bbox test] lappend x [.c itemconfig test -anchor sw; .c bbox test] lappend x [.c itemconfig test -anchor s; .c bbox test] lappend x [.c itemconfig test -anchor se; .c bbox test] lappend x [.c itemconfig test -anchor e; .c bbox test] lappend x [.c itemconfig test -anchor ne; .c bbox test] lappend x [.c itemconfig test -anchor center; .c bbox test] } "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\ {-1 0 [expr $ax+1] $ay}\ {-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\ {-1 -$ay [expr $ax+1] 0}\ {[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\ {[expr -$ax-1] -$ay 1 0}\ {[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\ {[expr -$ax-1] 0 1 $ay}\ {[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}" focus .c .c focus test .c itemconfig test -text "abcd\nefghi\njklmnopq" test canvText-7.0 {DisplayText procedure: stippling} { .c itemconfig test -stipple gray50 update .c itemconfig test -stipple {} update } {} test canvText-7.2 {DisplayText procedure: draw selection} { .c select from test 0 .c select to test end update selection get } "abcd\nefghi\njklmnopq" test canvText-7.3 {DisplayText procedure: selection} { .c select from test 0 .c select to test end update selection get } "abcd\nefghi\njklmnopq" test canvText-7.4 {DisplayText procedure: one line selection} { .c select from test 2 .c select to test 3 update } {} test canvText-7.5 {DisplayText procedure: multi-line selection} { .c select from test 2 .c select to test 12 update } {} test canvText-7.6 {DisplayText procedure: draw cursor} { .c icursor test 3 update } {} test canvText-7.7 {DisplayText procedure: selected text different color} { .c config -selectforeground blue .c itemconfig test -anchor n update } {} test canvText-7.8 {DisplayText procedure: not selected} { .c select clear update } {} test canvText-7.9 {DisplayText procedure: select end} { catch {destroy .t} toplevel .t wm geometry .t +0+0 canvas .t.c pack .t.c set id [.t.c create text 0 0 -text Dummy -anchor nw] update .t.c select from $id 0 .t.c select to $id end update #catch {destroy .t} update } {} test canvText-8.1 {TextInsert procedure: 0 length insert} { .c insert test end {} } {} test canvText-8.2 {TextInsert procedure: before beginning/after end} { # Can't test this because GetTextIndex filters out those numbers. } {} test canvText-8.3 {TextInsert procedure: inserting in a selected item} { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 1 "xyz" .c itemcget test -text } {axyzbcdefg} test canvText-8.4 {TextInsert procedure: inserting before selection} { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 1 "xyz" list [.c index test sel.first] [.c index test sel.last] } {5 7} test canvText-8.5 {TextInsert procedure: inserting in selection} { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 3 "xyz" list [.c index test sel.first] [.c index test sel.last] } {2 7} test canvText-8.6 {TextInsert procedure: inserting after selection} { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 5 "xyz" list [.c index test sel.first] [.c index test sel.last] } {2 4} test canvText-8.7 {TextInsert procedure: inserting in unselected item} { .c itemconfig test -text "abcdefg" .c select clear .c insert test 5 "xyz" .c itemcget test -text } {abcdexyzfg} test canvText-8.8 {TextInsert procedure: inserting before cursor} { .c itemconfig test -text "abcdefg" .c icursor test 3 .c insert test 2 "xyz" .c index test insert } {6} test canvText-8.9 {TextInsert procedure: inserting after cursor} { .c itemconfig test -text "abcdefg" .c icursor test 3 .c insert test 4 "xyz" .c index test insert } {3} test canvText-9.1 {TextInsert procedure: before beginning/after end} { # Can't test this because GetTextIndex filters out those numbers. } {} test canvText-9.2 {TextInsert procedure: start > end} { .c itemconfig test -text "abcdefg" .c dchars test 4 2 .c itemcget test -text } {abcdefg} test canvText-9.3 {TextInsert procedure: deleting from a selected item} { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c dchars test 3 5 .c itemcget test -text } {abcg} test canvText-9.4 {TextInsert procedure: deleting before start} { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 1 1 list [.c index test sel.first] [.c index test sel.last] } {3 7} test canvText-9.5 {TextInsert procedure: keep start > first char deleted} { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 2 6 list [.c index test sel.first] [.c index test sel.last] } {2 3} test canvText-9.6 {TextInsert procedure: deleting inside selection} { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 6 6 list [.c index test sel.first] [.c index test sel.last] } {4 7} test canvText-9.7 {TextInsert procedure: keep end > first char deleted} { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 6 10 list [.c index test sel.first] [.c index test sel.last] } {4 5} test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 3 10 list [catch {.c index test sel.first} msg] $msg } {1 {selection isn't in item}} test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 4 7 list [.c index test sel.first] [.c index test sel.last] } {4 4} test canvText-9.10 {TextInsert procedure: move anchor} { .c itemconfig test -text "abcdefghijk" .c select from test 6 .c select to test 8 .c dchars test 2 4 .c select to test 1 list [.c index test sel.first] [.c index test sel.last] } {1 2} test canvText-9.11 {TextInsert procedure: keep anchor >= first} { .c itemconfig test -text "abcdefghijk" .c select from test 6 .c select to test 8 .c dchars test 5 7 .c select to test 1 list [.c index test sel.first] [.c index test sel.last] } {1 4} test canvText-9.12 {TextInsert procedure: anchor doesn't move} { .c itemconfig test -text "abcdefghijk" .c select from test 2 .c select to test 5 .c dchars test 6 8 .c select to test 8 list [.c index test sel.first] [.c index test sel.last] } {2 8} test canvText-9.13 {TextInsert procedure: move cursor} { .c itemconfig test -text "abcdefghijk" .c icursor test 6 .c dchars test 2 4 .c index test insert } {3} test canvText-9.14 {TextInsert procedure: keep cursor >= first} { .c itemconfig test -text "abcdefghijk" .c icursor test 6 .c dchars test 2 10 .c index test insert } {2} test canvText-9.15 {TextInsert procedure: cursor doesn't move} { .c itemconfig test -text "abcdefghijk" .c icursor test 5 .c dchars test 7 9 .c index test insert } {5} test canvText-10.1 {TextToPoint procedure} { .c coords test 0 0 .c itemconfig test -text 0 -anchor center .c index test @0,0 } {0} test canvText-11.1 {TextToArea procedure} { .c coords test 0 0 .c itemconfig test -text 0 -anchor center .c find overlapping 0 0 1 1 } [.c find withtag test] test canvText-11.2 {TextToArea procedure} { .c coords test 0 0 .c itemconfig test -text 0 -anchor center .c find overlapping 1000 1000 1001 1001 } {} test canvText-12.1 {ScaleText procedure} { .c coords test 100 100 .c scale all 50 50 2 2 format {%.6g %.6g} {*}[.c coords test] } {150 150} test canvText-13.1 {TranslateText procedure} { .c coords test 100 100 .c move all 10 10 format {%.6g %.6g} {*}[.c coords test] } {110 110} .c itemconfig test -text "abcdefghijklmno" -anchor nw .c select from test 5 .c select to test 8 .c icursor test 12 .c coords test 0 0 test canvText-14.1 {GetTextIndex procedure} { list [.c index test end] [.c index test insert] \ [.c index test sel.first] [.c index test sel.last] \ [.c index test @0,0] \ [.c index test -1] [.c index test 10] [.c index test 100] } {15 12 5 8 0 0 10 15} test canvText-14.2 {GetTextIndex procedure: select error} { .c select clear list [catch {.c index test sel.first} msg] $msg } {1 {selection isn't in item}} test canvText-14.3 {GetTextIndex procedure: select error} { .c select clear list [catch {.c index test sel.last} msg] $msg } {1 {selection isn't in item}} test canvText-14.4 {GetTextIndex procedure: select error} { .c select clear list [catch {.c index test sel.} msg] $msg } {1 {bad index "sel."}} test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} { list [catch {.c index test xyz} msg] $msg } {1 {bad index "xyz"}} test canvText-14.6 {select clear errors} -body { .c select clear test } -returnCodes error -result "wrong \# args: should be \".c select clear\"" test canvText-15.1 {SetTextCursor procedure} { .c itemconfig -text "abcdefg" .c icursor test 3 .c index test insert } {3} test canvText-16.1 {GetSelText procedure} { .c itemconfig test -text "abcdefghijklmno" -anchor nw .c select from test 5 .c select to test 8 selection get } {fghi} set font {Courier 12 italic} set ax [font measure $font 0] set ay [font metrics $font -linespace] test canvText-17.1 {TextToPostscript procedure} { .c delete all .c config -height 300 -highlightthickness 0 -bd 0 update .c create text 100 100 -tags test .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax] .c itemconfig test -anchor n -fill black set x [.c postscript] set x [string range $x [string first "findfont " $x] end] } "findfont [font actual $font -size] scalefont ISOEncode setfont 0.000 0.000 0.000 setrgbcolor AdjustColor 100 200 \[ \[(000)\] \[(000)\] \[(00)\] ] $ay -0.5 0.0 0 false DrawText grestore restore showpage %%Trailer end %%EOF " test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -body { catch {destroy .c} canvas .c pack .c .c delete all .c create text 100 100 -text Hello\n -anchor nw set bbox [.c bbox 1] set x2 [lindex $bbox 2] set y2 [lindex $bbox 3] incr y2 update .c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1] } -cleanup { unset -nocomplain bbox x2 y2 } -result 1 test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { catch {destroy .c} set c [canvas .c -bg black -width 964] pack $c $c delete all after 1000 "set done 1" ; vwait done set f {Arial 28 bold} set s1 { Yeah-ah-ah-ah-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-Yow} set s2 { Yeah ah ah ah oh oh oh oh oh oh oh oh oh oh oh oh oh oh oh oh Yow} $c create text 21 18 \ -font $f \ -text $s1 \ -fill white \ -width 922 \ -anchor nw \ -tags tbox1 eval {$c create rect} [$c bbox tbox1] -outline red $c create text 21 160 \ -font $f \ -text $s2 \ -fill white \ -width 922 \ -anchor nw \ -tags tbox2 eval {$c create rect} [$c bbox tbox2] -outline red after 1000 "set done 1" ; vwait done set results [list] $c select from tbox2 4 $c select to tbox2 8 lappend results [selection get] $c select from tbox1 4 $c select to tbox1 8 lappend results [selection get] array set metrics [font metrics $f] set x [expr {21 + [font measure $f " "] \ + ([font measure {Arial 28 bold} "Y"] / 2)}] set y1 [expr {18 + ($metrics(-linespace) / 2)}] set y2 [expr {160 + ($metrics(-linespace) / 2)}] lappend results [$c index tbox1 @$x,$y1] lappend results [$c index tbox2 @$x,$y2] set results } {{Yeah } Yeah- 4 4} # cleanup cleanupTests return tk8.5.19/tests/winDialog.test0000644003604700454610000003275712612445655014562 0ustar dgp771div# -*- tcl -*- # This file is a Tcl script to test the Windows specific behavior of # the common dialog boxes. It is organized in the standard # fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 1998-1999 ActiveState Corporation. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands if {[testConstraint testwinevent]} { catch {testwinevent debug 1} } # Locale identifier LANG_ENGLISH is 0x09 testConstraint english [expr { [llength [info commands testwinlocale]] && (([testwinlocale] & 0xff) == 9) }] proc start {arg} { set ::tk_dialog 0 set ::iter_after 0 after 1 $arg } proc then {cmd} { set ::command $cmd set ::dialogresult {} afterbody vwait ::dialogresult return $::dialogresult } proc afterbody {} { if {$::tk_dialog == 0} { if {[incr ::iter_after] > 30} { set ::dialogresult ">30 iterations waiting on tk_dialog" return } after 150 {afterbody} return } uplevel #0 {set dialogresult [eval $command]} } proc Click {button} { switch -exact -- $button { ok { set button 1 } cancel { set button 2 } } testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b } proc GetText {id} { switch -exact -- $id { ok { set id 1 } cancel { set id 2 } } return [testwinevent $::tk_dialog $id WM_GETTEXT] } proc SetText {id text} { return [testwinevent $::tk_dialog $id WM_SETTEXT $text] } test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {tk_chooseColor} then { Click cancel } } -result {0} test winDialog-1.2 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933"]} then { set x [Click cancel] } list $x $clr } -result {0 {}} test winDialog-1.3 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933"]} then { set x [Click ok] } list $x $clr } -result [list 0 "#ff9933"] test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent } -setup { catch {unset a x} } -body { set x {} start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]} then { if {[catch { array set a [testgetwindowinfo $::tk_dialog] if {[info exists a(text)]} {lappend x $a(text)} } err]} { lappend x $err } lappend x [Click ok] } lappend x $clr } -result [list Hello 0 "#ff9933"] test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent } -setup { catch {unset a x} } -body { set x {} start { set clr [tk_chooseColor -initialcolor "#ff9933" \ -title "\u041f\u0440\u0438\u0432\u0435\u0442"] } then { if {[catch { array set a [testgetwindowinfo $::tk_dialog] if {[info exists a(text)]} {lappend x $a(text)} } err]} { lappend x $err } lappend x [Click ok] } lappend x $clr } -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"] test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { testwinevent } -setup { catch {unset a x} } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]} set x {} then { if {[catch { array set a [testgetwindowinfo $::tk_dialog] if {[info exists a(parent)]} { append x [expr {$a(parent) == [wm frame .]}] } } err]} {lappend x $err} Click ok } list $x $clr } -result [list 1 "#ff9933"] test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints { testwinevent } -body { tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12 } -returnCodes error -match glob -result {bad window path name*} test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { nt testwinevent english } -body { start {tk_getOpenFile} then { set x [GetText cancel] Click cancel } return $x } -result {Cancel} test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { nt testwinevent english } -body { start {tk_getSaveFile} then { set x [GetText cancel] Click cancel } return $x } -result {Cancel} test winDialog-5.1 {GetFileName: no arguments} -constraints { nt testwinevent } -body { start {tk_getOpenFile -title Open} then { Click cancel } } -result {0} test winDialog-5.2 {GetFileName: one argument} -constraints { nt } -body { tk_getOpenFile -foo } -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} test winDialog-5.3 {GetFileName: many arguments} -constraints { nt testwinevent } -body { start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} then { Click cancel } } -result {0} test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { nt } -body { tk_getOpenFile -foo bar -abc } -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints { nt testwinevent } -body { start {tk_getOpenFile -title bar} then { Click cancel } } -result {0} test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints { nt } -body { tk_getOpenFile -initialdir bar -title } -returnCodes error -result {value for "-title" missing} test winDialog-5.7 {GetFileName: extension begins with .} -constraints { nt testwinevent } -body { # if (string[0] == '.') { # string++; # } start {set x [tk_getSaveFile -defaultextension .foo -title Save]} set msg {} then { if {[catch {SetText 0x47C bar} msg]} { Click cancel } else { Click ok } } return [string totitle $x]$msg } -cleanup { unset msg } -result [string totitle [file join [pwd] bar.foo]] test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { nt testwinevent } -body { start {set x [tk_getSaveFile -defaultextension foo -title Save]} set msg {} then { if {[catch {SetText 0x47C bar} msg]} { Click cancel } else { Click ok } } return [string totitle $x]$msg } -cleanup { unset msg } -result [string totitle [file join [pwd] bar.foo]] test winDialog-5.9 {GetFileName: file types} -constraints { nt testwinevent } -body { # case FILE_TYPES: start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} then { set x [GetText 0x470] Click cancel } return $x } -result {foo files (*.foo)} test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { nt } -body { # if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) tk_getSaveFile -filetypes {{"foo" .foo FOO}} } -returnCodes error -result {bad Macintosh file type "FOO"} if {[info exists ::env(TEMP)]} { test winDialog-5.11 {GetFileName: initial directory} -constraints { nt testwinevent } -body { # case FILE_INITDIR: start {set x [tk_getSaveFile \ -initialdir [file normalize $::env(TEMP)] \ -initialfile "12x 455" -title Foo]} then { Click ok } return $x } -result [file join [file normalize $::env(TEMP)] "12x 455"] } test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { # if (Tcl_TranslateFileName(interp, string, &ds) == NULL) tk_getOpenFile -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} test winDialog-5.13 {GetFileName: initial file} -constraints { nt testwinevent } -body { # case FILE_INITFILE: start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { Click ok } string totitle $x } -result [string totitle [file join [pwd] "12x 456"]] test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints { nt } -body { # if (Tcl_TranslateFileName(interp, string, &ds) == NULL) tk_getOpenFile -initialfile ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} test winDialog-5.15 {GetFileName: initial file: long name} -constraints { nt testwinevent } -body { start { set dialogresult [catch { tk_getSaveFile -initialfile [string repeat a 1024] -title Long } x] } then { Click ok } list $dialogresult [string match "invalid filename *" $x] } -result {1 1} test winDialog-5.16 {GetFileName: parent} -constraints { nt } -body { # case FILE_PARENT: toplevel .t set x 0 start {tk_getOpenFile -parent .t -title Parent; set x 1} then { destroy .t } return $x } -result {1} test winDialog-5.17 {GetFileName: title} -constraints { nt testwinevent } -body { # case FILE_TITLE: start {tk_getOpenFile -title Narf} then { Click cancel } } -result {0} test winDialog-5.18 {GetFileName: no filter specified} -constraints { nt testwinevent } -body { # if (ofn.lpstrFilter == NULL) start {tk_getOpenFile -title Filter} then { set x [GetText 0x470] Click cancel } return $x } -result {All Files (*.*)} test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { nt } -setup { destroy .t } -body { # if (Tk_WindowId(parent) == None) toplevel .t start {tk_getOpenFile -parent .t -title Open} then { destroy .t } } -result {} test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { nt } -setup { destroy .t } -body { toplevel .t update start {tk_getOpenFile -parent .t -title Open} then { destroy .t } } -result {} test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints { nt testwinevent english } -body { # winCode = GetOpenFileName(&ofn); start {tk_getOpenFile -title Open} then { set x [GetText ok] Click cancel } return $x } -result {&Open} test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints { nt testwinevent english } -body { # winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} then { set x [GetText ok] Click cancel } return $x } -result {&Save} if {[info exists ::env(TEMP)]} { test winDialog-5.23 {GetFileName: convert \ to /} -constraints { nt testwinevent } -body { set msg {} start {set x [tk_getSaveFile -title Back]} then { if {[catch {SetText 0x47C [file nativename \ [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { Click cancel } else { Click ok } } return $x$msg } -cleanup { unset msg } -result [file join [file normalize $::env(TEMP)] "12x 457"] } test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints { nt } -body { # MacOS type that is correct, but has embedded nulls. start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]} then { Click cancel } return $x } -result {0} test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraints { nt } -body { # MacOS type that is correct, but has embedded high-bit chars. start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]} then { Click cancel } return $x } -result {0} ## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows ## because somehow the GetOpenFileName ends up a noop in the static ## build. ## test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints { nt testwinevent } -body { start {tk_chooseDirectory} then { Click cancel } } -result {0} test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints { nt } -body { tk_chooseDirectory -foo } -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { nt testwinevent } -body { start { tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test } then { Click cancel } } -result {0} test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints { nt } -body { tk_chooseDirectory -foo bar -abc } -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} -constraints { nt testwinevent } -body { start {tk_chooseDirectory -title bar} then { Click cancel } } -result {0} test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints { nt } -body { tk_chooseDirectory -initialdir bar -title } -returnCodes error -result {value for "-title" missing} test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { nt testwinevent } -body { # case DIR_INITIAL: start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} then { Click ok } string tolower [set x] } -result {c:/} test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { # if (Tcl_TranslateFileName(interp, string, # &utfDirString) == NULL) tk_chooseDirectory -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} if {[testConstraint testwinevent]} { catch {testwinevent debug 0} } # cleanup cleanupTests return # Local variables: # mode: tcl # End: tk8.5.19/tests/scale.test0000644003604700454610000007021512612445655013723 0ustar dgp771div# This file is a Tcl script to test out the "scale" command # of Tk. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # Create entries in the option database to be sure that geometry options # like border width have predictable values. option add *Scale.borderWidth 2 option add *Scale.highlightThickness 2 option add *Scale.font {Helvetica -12 bold} scale .s -from 100 -to 300 pack .s update set i 1 foreach test { {-activebackground #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bd 4 4 badValue {bad screen distance "badValue"}} {-bigincrement 12.5 12.5 badValue {expected floating-point number but got "badValue"}} {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-command "set x" {set x} {} {}} {-cursor arrow arrow badValue {bad cursor spec "badValue"}} {-digits 5 5 badValue {expected integer but got "badValue"}} {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}} {-font fixed fixed {} {font "" doesn't exist}} {-foreground green green badValue {unknown color name "badValue"}} {-from -15.0 -15.0 badValue {expected floating-point number but got "badValue"}} {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} {-highlightcolor #123456 #123456 non-existent {unknown color name "non-existent"}} {-highlightthickness 2 2 badValue {bad screen distance "badValue"}} {-label "Some text" {Some text} {} {}} {-length 130 130 badValue {bad screen distance "badValue"}} {-orient horizontal horizontal badValue {bad orient "badValue": must be horizontal or vertical}} {-orient horizontal horizontal {} {}} {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-repeatdelay 14 14 bogus {expected integer but got "bogus"}} {-repeatinterval 14 14 bogus {expected integer but got "bogus"}} {-resolution 2.0 2.0 badValue {expected floating-point number but got "badValue"}} {-showvalue 0 0 badValue {expected boolean value but got "badValue"}} {-sliderlength 86 86 badValue {bad screen distance "badValue"}} {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-state d disabled badValue {bad state "badValue": must be active, disabled, or normal}} {-state n normal {} {}} {-takefocus "any string" "any string" {} {}} {-tickinterval 4.3 4.0 badValue {expected floating-point number but got "badValue"}} {-to 14.9 15.0 badValue {expected floating-point number but got "badValue"}} {-troughcolor #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-variable x x {} {}} {-width 32 32 badValue {bad screen distance "badValue"}} } { set name [lindex $test 0] test scale-1.$i {configuration options} { .s configure $name [lindex $test 1] lindex [.s configure $name] 4 } [lindex $test 2] incr i if {[lindex $test 3] ne ""} { test scale-1.$i {configuration options} { list [catch {.s configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } .s configure $name [lindex [.s configure $name] 3] incr i } destroy .s test scale-2.1 {Tk_ScaleCmd procedure} { list [catch {scale} msg] $msg } {1 {wrong # args: should be "scale pathName ?options?"}} test scale-2.2 {Tk_ScaleCmd procedure} { list [catch {scale foo} msg] $msg [winfo child .] } {1 {bad window path name "foo"} {}} test scale-2.3 {Tk_ScaleCmd procedure} { list [catch {scale .s -gorp dumb} msg] $msg [winfo child .] } {1 {unknown option "-gorp"} {}} scale .s -from 100 -to 200 pack .s update idletasks test scale-3.1 {ScaleWidgetCmd procedure} { list [catch {.s} msg] $msg } {1 {wrong # args: should be ".s option ?arg arg ...?"}} test scale-3.2 {ScaleWidgetCmd procedure, cget option} { list [catch {.s cget} msg] $msg } {1 {wrong # args: should be ".s cget option"}} test scale-3.3 {ScaleWidgetCmd procedure, cget option} { list [catch {.s cget a b} msg] $msg } {1 {wrong # args: should be ".s cget option"}} test scale-3.4 {ScaleWidgetCmd procedure, cget option} { list [catch {.s cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} test scale-3.5 {ScaleWidgetCmd procedure, cget option} { .s cget -highlightthickness } {2} test scale-3.6 {ScaleWidgetCmd procedure, configure option} { list [llength [.s configure]] [lindex [.s configure] 6] } {33 {-command command Command {} {}}} test scale-3.7 {ScaleWidgetCmd procedure, configure option} { list [catch {.s configure -foo} msg] $msg } {1 {unknown option "-foo"}} test scale-3.8 {ScaleWidgetCmd procedure, configure option} { list [catch {.s configure -borderwidth 2 -bg} msg] $msg } {1 {value for "-bg" missing}} test scale-3.9 {ScaleWidgetCmd procedure, coords option} { list [catch {.s coords a b} msg] $msg } {1 {wrong # args: should be ".s coords ?value?"}} test scale-3.10 {ScaleWidgetCmd procedure, coords option} { list [catch {.s coords bad} msg] $msg } {1 {expected floating-point number but got "bad"}} test scale-3.11 {ScaleWidgetCmd procedure} {fonts} { .s set 120 .s coords } {38 34} test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} { .s configure -orient horizontal update .s set 120 .s coords } {34 31} .s configure -orient vertical update test scale-3.13 {ScaleWidgetCmd procedure, get option} { list [catch {.s get a} msg] $msg } {1 {wrong # args: should be ".s get ?x y?"}} test scale-3.14 {ScaleWidgetCmd procedure, get option} { list [catch {.s get a b c} msg] $msg } {1 {wrong # args: should be ".s get ?x y?"}} test scale-3.15 {ScaleWidgetCmd procedure, get option} { list [catch {.s get a 11} msg] $msg } {1 {expected integer but got "a"}} test scale-3.16 {ScaleWidgetCmd procedure, get option} { list [catch {.s get 12 b} msg] $msg } {1 {expected integer but got "b"}} test scale-3.17 {ScaleWidgetCmd procedure, get option} { .s set 133 .s get } 133 test scale-3.18 {ScaleWidgetCmd procedure, get option} { .s configure -resolution 0.5 .s set 150 .s get 37 34 } 119.5 .s configure -resolution 1 test scale-3.19 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify} msg] $msg } {1 {wrong # args: should be ".s identify x y"}} test scale-3.20 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify 1 2 3} msg] $msg } {1 {wrong # args: should be ".s identify x y"}} test scale-3.21 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify boo 16} msg] $msg } {1 {expected integer but got "boo"}} test scale-3.22 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify 17 bad} msg] $msg } {1 {expected integer but got "bad"}} test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} { .s set 120 list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80] } {trough1 slider trough2 {}} test scale-3.24 {ScaleWidgetCmd procedure, set option} { list [catch {.s set} msg] $msg } {1 {wrong # args: should be ".s set value"}} test scale-3.25 {ScaleWidgetCmd procedure, set option} { list [catch {.s set a b} msg] $msg } {1 {wrong # args: should be ".s set value"}} test scale-3.26 {ScaleWidgetCmd procedure, set option} { list [catch {.s set bad} msg] $msg } {1 {expected floating-point number but got "bad"}} test scale-3.27 {ScaleWidgetCmd procedure, set option} { .s set 142 } {} test scale-3.28 {ScaleWidgetCmd procedure, set option} { .s set 118 .s configure -state disabled .s set 181 .s configure -state normal .s get } {118} test scale-3.29 {ScaleWidgetCmd procedure} { list [catch {.s dumb} msg] $msg } {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}} test scale-3.30 {ScaleWidgetCmd procedure} { list [catch {.s c} msg] $msg } {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}} test scale-3.31 {ScaleWidgetCmd procedure} { list [catch {.s co} msg] $msg } {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}} test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} { proc kill args { destroy .s } catch {destroy .s} scale .s -variable x -from 0 -to 100 -orient horizontal pack .s update .s configure -command kill .s set 55 } {} test scale-4.1 {DestroyScale procedure} { catch {destroy .s} set x 50 scale .s -variable x -from 0 -to 100 -orient horizontal pack .s update destroy .s list [catch {set x foo} msg] $msg $x } {0 foo foo} test scale-5.1 {ConfigureScale procedure} { catch {destroy .s} set x 66 set y 77 scale .s -variable x -from 0 -to 100 pack .s update .s configure -variable y list [catch {set x foo} msg] $msg $x [.s get] } {0 foo foo 77} test scale-5.2 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 0 -to 100 list [catch {.s configure -foo bar} msg] $msg } {1 {unknown option "-foo"}} test scale-5.3 {ConfigureScale procedure} { catch {destroy .s} catch {unset x} scale .s -from 0 -to 100 -variable x set result $x lappend result [.s get] set x 92 lappend result [.s get] .s set 3 lappend result $x unset x lappend result [catch {set x} msg] $msg } {0 0 92 3 0 3} test scale-5.4 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 0 -to 100 list [catch {.s configure -orient dumb} msg] $msg } {1 {bad orient "dumb": must be horizontal or vertical}} test scale-5.5 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76 list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \ [format %.1f [.s cget -tickinterval]] } {1.1 1.9 0.8} test scale-5.6 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 1 -to 10 -tickinterval -2 pack .s set result [lindex [.s configure -tickinterval] 4] .s configure -from 10 -to 1 -tickinterval 2 lappend result [lindex [.s configure -tickinterval] 4] } {2.0 -2.0} test scale-5.7 {ConfigureScale procedure} { catch {destroy .s} list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg } {1 {bad state "bogus": must be active, disabled, or normal}} catch {destroy .s} scale .s -orient horizontal -length 200 pack .s test scale-6.1 {ComputeFormat procedure} { .s configure -from 10 -to 100 -resolution 10 .s set 49.3 .s get } {50} test scale-6.2 {ComputeFormat procedure} { .s configure -from 100 -to 1000 -resolution 100 .s set 493 .s get } {500} test scale-6.3 {ComputeFormat procedure} { .s configure -from 1000 -to 10000 -resolution 1000 .s set 4930 .s get } {5000} test scale-6.4 {ComputeFormat procedure} { .s configure -from 10000 -to 100000 -resolution 10000 .s set 49000 .s get } {50000} test scale-6.5 {ComputeFormat procedure} { .s configure -from 100000 -to 1000000 -resolution 100000 .s set 493000 .s get } {500000} test scale-6.6 {ComputeFormat procedure} {nonPortable} { # This test is non-portable because some platforms format the # result as 5e+06. .s configure -from 1000000 -to 10000000 -resolution 1000000 .s set 4930000 .s get } {5000000} test scale-6.7 {ComputeFormat procedure} { .s configure -from 1000000000 -to 10000000000 -resolution 1000000000 .s set 4930000000 expr {[.s get] == 5.0e+09} } 1 test scale-6.8 {ComputeFormat procedure} { .s configure -from .1 -to 1 -resolution .1 .s set .6 .s get } {0.6} test scale-6.9 {ComputeFormat procedure} { .s configure -from .01 -to .1 -resolution .01 .s set .06 .s get } {0.06} test scale-6.10 {ComputeFormat procedure} { .s configure -from .001 -to .01 -resolution .001 .s set .006 .s get } {0.006} test scale-6.11 {ComputeFormat procedure} { .s configure -from .0001 -to .001 -resolution .0001 .s set .0006 .s get } {0.0006} test scale-6.12 {ComputeFormat procedure} { .s configure -from .00001 -to .0001 -resolution .00001 .s set .00006 .s get } {0.00006} test scale-6.13 {ComputeFormat procedure} { .s configure -from .000001 -to .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} } {1} test scale-6.14 {ComputeFormat procedure} { .s configure -to .00001 -from .0001 -resolution .00001 .s set .00006 .s get } {0.00006} test scale-6.15 {ComputeFormat procedure} { .s configure -to .000001 -from .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} } {1} test scale-6.16 {ComputeFormat procedure} { .s configure -from .00001 -to .0001 -resolution .00001 -digits 1 .s set .00006 expr {[.s get] == 6e-05} } {1} test scale-6.17 {ComputeFormat procedure} { .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3 .s set 49300000 .s get } {50000000} test scale-6.18 {ComputeFormat procedure} { .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0 .s set .111111111 .s get } {0.11} test scale-6.19 {ComputeFormat procedure} { .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0 .s set 1001.23456789 .s get } {1001.23} test scale-6.20 {ComputeFormat procedure} { .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0 .s set 1001.23456789 .s get } {1001.235} test scale-6.21 {ComputeFormat procedure} { .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 200 .s set 1001.23456789 .s get } {1001.235} test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} { catch {destroy .s} scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {88 458} test scale-7.2 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {168 108} test scale-7.3 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \ -sliderlength 10 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {22 108} test scale-7.4 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \ -relief sunken pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {39 114} test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} { catch {destroy .s} scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {458 61} test scale-7.6 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \ -tick 500 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {108 79} test scale-7.7 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {108 27} test scale-7.8 {ComputeScaleGeometry procedure} { catch {destroy .s} scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \ -relief raised -highlightthickness 2 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {114 39} test scale-8.1 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \ [.s identify 71 52] } {{} trough1 trough1 {}} test scale-8.2 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \ [.s identify 60 303] } {{} trough1 trough2 {}} test scale-8.3 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \ [.s identify 60 114] \ } {trough1 slider slider trough2} test scale-8.4 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \ -highlightthickness 1 -length 300 -showvalue 0 pack .s .s set 30 update list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \ [.s identify 23 40] \ } {{} trough1 trough1 {}} test scale-8.5 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 1 \ -highlightthickness 2 -tick 20 -sliderlength 20 \ -length 200 -label Test pack .s .s set 30 update list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \ [.s identify 150 54] } {{} trough2 trough2 {}} test scale-8.6 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 2 \ -highlightthickness 1 -tick 20 -length 200 pack .s .s set 30 update list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \ [.s identify 150 40] } {{} trough2 trough2 {}} test scale-8.7 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \ -length 200 -width 10 -showvalue 0 pack .s .s set 30 update list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \ [.s identify 30 24] } {{} trough1 trough1 {}} test scale-8.8 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 30 update list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \ [.s identify 203 28] } {{} trough1 trough2 {}} test scale-8.9 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 80 update list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \ [.s identify 166 28] } {trough1 slider slider trough2} catch {destroy .s} scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 pack .s update test scale-9.1 {PixelToValue procedure} { .s get 46 0 } 0 test scale-9.2 {PixelToValue procedure} { .s get -10 9 } 0 test scale-9.3 {PixelToValue procedure} { .s get -10 12 } 1 test scale-9.4 {PixelToValue procedure} { .s get -10 46 } 35 test scale-9.5 {PixelToValue procedure} { .s get -10 110 } 99 test scale-9.6 {PixelToValue procedure} { .s get -10 111 } 100 test scale-9.7 {PixelToValue procedure} { .s get -10 112 } 100 test scale-9.8 {PixelToValue procedure} { .s get -10 154 } 100 .s configure -orient horizontal update test scale-9.9 {PixelToValue procedure} { .s get 76 152 } 65 test scale-10.1 {ValueToPixel procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \ -orient horizontal -label Test -tick 20 pack .s update list [.s coords -10] [.s coords 40] [.s coords 1000] } {{16 47} {56 47} {116 47}} test scale-10.2 {ValueToPixel procedure} {fonts} { catch {destroy .s} scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \ -orient vertical -label Test -tick 20 pack .s update list [.s coords -10] [.s coords 40] [.s coords 1000] } {{62 114} {62 74} {62 14}} test scale-11.1 {ScaleEventProc procedure} { proc killScale value { global x if {$value > 30} { destroy .s1 lappend x [winfo exists .s1] [info commands .s1] } } catch {destroy .s1} set x initial scale .s1 -from 0 -to 100 -command killScale .s1 set 20 pack .s1 update idletasks lappend x [winfo exists .s1] .s1 set 40 update idletasks rename killScale {} set x } {initial 1 0 {}} test scale-11.2 {ScaleEventProc procedure} { deleteWindows scale .s1 -bg #543210 rename .s1 .s2 set x {} lappend x [winfo children .] lappend x [.s2 cget -bg] destroy .s1 lappend x [info command .s*] [winfo children .] } {.s1 #543210 {} {}} test scale-12.1 {ScaleCmdDeletedProc procedure} { deleteWindows scale .s1 rename .s1 {} list [info command .s*] [winfo children .] } {{} {}} catch {destroy .s} scale .s -from 0 -to 100 -command {set x} -variable y pack .s update proc varTrace args { global traceInfo set traceInfo $args } test scale-13.1 {SetScaleValue procedure} { set x xyzzy .s set 44 set result [list $x $y] update lappend result $x $y } {xyzzy 44 44 44} test scale-13.2 {SetScaleValue procedure} { .s set -3 .s get } 0 test scale-13.3 {SetScaleValue procedure} { .s set 105 .s get } 100 .s configure -from 100 -to 0 test scale-13.4 {SetScaleValue procedure} { .s set -3 .s get } 0 test scale-13.5 {SetScaleValue procedure} { .s set 105 .s get } 100 test scale-13.6 {SetScaleValue procedure} { .s set 50 update trace variable y w varTrace set traceInfo empty set x untouched .s set 50 update list $x $traceInfo } {untouched empty} catch {destroy .s} scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal pack .s update .s configure -resolution 4.0 update test scale-14.1 {RoundToResolution procedure} { .s get 84 152 } 72 test scale-14.2 {RoundToResolution procedure} { .s get 86 152 } 76 .s configure -from 100 -to 0 update test scale-14.3 {RoundToResolution procedure} { .s get 84 152 } 28 test scale-14.4 {RoundToResolution procedure} { .s get 86 152 } 24 .s configure -from -100 -to 0 update test scale-14.5 {RoundToResolution procedure} { .s get 84 152 } -28 test scale-14.6 {RoundToResolution procedure} { .s get 86 152 } -24 .s configure -from 0 -to -100 update test scale-14.7 {RoundToResolution procedure} { .s get 84 152 } -72 test scale-14.8 {RoundToResolution procedure} { .s get 86 152 } -76 .s configure -from 0 -to 2.25 -resolution 0 update test scale-14.9 {RoundToResolution procedure} { .s get 84 152 } 1.64 test scale-14.10 {RoundToResolution procedure} { .s get 86 152 } 1.69 .s configure -from 0 -to 225 -resolution 0 -digits 5 update test scale-14.11 {RoundToResolution procedure} { .s get 84 152 } 164.25 test scale-14.12 {RoundToResolution procedure} { .s get 86 152 } 168.75 test scale-15.1 {ScaleVarProc procedure} { catch {destroy .s} set y -130 scale .s -from 0 -to -200 -variable y -orient horizontal -length 150 pack .s set y } -130 test scale-15.2 {ScaleVarProc procedure} { catch {destroy .s} set y -130 scale .s -from -200 -to 0 -variable y -orient horizontal -length 150 pack .s set y -87 .s get } -87 test scale-15.3 {ScaleVarProc procedure} { catch {destroy .s} set y -130 scale .s -from -200 -to 0 -variable y -orient horizontal -length 150 pack .s list [catch {set y 40q} msg] $msg [.s get] } {1 {can't set "y": can't assign non-numeric value to scale variable} -130} test scale-15.4 {ScaleVarProc procedure} { catch {destroy .s} set y 1 scale .s -from 1 -to 0 -variable y -orient horizontal -length 150 pack .s list [catch {set y x} msg] $msg [.s get] } {1 {can't set "y": can't assign non-numeric value to scale variable} 1} test scale-15.5 {ScaleVarProc procedure, variable deleted} { catch {destroy .s} set y 6 scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \ -command "set x" pack .s update set x untouched unset y update list [catch {set y} msg] $msg [.s get] $x } {0 6 6 untouched} test scale-15.6 {ScaleVarProc procedure, don't call -command} { catch {destroy .s} set y 6 scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \ -command "set x" pack .s update set x untouched set y 60 update list $x [.s get] } {untouched 60} set l [interp hidden] deleteWindows test scale-16.1 {scale widget vs hidden commands} { catch {destroy .s} scale .s interp hide {} .s destroy .s list [winfo children .] [interp hidden] } [list {} $l] test scale-17.1 {bug fix 1786} { # Perhaps x is set to {}, depending on what other tests have run. # If x is unset, or set to something not convertable to a double, # then the scale try to initialize its value with the contents # of uninitialized memory. Sometimes that causes an FPE. set x {} scale .s -from 100 -to 300 pack .s update .s configure -variable x ;# CRASH! -> Floating point exception # Bug 4833 changed the result to realize that x should pick up # a value from the scale. In an FPE occurs, it is due to the # lack of errno being set to 0 by some libc's. (see bug 4942) set x } {100} test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} { catch {destroy .s} scale .s -cursor trek destroy .s } {} test scale-18.2 {Scale button 1 events [Bug 787065]} \ -setup { catch {destroy .s} set y 5 scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 pack .s tkwait visibility .s set ::error {} proc bgerror {args} {set ::error $args} } \ -body { list [catch { event generate .s <1> -x 0 -y 0 event generate .s -x 0 -y 0 update set ::error } msg] $msg } \ -cleanup { unset ::error rename bgerror {} catch {destroy .s} } \ -result {0 {}} test scale-18.3 {Scale button 2 events [Bug 787065]} \ -setup { catch {destroy .s} set y 5 scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 pack .s tkwait visibility .s set ::error {} proc bgerror {args} {set ::error $args} } \ -body { list [catch { event generate .s <2> -x 0 -y 0 event generate .s -x 0 -y 0 update set ::error } msg] $msg } \ -cleanup { unset ::error rename bgerror {} catch {destroy .s} } \ -result {0 {}} test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \ -setup { catch {destroy .s} catch {destroy .s1 .s2 .s3 .s4} unset -nocomplain x1 x2 x3 x4 x y scale .s1 -from 0 -to 100 -resolution 1 -variable x1 -digits 4 -orient horizontal -length 100 scale .s2 -from 0 -to 100 -resolution -1 -variable x2 -digits 4 -orient horizontal -length 100 scale .s3 -from 100 -to 0 -resolution 1 -variable x3 -digits 4 -orient horizontal -length 100 scale .s4 -from 100 -to 0 -resolution -1 -variable x4 -digits 4 -orient horizontal -length 100 pack .s1 .s2 .s3 .s4 -side left update } \ -body { foreach {x y} [.s1 coord 50] {} event generate .s1 <1> -x $x -y $y event generate .s1 -x $x -y $y foreach {x y} [.s2 coord 50] {} event generate .s2 <1> -x $x -y $y event generate .s2 -x $x -y $y foreach {x y} [.s3 coord 50] {} event generate .s3 <1> -x $x -y $y event generate .s3 -x $x -y $y foreach {x y} [.s4 coord 50] {} event generate .s4 <1> -x $x -y $y event generate .s4 -x $x -y $y update list $x1 $x2 $x3 $x4 } \ -cleanup { unset x1 x2 x3 x4 x y destroy .s1 .s2 .s3 .s4 } \ -result {1.0 1.0 1.0 1.0} catch {destroy .s} option clear # cleanup cleanupTests return tk8.5.19/tests/listbox.test0000644003604700454610000021017612650173000014302 0ustar dgp771div# This file is a Tcl script to test out the "listbox" command # of Tk. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1993-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands set fixed {Courier -12} proc record {name args} { global log lappend log [format {%s %.6g %.6g} $name {*}$args] } proc getsize w { regexp {(^[^+-]*)} [wm geometry $w] foo x return $x } proc resetGridInfo {} { # Some window managers, such as mwm, don't reset gridding information # unless the window is withdrawn and re-mapped. If this procedure # isn't invoked, the window manager will stay in gridded mode, which # can cause all sorts of problems. The "wm positionfrom" command is # needed so that the window manager doesn't ask the user to # manually position the window when it is re-mapped. wm withdraw . wm positionfrom . user wm deiconify . } # Procedure that creates a second listbox for checking things related # to partially visible lines. proc mkPartial {{w .partial}} { catch {destroy $w} toplevel $w wm geometry $w +0+0 listbox $w.l -width 30 -height 5 pack $w.l -expand 1 -fill both $w.l insert end one two three four five six seven eight nine ten \ eleven twelve thirteen fourteen fifteen update scan [wm geometry $w] "%dx%d" width height wm geometry $w ${width}x[expr $height-3] update } # Create entries in the option database to be sure that geometry options # like border width have predictable values. option add *Listbox.borderWidth 2 option add *Listbox.highlightThickness 2 option add *Listbox.font {Helvetica -12 bold} listbox .l pack .l update resetGridInfo set i 1 foreach test { {-activestyle under underline foo {bad activestyle "foo": must be dotbox, none, or underline}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bd 4 4 badValue {bad screen distance "badValue"}} {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-cursor arrow arrow badValue {bad cursor spec "badValue"}} {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}} {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} {-fg #110022 #110022 bogus {unknown color name "bogus"}} {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}} {-foreground #110022 #110022 bogus {unknown color name "bogus"}} {-height 30 30 20p {expected integer but got "20p"}} {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} {-highlightthickness -2 0 {} {}} {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} {-selectmode string string {} {}} {-setgrid false 0 lousy {expected boolean value but got "lousy"}} {-state disabled disabled foo {bad state "foo": must be disabled or normal}} {-takefocus "any string" "any string" {} {}} {-width 45 45 3p {expected integer but got "3p"}} {-xscrollcommand {Some command} {Some command} {} {}} {-yscrollcommand {Another command} {Another command} {} {}} {-listvar testVariable testVariable {} {}} } { set name [lindex $test 0] test listbox-1.$i {configuration options} { .l configure $name [lindex $test 1] list [lindex [.l configure $name] 4] [.l cget $name] } [list [lindex $test 2] [lindex $test 2]] incr i if {[lindex $test 3] != ""} { test listbox-1.$i {configuration options} { list [catch {.l configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } .l configure $name [lindex [.l configure $name] 3] incr i } test listbox-2.1 {Tk_ListboxCmd procedure} { list [catch {listbox} msg] $msg } {1 {wrong # args: should be "listbox pathName ?options?"}} test listbox-2.2 {Tk_ListboxCmd procedure} { list [catch {listbox gorp} msg] $msg } {1 {bad window path name "gorp"}} test listbox-2.3 {Tk_ListboxCmd procedure} { catch {destroy .l} listbox .l list [winfo exists .l] [winfo class .l] [info commands .l] } {1 Listbox .l} test listbox-2.4 {Tk_ListboxCmd procedure} { catch {destroy .l} list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \ [info commands .l] } {1 {unknown option "-gorp"} 0 {}} test listbox-2.5 {Tk_ListboxCmd procedure} { catch {destroy .l} listbox .l } {.l} catch {destroy .l} listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2 pack .l .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \ el15 el16 el17 update test listbox-3.1 {ListboxWidgetCmd procedure} { list [catch .l msg] $msg } {1 {wrong # args: should be ".l option ?arg arg ...?"}} test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} { list [catch {.l activate} msg] $msg } {1 {wrong # args: should be ".l activate index"}} test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} { list [catch {.l activate a b} msg] $msg } {1 {wrong # args: should be ".l activate index"}} test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} { list [catch {.l activate fooey} msg] $msg } {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}} test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} { .l activate 3 .l index active } 3 test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} { .l activate -1 .l index active } {0} test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} { .l activate 30 .l index active } {17} test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} { .l activate end .l index active } {17} test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} { list [catch {.l bbox} msg] $msg } {1 {wrong # args: should be ".l bbox index"}} test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} { list [catch {.l bbox a b} msg] $msg } {1 {wrong # args: should be ".l bbox index"}} test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} { list [catch {.l bbox fooey} msg] $msg } {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}} test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} { .l yview 3 update list [.l bbox 2] [.l bbox 8] } {{} {}} test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} { # Used to generate a core dump before a bug was fixed (the last # element would be on-screen if it existed, but it doesn't exist). listbox .l2 pack .l2 -side top tkwait visibility .l2 set x [.l2 bbox 0] destroy .l2 set x } {} test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { .l yview 3 update list [.l bbox 3] [.l bbox 4] } {{7 7 17 14} {7 26 17 14}} test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { .l yview 0 update list [.l bbox -1] [.l bbox 0] } {{} {7 7 17 14}} test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { .l yview end update list [.l bbox 17] [.l bbox end] [.l bbox 18] } {{7 83 24 14} {7 83 24 14} {}} test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { catch {destroy .t} toplevel .t wm geom .t +0+0 listbox .t.l -width 10 -height 5 .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short" pack .t.l update .t.l xview moveto .2 .t.l bbox 2 } {-72 39 393 14} test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {fonts} { mkPartial list [.partial.l bbox 3] [.partial.l bbox 4] } {{5 56 24 14} {5 73 23 14}} test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} { list [catch {.l cget} msg] $msg } {1 {wrong # args: should be ".l cget option"}} test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} { list [catch {.l cget a b} msg] $msg } {1 {wrong # args: should be ".l cget option"}} test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} { list [catch {.l cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} { .l cget -setgrid } {0} test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} { llength [.l configure] } {27} test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} { list [catch {.l configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} { .l configure -setgrid } {-setgrid setGrid SetGrid 0 0} test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} { list [catch {.l configure -gorp is_messy} msg] $msg } {1 {unknown option "-gorp"}} test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} { set oldbd [.l cget -bd] set oldht [.l cget -highlightthickness] .l configure -bd 3 -highlightthickness 0 set x "[.l cget -bd] [.l cget -highlightthickness]" .l configure -bd $oldbd -highlightthickness $oldht set x } {3 0} test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} { list [catch {.l curselection a} msg] $msg } {1 {wrong # args: should be ".l curselection"}} test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} { .l selection clear 0 end .l selection set 3 6 .l selection set 9 .l curselection } {3 4 5 6 9} test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} { list [catch {.l delete} msg] $msg } {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}} test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} { list [catch {.l delete a b c} msg] $msg } {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}} test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} { list [catch {.l delete badIndex} msg] $msg } {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}} test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} { list [catch {.l delete 2 123ab} msg] $msg } {1 {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}} test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 3 list [.l2 get 2] [.l2 get 3] [.l2 index end] } {el2 el4 7} test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 2 4 list [.l2 get 1] [.l2 get 2] [.l2 index end] } {el1 el5 5} test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete -3 2 .l2 get 0 end } {el3 el4 el5 el6 el7} test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete -3 -1 .l2 get 0 end } {el0 el1 el2 el3 el4 el5 el6 el7} test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 2 end .l2 get 0 end } {el0 el1} test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 5 20 .l2 get 0 end } {el0 el1 el2 el3 el4} test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete end 20 .l2 get 0 end } {el0 el1 el2 el3 el4 el5 el6} test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 8 20 .l2 get 0 end } {el0 el1 el2 el3 el4 el5 el6 el7} test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} { list [catch {.l get} msg] $msg } {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}} test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} { list [catch {.l get a b c} msg] $msg } {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}} test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} { list [catch {.l get 2.4} msg] $msg } {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}} test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} { list [catch {.l get end bogus} msg] $msg } {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}} test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 list [.l2 get 0] [.l2 get 3] [.l2 get end] } {el0 el3 el7} test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} { catch {destroy .l2} listbox .l2 list [.l2 get 0] [.l2 get end] } {{} {}} test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} { catch {destroy .l2} listbox .l2 .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7 .l2 get 3 end } {{two words} el4 el5 el6 el7} test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} { .l get -1 } {} test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} { .l get -2 -1 } {} test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} { .l get -2 3 } {el0 el1 el2 el3} test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} { .l get 12 end } {el12 el13 el14 el15 el16 el17} test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} { .l get 12 20 } {el12 el13 el14 el15 el16 el17} test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} { .l get end } {el17} test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} { .l get 30 } {} test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} { .l get 30 35 } {} test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} { list [catch {.l index} msg] $msg } {1 {wrong # args: should be ".l index index"}} test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} { list [catch {.l index a b} msg] $msg } {1 {wrong # args: should be ".l index index"}} test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} { list [catch {.l index @} msg] $msg } {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}} test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} { .l index 2 } 2 test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} { .l index -1 } -1 test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} { .l index end } 18 test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} { .l index 34 } 34 test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} { list [catch {.l insert} msg] $msg } {1 {wrong # args: should be ".l insert index ?element element ...?"}} test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} { list [catch {.l insert badIndex} msg] $msg } {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}} test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} { catch {destroy .l2} listbox .l2 .l2 insert end a b c d e .l2 insert 3 x y z .l2 get 0 end } {a b c x y z d e} test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} { catch {destroy .l2} listbox .l2 .l2 insert end a b c .l2 insert -1 x .l2 get 0 end } {x a b c} test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} { catch {destroy .l2} listbox .l2 .l2 insert end a b c .l2 insert end x .l2 get 0 end } {a b c x} test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} { catch {destroy .l2} listbox .l2 .l2 insert end a b c .l2 insert 43 x .l2 get 0 end } {a b c x} test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} { list [catch {.l nearest} msg] $msg } {1 {wrong # args: should be ".l nearest y"}} test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} { list [catch {.l nearest a b} msg] $msg } {1 {wrong # args: should be ".l nearest y"}} test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} { list [catch {.l nearest 20p} msg] $msg } {1 {expected integer but got "20p"}} test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} { .l yview 3 .l nearest 1000 } {7} test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} { list [catch {.l scan a b} msg] $msg } {1 {wrong # args: should be ".l scan mark|dragto x y"}} test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} { list [catch {.l scan a b c d} msg] $msg } {1 {wrong # args: should be ".l scan mark|dragto x y"}} test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} { list [catch {.l scan foo bogus 2} msg] $msg } {1 {expected integer but got "bogus"}} test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} { list [catch {.l scan foo 2 2.3} msg] $msg } {1 {expected integer but got "2.3"}} test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} { catch {destroy .t} toplevel .t wm geom .t +0+0 listbox .t.l -width 10 -height 5 .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short" a b c d e f g h i j pack .t.l update .t.l scan mark 100 140 .t.l scan dragto 90 137 update list [format {%.6g %.6g} {*}[.t.l xview]] [format {%.6g %.6g} {*}[.t.l yview]] } {{0.249364 0.427481} {0.0714286 0.428571}} test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} { list [catch {.l scan foo 2 4} msg] $msg } {1 {bad option "foo": must be mark or dragto}} test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} { list [catch {.l see} msg] $msg } {1 {wrong # args: should be ".l see index"}} test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} { list [catch {.l see a b} msg] $msg } {1 {wrong # args: should be ".l see index"}} test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} { list [catch {.l see gorp} msg] $msg } {1 {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}} test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see 7 .l index @0,0 } {7} test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see 11 .l index @0,0 } {7} test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see 6 .l index @0,0 } {6} test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see 5 .l index @0,0 } {3} test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see 12 .l index @0,0 } {8} test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see 13 .l index @0,0 } {11} test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see -1 .l index @0,0 } {0} test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see end .l index @0,0 } {13} test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} { .l yview 7 .l see 322 .l index @0,0 } {13} test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} { mkPartial .partial.l see 4 .partial.l index @0,0 } {1} test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} { list [catch {.l select a} msg] $msg } {1 {wrong # args: should be ".l selection option index ?index?"}} test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} { list [catch {.l select a b c d} msg] $msg } {1 {wrong # args: should be ".l selection option index ?index?"}} test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} { list [catch {.l selection a bogus} msg] $msg } {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}} test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} { list [catch {.l selection a 0 lousy} msg] $msg } {1 {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}} test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} { list [catch {.l selection anchor 0 0} msg] $msg } {1 {wrong # args: should be ".l selection anchor index"}} test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} { list [.l selection anchor 5; .l index anchor] \ [.l selection anchor 0; .l index anchor] } {5 0} test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} { .l selection anchor -1 .l index anchor } {0} test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} { .l selection anchor end .l index anchor } {17} test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} { .l selection anchor 44 .l index anchor } {17} test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} { .l selection clear 0 end .l selection set 2 8 .l selection clear 3 4 .l curselection } {2 5 6 7 8} test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} { list [catch {.l selection includes 0 0} msg] $msg } {1 {wrong # args: should be ".l selection includes index"}} test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} { .l selection clear 0 end .l selection set 2 8 .l selection clear 4 list [.l selection includes 3] [.l selection includes 4] \ [.l selection includes 5] } {1 0 1} test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} { .l selection set 0 end .l selection includes -1 } {0} test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} { .l selection clear 0 end .l selection set end .l selection includes end } {1} test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} { .l selection set 0 end .l selection includes 44 } {0} test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} { catch {destroy .l2} listbox .l2 .l2 selection includes 0 } {0} test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} { .l selection clear 0 end .l selection set 2 .l selection set 5 7 .l curselection } {2 5 6 7} test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} { .l selection set 5 7 .l curselection } {2 5 6 7} test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} { list [catch {.l selection badOption 0 0} msg] $msg } {1 {bad option "badOption": must be anchor, clear, includes, or set}} test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} { list [catch {.l size a} msg] $msg } {1 {wrong # args: should be ".l size"}} test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} { .l size } {18} test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} { catch {destroy .l2} listbox .l2 update format {%.6g %.6g} {*}[.l2 xview] } {0 1} test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} { catch {destroy .l} listbox .l -width 10 -height 5 -font $fixed .l insert 0 a b c d e f g h i j k l m n o p q r s t pack .l update format {%.6g %.6g} {*}[.l xview] } {0 1} catch {destroy .l} listbox .l -width 10 -height 5 -font $fixed .l insert 0 a b c d e f g h i j k l m n o p q r s t .l insert 1 "0123456789a123456789b123456789c123456789d123456789" pack .l update test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} {fonts} { .l xview 4 format {%.6g %.6g} {*}[.l xview] } {0.08 0.28} test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l xview foo} msg] $msg } {1 {expected integer but got "foo"}} test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l xview zoom a b} msg] $msg } {1 {unknown option "zoom": must be moveto or scroll}} test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} {fonts} { .l xview 0 .l xview moveto .4 update format {%.6g %.6g} {*}[.l xview] } {0.4 0.6} test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} {fonts} { .l xview 0 .l xview scroll 2 units update format {%.6g %.6g} {*}[.l xview] } {0.04 0.24} test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} {fonts} { .l xview 30 .l xview scroll -1 pages update format {%.6g %.6g} {*}[.l xview] } {0.44 0.64} test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} {fonts} { .l configure -width 1 update .l xview 30 .l xview scroll -4 pages update format {%.6g %.6g} {*}[.l xview] } {0.52 0.54} test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} { catch {destroy .l} listbox .l pack .l update format {%.6g %.6g} {*}[.l yview] } {0 1} test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} { catch {destroy .l} listbox .l .l insert 0 el1 pack .l update format {%.6g %.6g} {*}[.l yview] } {0 1} catch {destroy .l} listbox .l -width 10 -height 5 -font $fixed .l insert 0 a b c d e f g h i j k l m n o p q r s t pack .l update test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} { .l yview 4 update format {%.6g %.6g} {*}[.l yview] } {0.2 0.45} test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} { mkPartial format {%.6g %.6g} {*}[.partial.l yview] } {0 0.266667} test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l yview foo} msg] $msg } {1 {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}} test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l yview foo a b} msg] $msg } {1 {unknown option "foo": must be moveto or scroll}} test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} { .l yview 0 .l yview moveto .31 format {%.6g %.6g} {*}[.l yview] } {0.3 0.55} test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} { .l yview 2 .l yview scroll 2 pages format {%.6g %.6g} {*}[.l yview] } {0.4 0.65} test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} { .l yview 10 .l yview scroll -3 units format {%.6g %.6g} {*}[.l yview] } {0.35 0.6} test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} { .l configure -height 2 update .l yview 15 .l yview scroll -4 pages format {%.6g %.6g} {*}[.l yview] } {0.55 0.65} test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l whoknows} msg] $msg } {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l c} msg] $msg } {1 {ambiguous option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l in} msg] $msg } {1 {ambiguous option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l s} msg] $msg } {1 {ambiguous option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} { list [catch {.l se} msg] $msg } {1 {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} # No tests for DestroyListbox: I can't come up with anything to test # in this procedure. test listbox-4.1 {ConfigureListbox procedure} {fonts} { catch {destroy .l} listbox .l -setgrid 1 -width 25 -height 15 pack .l update set x [getsize .] .l configure -setgrid 0 update list $x [getsize .] } {25x15 185x263} resetGridInfo test listbox-4.2 {ConfigureListbox procedure} { .l configure -highlightthickness -3 .l cget -highlightthickness } {0} test listbox-4.3 {ConfigureListbox procedure} { .l configure -exportselection 0 .l delete 0 end .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 .l selection set 3 5 .l configure -exportselection 1 selection get } {el3 el4 el5} test listbox-4.4 {ConfigureListbox procedure} { catch {destroy .e} entry .e .e insert 0 abc .e select from 0 .e select to 2 .l configure -exportselection 0 .l delete 0 end .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 .l selection set 3 5 .l selection clear 3 5 .l configure -exportselection 1 list [selection own] [selection get] } {.e ab} test listbox-4.5 {-exportselection option} { selection clear . .l configure -exportselection 1 .l delete 0 end .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 .l selection set 1 1 set x {} lappend x [catch {selection get} msg] $msg [.l curselection] .l config -exportselection 0 lappend x [catch {selection get} msg] $msg [.l curselection] .l selection clear 0 end lappend x [catch {selection get} msg] $msg [.l curselection] .l selection set 1 3 lappend x [catch {selection get} msg] $msg [.l curselection] .l config -exportselection 1 lappend x [catch {selection get} msg] $msg [.l curselection] } {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1 el2 el3} {1 2 3}} test listbox-4.6 {ConfigureListbox procedure} {fonts} { catch {destroy .l} # The following code (reset geometry, withdraw, etc.) is necessary # to reset the state of some window managers like olvwm under # SunOS 4.1.3. wm geom . 300x300 update wm geom . {} wm withdraw . listbox .l -font $fixed -width 15 -height 20 pack .l update wm deiconify . set x [getsize .] .l configure -setgrid 1 update list $x [getsize .] } {115x328 15x20} test listbox-4.7 {ConfigureListbox procedure} { catch {destroy .l} wm withdraw . listbox .l -font $fixed -width 30 -height 20 -setgrid 1 wm geom . +25+25 pack .l update wm deiconify . set result [getsize .] wm geom . 26x15 update lappend result [getsize .] .l configure -setgrid 1 update lappend result [getsize .] } {30x20 26x15 26x15} wm geom . {} catch {destroy .l} resetGridInfo test listbox-4.8 {ConfigureListbox procedure} { catch {destroy .l} listbox .l -width 15 -height 20 -xscrollcommand "record x" \ -yscrollcommand "record y" pack .l update .l configure -fg black set log {} update set log } {{y 0 1} {x 0 1}} test listbox-4.9 {ConfigureListbox procedure, -listvar} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x .l get 0 end } [list a b c d] test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} { catch {destroy .l} set x [list a b c d] listbox .l .l insert end 1 2 3 4 .l configure -listvar x .l get 0 end } [list a b c d] test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x .l configure -listvar {} .l insert end 1 2 3 4 list $x [.l get 0 end] } [list [list a b c d] [list a b c d 1 2 3 4]] test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} { catch {destroy .l} set x [list a b c d] set y [list 1 2 3 4] listbox .l .l configure -listvar x .l configure -listvar y .l insert end 5 6 7 8 list $x $y } [list [list a b c d] [list 1 2 3 4 5 6 7 8]] test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} { catch {destroy .l} catch {unset x} listbox .l .l insert end a b c d .l configure -listvar x set x } [list a b c d] test listbox-4.14 {ConfigureListbox, non-existant listvar} { catch {destroy .l} catch {unset x} listbox .l -listvar x list [info exists x] $x } [list 1 {}] test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} { catch {destroy .l} catch {unset y} set x [list a b c d] listbox .l -listvar x .l configure -listvar y list [info exists y] $y } [list 1 [list a b c d]] test listbox-4.16 {ConfigureListbox, listvar -> same listvar} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x .l configure -listvar x set x } [list a b c d] test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} { catch {destroy .l} listbox .l .l insert end a b c d .l configure -listvar {} .l get 0 end } [list a b c d] test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} { catch {destroy .l} listbox .l .l insert end a b c d set x "this is a \" bad list" catch {.l configure -listvar x} result list [.l get 0 end] [.l cget -listvar] $result } [list [list a b c d] {} \ "unmatched open quote in list: invalid -listvariable value"] test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} { catch {destroy .l} unset -nocomplain ::foo listbox .l -listvar foo .l insert end a b c d catch {.l configure -listvar ::zoo::bar::foo} result list [.l get 0 end] [.l cget -listvar] $foo $result } [list [list a b c d] foo [list a b c d] \ {can't set "::zoo::bar::foo": parent namespace doesn't exist}] # No tests for DisplayListbox: I don't know how to test this procedure. test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} { catch {destroy .l} listbox .l -font $fixed -width 15 -height 20 pack .l list [winfo reqwidth .l] [winfo reqheight .l] } {115 328} test listbox-5.2 {ListboxComputeGeometry procedure} {fonts} { catch {destroy .l} listbox .l -font $fixed -width 0 -height 10 pack .l update list [winfo reqwidth .l] [winfo reqheight .l] } {17 168} test listbox-5.3 {ListboxComputeGeometry procedure} {fonts} { catch {destroy .l} listbox .l -font $fixed -width 0 -height 10 -bd 3 .l insert 0 Short "Really much longer" Longer pack .l update list [winfo reqwidth .l] [winfo reqheight .l] } {138 170} test listbox-5.4 {ListboxComputeGeometry procedure} {fonts} { catch {destroy .l} listbox .l -font $fixed -width 10 -height 0 pack .l update list [winfo reqwidth .l] [winfo reqheight .l] } {80 24} test listbox-5.5 {ListboxComputeGeometry procedure} {fonts} { catch {destroy .l} listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0 .l insert 0 Short "Really much longer" Longer pack .l update list [winfo reqwidth .l] [winfo reqheight .l] } {76 52} test listbox-5.6 {ListboxComputeGeometry procedure} { # If "0" in selected font had 0 width, caused divide-by-zero error. catch {destroy .l} pack [listbox .l -font {{open look glyph}}] update } {} catch {destroy .l} listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y" pack .l update test listbox-6.1 {InsertEls procedure} { .l delete 0 end .l insert end a b c d .l insert 5 x y z .l insert 2 A .l insert 0 q r s .l get 0 end } {q r s a b A c d x y z} test listbox-6.2 {InsertEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l insert 2 A B .l index anchor } {4} test listbox-6.3 {InsertEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l insert 3 A B .l index anchor } {2} test listbox-6.4 {InsertEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l insert 2 A B .l index @0,0 } {5} test listbox-6.5 {InsertEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l insert 3 A B .l index @0,0 } {3} test listbox-6.6 {InsertEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 5 .l insert 5 A B .l index active } {7} test listbox-6.7 {InsertEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 5 .l insert 6 A B .l index active } {5} test listbox-6.8 {InsertEls procedure} { .l delete 0 end .l insert 0 a b c .l index active } {2} test listbox-6.9 {InsertEls procedure} { .l delete 0 end .l insert 0 .l index active } {0} test listbox-6.10 {InsertEls procedure} { .l delete 0 end .l insert 0 a b "two words" c d e f g h i j update set log {} .l insert 0 word update set log } {{y 0 0.166667}} test listbox-6.11 {InsertEls procedure} { .l delete 0 end .l insert 0 a b "two words" c d e f g h i j update set log {} .l insert 0 "much longer entry" update set log } {{y 0 0.166667} {x 0 1}} test listbox-6.12 {InsertEls procedure} {fonts} { catch {destroy .l2} listbox .l2 -width 0 -height 0 pack .l2 -side top .l2 insert 0 a b "two words" c d set x {} lappend x [winfo reqwidth .l2] [winfo reqheight .l2] .l2 insert 0 "much longer entry" lappend x [winfo reqwidth .l2] [winfo reqheight .l2] } {80 93 122 110} test listbox-6.13 {InsertEls procedure, check -listvar update} { catch {destroy .l2} set x [list a b c d] listbox .l2 -listvar x .l2 insert 0 1 2 3 4 set x } [list 1 2 3 4 a b c d] test listbox-6.14 {InsertEls procedure, check selection update} { catch {destroy .l2} listbox .l2 .l2 insert 0 0 1 2 3 4 .l2 selection set 2 4 .l2 insert 0 a .l2 curselection } [list 3 4 5] test listbox-6.15 {InsertEls procedure, lost namespaced listvar} { destroy .l2 namespace eval test { variable foo {a b} } listbox .l2 -listvar ::test::foo namespace delete test .l2 insert end c d .l2 delete end .l2 insert end e f catch {set ::test::foo} result list [.l2 get 0 end] [.l2 cget -listvar] $result } [list [list a b c e f] ::test::foo \ {can't read "::test::foo": no such variable}] test listbox-7.1 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection set 1 6 .l delete 4 3 list [.l size] [selection get] } {10 {b c d e f g}} test listbox-7.2 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection set 3 6 .l delete 4 4 list [.l size] [.l get 4] [.l curselection] } {9 f {3 4 5}} test listbox-7.3 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l delete 0 3 list [.l size] [.l get 0] [.l get 1] } {6 e f} test listbox-7.4 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l delete 8 1000 list [.l size] [.l get 7] } {8 h} test listbox-7.5 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l delete 0 1 .l index anchor } {0} test listbox-7.6 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l delete 2 .l index anchor } {2} test listbox-7.7 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 4 .l delete 2 5 .l index anchor } {2} test listbox-7.8 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 3 .l delete 4 5 .l index anchor } {3} test listbox-7.9 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 1 2 .l index @0,0 } {1} test listbox-7.10 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 3 4 .l index @0,0 } {3} test listbox-7.11 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 4 6 .l index @0,0 } {3} test listbox-7.12 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 3 end .l index @0,0 } {1} test listbox-7.13 {DeleteEls procedure, updating view with partial last line} { mkPartial .partial.l yview 8 update .partial.l delete 10 13 .partial.l index @0,0 } {7} test listbox-7.14 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 3 4 .l index active } {4} test listbox-7.15 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 5 7 .l index active } {5} test listbox-7.16 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 5 end .l index active } {4} test listbox-7.17 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 0 end .l index active } {0} test listbox-7.18 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c "two words" d e f g h i j update set log {} .l delete 4 6 update set log } {{y 0 0.25}} test listbox-7.19 {DeleteEls procedure} { .l delete 0 end .l insert 0 a b c "two words" d e f g h i j update set log {} .l delete 3 update set log } {{y 0 0.2} {x 0 1}} test listbox-7.20 {DeleteEls procedure} {fonts} { catch {destroy .l2} listbox .l2 -width 0 -height 0 pack .l2 -side top .l2 insert 0 a b "two words" c d e f g set x {} lappend x [winfo reqwidth .l2] [winfo reqheight .l2] .l2 delete 2 4 lappend x [winfo reqwidth .l2] [winfo reqheight .l2] } {80 144 17 93} catch {destroy .l2} test listbox-7.21 {DeleteEls procedure, check -listvar update} { catch {destroy .l2} set x [list a b c d] listbox .l2 -listvar x .l2 delete 0 1 set x } [list c d] test listbox-8.1 {ListboxEventProc procedure} {fonts} { catch {destroy .l} listbox .l -setgrid 1 pack .l update set x [getsize .] destroy .l list $x [getsize .] [winfo exists .l] [info command .l] } {20x10 150x178 0 {}} resetGridInfo test listbox-8.2 {ListboxEventProc procedure} {fonts} { catch {destroy .l} listbox .l -height 5 -width 10 .l insert 0 a b c "A string that is very very long" d e f g h i j k pack .l update place .l -width 50 -height 80 update list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } {{0 0.222222} {0 0.333333}} test listbox-8.3 {ListboxEventProc procedure} { deleteWindows listbox .l1 -bg #543210 rename .l1 .l2 set x {} lappend x [winfo children .] lappend x [.l2 cget -bg] destroy .l1 lappend x [info command .l*] [winfo children .] } {.l1 #543210 {} {}} test listbox-9.1 {ListboxCmdDeletedProc procedure} { deleteWindows listbox .l1 rename .l1 {} list [info command .l*] [winfo children .] } {{} {}} test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} fonts { catch {destroy .top} toplevel .top wm geom .top +0+0 listbox .top.l -setgrid 1 -width 20 -height 10 pack .top.l update set x [wm geometry .top] rename .top.l {} update lappend x [wm geometry .top] destroy .top set x } {20x10+0+0 150x178+0+0} catch {destroy .l} listbox .l pack .l .l delete 0 end .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 test listbox-10.1 {GetListboxIndex procedure} { .l activate 3 list [.l activate 3; .l index active] [.l activate 6; .l index active] } {3 6} test listbox-10.2 {GetListboxIndex procedure} { .l selection anchor 2 .l index anchor } 2 test listbox-10.3 {GetListboxIndex procedure} { .l insert end A B C D E .l selection anchor end .l delete 12 end list [.l index anchor] [.l index end] } {12 12} test listbox-10.4 {GetListboxIndex procedure} { list [catch {.l index a} msg] $msg } {1 {bad listbox index "a": must be active, anchor, end, @x,y, or a number}} test listbox-10.5 {GetListboxIndex procedure} { .l index end } {12} test listbox-10.6 {GetListboxIndex procedure} { .l get end } {el11} test listbox-10.7 {GetListboxIndex procedure} { .l delete 0 end .l index end } 0 .l delete 0 end .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 update test listbox-10.8 {GetListboxIndex procedure} { list [catch {.l index @} msg] $msg } {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}} test listbox-10.9 {GetListboxIndex procedure} { list [catch {.l index @foo} msg] $msg } {1 {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}} test listbox-10.10 {GetListboxIndex procedure} { list [catch {.l index @1x3} msg] $msg } {1 {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}} test listbox-10.11 {GetListboxIndex procedure} { list [catch {.l index @1,} msg] $msg } {1 {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}} test listbox-10.12 {GetListboxIndex procedure} { list [catch {.l index @1,foo} msg] $msg } {1 {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}} test listbox-10.13 {GetListboxIndex procedure} { list [catch {.l index @1,2x} msg] $msg } {1 {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}} test listbox-10.14 {GetListboxIndex procedure} {fonts} { list [.l index @5,57] [.l index @5,58] } {3 3} test listbox-10.15 {GetListboxIndex procedure} { list [catch {.l index 1xy} msg] $msg } {1 {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}} test listbox-10.16 {GetListboxIndex procedure} { .l index 3 } {3} test listbox-10.17 {GetListboxIndex procedure} { .l index 20 } {20} test listbox-10.18 {GetListboxIndex procedure} { .l get 20 } {} test listbox-10.19 {GetListboxIndex procedure} { .l index -2 } -2 test listbox-10.20 {GetListboxIndex procedure} { .l delete 0 end .l index 1 } 1 test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} { catch {destroy .l} listbox .l -height 5 pack .l .l insert 0 a b c d e f g h i j .l yview 3 update set x [.l index @0,0] .l yview -1 update lappend x [.l index @0,0] } {3 0} test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} { catch {destroy .l} listbox .l -height 5 pack .l .l insert 0 a b c d e f g h i j .l yview 3 update set x [.l index @0,0] .l yview 20 update lappend x [.l index @0,0] } {3 5} test listbox-11.3 {ChangeListboxView procedure} { catch {destroy .l} listbox .l -height 5 -yscrollcommand "record y" pack .l .l insert 0 a b c d e f g h i j update set log {} .l yview 2 update list [format {%.6g %.6g} {*}[.l yview]] $log } {{0.2 0.7} {{y 0.2 0.7}}} test listbox-11.4 {ChangeListboxView procedure} { catch {destroy .l} listbox .l -height 5 -yscrollcommand "record y" pack .l .l insert 0 a b c d e f g h i j update set log {} .l yview 8 update list [format {%.6g %.6g} {*}[.l yview]] $log } {{0.5 1} {{y 0.5 1}}} test listbox-11.5 {ChangeListboxView procedure} { catch {destroy .l} listbox .l -height 5 -yscrollcommand "record y" pack .l .l insert 0 a b c d e f g h i j .l yview 3 update set log {} .l yview 3 update list [format {%.6g %.6g} {*}[.l yview]] $log } {{0.3 0.8} {}} test listbox-11.6 {ChangeListboxView procedure, partial last line} { mkPartial .partial.l yview 13 .partial.l index @0,0 } {11} catch {destroy .l} listbox .l -font $fixed -xscrollcommand "record x" -width 10 .l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789 pack .l update test listbox-12.1 {ChangeListboxOffset procedure} {fonts} { set log {} .l xview 99 update list [format {%.6g %.6g} {*}[.l xview]] $log } {{0.9 1} {{x 0.9 1}}} test listbox-12.2 {ChangeListboxOffset procedure} {fonts} { set log {} .l xview moveto -.25 update list [format {%.6g %.6g} {*}[.l xview]] $log } {{0 0.1} {{x 0 0.1}}} test listbox-12.3 {ChangeListboxOffset procedure} {fonts} { .l xview 10 update set log {} .l xview 10 update list [format {%.6g %.6g} {*}[.l xview]] $log } {{0.1 0.2} {}} catch {destroy .l} listbox .l -font $fixed -width 10 -height 5 pack .l .l insert 0 a bb c d e f g h i j k l m n o p q r s .l insert 0 0123456789a123456789b123456789c123456789d123456789 update set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]] set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]] test listbox-13.1 {ListboxScanTo procedure} {fonts} { .l yview 0 .l xview 0 .l scan mark 10 20 .l scan dragto [expr 10-$width] [expr 20-$height] update list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } {{0.2 0.4} {0.5 0.75}} test listbox-13.2 {ListboxScanTo procedure} {fonts} { .l yview 5 .l xview 10 .l scan mark 10 20 .l scan dragto 20 40 update set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]] .l scan dragto [expr 20-$width] [expr 40-$height] update lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}} test listbox-13.3 {ListboxScanTo procedure} {fonts} { .l yview moveto 1.0 .l xview moveto 1.0 .l scan mark 10 20 .l scan dragto 5 10 update set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]] .l scan dragto [expr 5+$width] [expr 10+$height] update lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } {{0.8 1} {0.75 1} {0.64 0.84} {0.25 0.5}} test listbox-14.1 {NearestListboxElement procedure, partial last line} { mkPartial .partial.l nearest [winfo height .partial.l] } {4} catch {destroy .l} listbox .l -font $fixed -width 20 -height 10 .l insert 0 a b c d e f g h i j k l m n o p q r s t .l yview 4 pack .l update test listbox-14.2 {NearestListboxElement procedure} {fonts} { .l index @50,0 } {4} test listbox-14.3 {NearestListboxElement procedure} {fonts} { list [.l index @50,35] [.l index @50,36] } {5 6} test listbox-14.4 {NearestListboxElement procedure} {fonts} { .l index @50,200 } {13} test listbox-15.1 {ListboxSelect procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j k l m n o p .l select set 2 4 .l select set 7 12 .l select clear 4 7 .l curselection } {2 3 8 9 10 11 12} test listbox-15.2 {ListboxSelect procedure} { .l delete 0 end .l insert 0 a b c d e f g h i j k l m n o p catch {destroy .e} entry .e .e insert 0 "This is some text" .e select from 0 .e select to 7 .l selection clear 2 4 set x [selection own] .l selection set 3 list $x [selection own] [selection get] } {.e .l d} test listbox-15.3 {ListboxSelect procedure} { .l delete 0 end .l selection clear 0 end .l select set 0 end .l curselection } {} test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set -2 -1 .l curselection } {} test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set -1 3 .l curselection } {0 1 2 3} test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 2 4 .l curselection } {2 3 4} test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 4 end .l curselection } {4 5} test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 4 30 .l curselection } {4 5} test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set end 30 .l curselection } {5} test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 20 25 .l curselection } {} test listbox-16.1 {ListboxFetchSelection procedure} { .l delete 0 end .l insert 0 a b c "two words" e f g h i \\ k l m n o p .l selection set 2 4 .l selection set 9 .l selection set 11 12 selection get } "c\ntwo words\ne\n\\\nl\nm" test listbox-16.2 {ListboxFetchSelection procedure} { .l delete 0 end .l insert 0 a b c "two words" e f g h i \\ k l m n o p .l selection set 3 selection get } "two words" test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} { set long "This is quite a long string\n" append long $long $long $long $long append long $long $long $long $long append long $long $long .l delete 0 end .l insert 0 1$long 2$long 3$long 4$long 5$long .l selection set 0 end set sel [selection get] string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel } {0} catch {unset long sel} test listbox-17.1 {ListboxLostSelection procedure} { .l delete 0 end .l insert 0 a b c d e .l select set 0 end catch {destroy .e} entry .e .e insert 0 "This is some text" .e select from 0 .e select to 5 .l curselection } {} test listbox-17.2 {ListboxLostSelection procedure} { .l delete 0 end .l insert 0 a b c d e .l select set 0 end .l configure -exportselection 0 catch {destroy .e} entry .e .e insert 0 "This is some text" .e select from 0 .e select to 5 .l curselection } {0 1 2 3 4} catch {destroy .l} listbox .l -font $fixed -width 10 -height 5 pack .l update test listbox-18.1 {ListboxUpdateVScrollbar procedure} { .l configure -yscrollcommand "record y" set log {} .l insert 0 a b c update .l insert end d e f g h update .l delete 0 end update set log } {{y 0 1} {y 0 0.625} {y 0 1}} test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} { mkPartial .partial.l configure -yscrollcommand "record y" set log {} .partial.l yview 3 update set log } {{y 0.2 0.466667}} test listbox-18.3 {ListboxUpdateVScrollbar procedure} { proc bgerror args { global x errorInfo set x [list $args $errorInfo] } .l configure -yscrollcommand gorp .l insert 0 foo update set x } {{{invalid command name "gorp"}} {invalid command name "gorp" while executing "gorp 0.0 1.0" (vertical scrolling command executed by listbox)}} if {[info exists bgerror]} { rename bgerror {} } catch {destroy .l} listbox .l -font $fixed -width 10 -height 5 pack .l update test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} { .l configure -xscrollcommand "record x" set log {} .l insert 0 abc update .l insert 0 "This is a much longer string..." update .l delete 0 end update set log } {{x 0 1} {x 0 0.322581} {x 0 1}} test listbox-19.2 {ListboxUpdateVScrollbar procedure} { proc bgerror args { global x errorInfo set x [list $args $errorInfo] } .l configure -xscrollcommand bogus .l insert 0 foo update set x } {{{invalid command name "bogus"}} {invalid command name "bogus" while executing "bogus 0.0 1.0" (horizontal scrolling command executed by listbox)}} set l [interp hidden] deleteWindows test listbox-20.1 {listbox vs hidden commands} { catch {destroy .l} listbox .l interp hide {} .l destroy .l list [winfo children .] [interp hidden] } [list {} $l] # tests for ListboxListVarProc test listbox-21.1 {ListboxListVarProc} { catch {destroy .l} catch {unset x} listbox .l -listvar x set x [list a b c d] .l get 0 end } [list a b c d] test listbox-21.2 {ListboxListVarProc} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x unset x set x } [list a b c d] test listbox-21.3 {ListboxListVarProc} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x .l configure -listvar {} unset x info exists x } 0 test listbox-21.4 {ListboxListVarProc} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x lappend x e f g .l size } 7 test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} { catch {destroy .l} set x [list a b c d e f g] listbox .l -listvar x .l selection set end set x [list a b c d] set x [list 0 1 2 3 4 5 6] .l curselection } {} test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x .l selection set 3 lappend x e f g .l curselection } 3 test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x .l selection set 0 set x [linsert $x 0 1 2 3 4] .l curselection } 0 test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} { catch {destroy .l} set x [list a b c d] listbox .l -listvar x .l selection set 2 set x [list a b c] .l curselection } 2 test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} { catch {destroy .l} catch {unset x} set log {} listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x pack .l update lappend x "0000000000" update lappend x "00000000000000000000" update set log } [list {x 0 1} {x 0 1} {x 0 0.5}] test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} { catch {destroy .l} catch {unset x} set log {} listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x pack .l update lappend x "0000000000" update lappend x "00000000000000000000" update set x [list "0000000000"] update set log } [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}] test listbox-21.11 {ListboxListVarProc, bad list} { catch {destroy .l} catch {unset x} listbox .l -listvar x set x [list a b c d] catch {set x "this is a \" bad list"} result set result } {can't set "x": invalid listvar value} test listbox-21.12 {ListboxListVarProc, cleanup item attributes} { catch {destroy .l} set x [list a b c d e f g] listbox .l -listvar x .l itemconfigure end -fg red set x [list a b c d] set x [list 0 1 2 3 4 5 6] .l itemcget end -fg } {} test listbox-21.12a {ListboxListVarProc, cleanup item attributes} { catch {destroy .l} set x [list a b c d e f g] listbox .l -listvar x .l itemconfigure end -fg red set x [list a b c d] set x [list 0 1 2 3 4 5 6] .l itemcget end -fg } {} test listbox-21.13 {listbox item configurations and listvar based deletions} { catch {destroy .l} catch {unset x} listbox .l -listvar x .l insert end a b c .l itemconfigure 1 -fg red set x [list b c] .l itemcget 1 -fg } red test listbox-21.14 {listbox item configurations and listvar based inserts} { catch {destroy .l} catch {unset x} listbox .l -listvar x .l insert end a b c .l itemconfigure 0 -fg red set x [list 1 2 3 4 a b c] .l itemcget 0 -fg } red test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} { catch {destroy .l} catch {unset x} set log {} listbox .l -listvar x -yscrollcommand "record y" -font fixed -height 3 pack .l update lappend x a b c d e f update set log } [list {y 0 1} {y 0 0.5}] test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} { catch {destroy .l} catch {unset x} listbox .l -listvar x -height 3 pack .l update set x [list 0 1 2 3 4 5] .l yview scroll 3 units update set result {} lappend result [format {%.6g %.6g} {*}[.l yview]] set x [lreplace $x 3 3] set x [lreplace $x 3 3] set x [lreplace $x 3 3] update lappend result [format {%.6g %.6g} {*}[.l yview]] set result } [list {0.5 1} {0 1}] # UpdateHScrollbar test listbox-22.1 {UpdateHScrollbar} { catch {destroy .l} set log {} listbox .l -font $fixed -width 10 -xscrollcommand "record x" pack .l update .l insert end "0000000000" update .l insert end "00000000000000000000" update set log } [list {x 0 1} {x 0 1} {x 0 0.5}] # ConfigureListboxItem test listbox-23.1 {ConfigureListboxItem} { catch {destroy .l} listbox .l catch {.l itemconfigure 0} result set result } {item number "0" out of range} test listbox-23.2 {ConfigureListboxItem} { catch {destroy .l} listbox .l .l insert end a b c d .l itemconfigure 0 } [list {-background background Background {} {}} \ {-bg -background} \ {-fg -foreground} \ {-foreground foreground Foreground {} {}} \ {-selectbackground selectBackground Foreground {} {}} \ {-selectforeground selectForeground Background {} {}}] test listbox-23.3 {ConfigureListboxItem, itemco shortcut} { catch {destroy .l} listbox .l .l insert end a b c d .l itemco 0 -background } {-background background Background {} {}} test listbox-23.4 {ConfigureListboxItem, wrong num args} { catch {destroy .l} listbox .l .l insert end a catch {.l itemco} result set result } {wrong # args: should be ".l itemconfigure index ?option? ?value? ?option value ...?"} test listbox-23.5 {ConfigureListboxItem, multiple calls} { catch {destroy .l} listbox .l set i 0 foreach color {red orange yellow green blue white violet} { .l insert end $color .l itemconfigure $i -bg $color incr i } pack .l update list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \ [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \ [.l itemcget 6 -bg] } {red orange yellow green blue white violet} catch {destroy .l} listbox .l .l insert end a b c d set i 6 foreach test { {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-fg #110022 #110022 bogus {unknown color name "bogus"}} {-foreground #110022 #110022 bogus {unknown color name "bogus"}} {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} } { set name [lindex $test 0] test listbox-23.$i {configuration options} { .l itemconfigure 0 $name [lindex $test 1] list [lindex [.l itemconfigure 0 $name] 4] [.l itemcget 0 $name] } [list [lindex $test 2] [lindex $test 2]] incr i if {[lindex $test 3] != ""} { test listbox-23.$i {configuration options} { list [catch {.l configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } .l configure $name [lindex [.l configure $name] 3] incr i } # ListboxWidgetObjCmd, itemcget test listbox-24.1 {itemcget} { catch {destroy .l} listbox .l .l insert end a b c d .l itemcget 0 -fg } {} test listbox-24.2 {itemcget} { catch {destroy .l} listbox .l .l insert end a b c d .l itemconfigure 0 -fg red .l itemcget 0 -fg } red test listbox-24.3 {itemcget} { catch {destroy .l} listbox .l .l insert end a b c d catch {.l itemcget 0} result set result } {wrong # args: should be ".l itemcget index option"} test listbox-24.4 {itemcget, itemcg shortcut} { catch {destroy .l} listbox .l .l insert end a b c d catch {.l itemcg 0} result set result } {wrong # args: should be ".l itemcget index option"} # General item configuration issues test listbox-25.1 {listbox item configurations and widget based deletions} { catch {destroy .l} listbox .l .l insert end a .l itemconfigure 0 -fg red .l delete 0 end .l insert end a .l itemcget 0 -fg } {} test listbox-25.2 {listbox item configurations and widget based inserts} { catch {destroy .l} listbox .l .l insert end a b c .l itemconfigure 0 -fg red .l insert 0 1 2 3 4 list [.l itemcget 0 -fg] [.l itemcget 4 -fg] } [list {} red] # state issues test listbox-26.1 {listbox disabled state disallows inserts} { catch {destroy .l} listbox .l .l insert end a b c .l configure -state disabled .l insert end d e f .l get 0 end } [list a b c] test listbox-26.2 {listbox disabled state disallows deletions} { catch {destroy .l} listbox .l .l insert end a b c .l configure -state disabled .l delete 0 end .l get 0 end } [list a b c] test listbox-26.3 {listbox disabled state disallows selection modification} { catch {destroy .l} listbox .l .l insert end a b c .l selection set 0 .l selection set 2 .l configure -state disabled .l selection clear 0 end .l selection set 1 .l curselection } [list 0 2] test listbox-26.4 {listbox disabled state disallows anchor modification} { catch {destroy .l} listbox .l .l insert end a b c .l selection anchor 0 .l configure -state disabled .l selection anchor 2 .l index anchor } 0 test listbox-26.5 {listbox disabled state disallows active modification} { catch {destroy .l} listbox .l .l insert end a b c .l activate 0 .l configure -state disabled .l activate 2 .l index active } 0 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 test listbox-28.1 {listbox -activestyle} { destroy .l listbox .l -activ non .l cget -activestyle } none test listbox-28.2-nonwin {listbox -activestyle} {nonwin} { destroy .l listbox .l .l cget -activestyle } dotbox test listbox-28.2-win {listbox -activestyle} {win} { destroy .l listbox .l .l cget -activestyle } underline test listbox-28.3 {listbox -activestyle} { destroy .l listbox .l -activestyle und .l cget -activestyle } underline test listbox-29.1 {listbox selection behavior, -state disabled} { destroy .l listbox .l .l insert end 1 2 3 .l selection set 2 set out [.l selection includes 2] .l configure -state disabled # still return 1 when disabled, because 'selection get' will work, # but selection cannot be changed (new behavior since 8.4) .l selection set 3 lappend out [.l selection includes 2] [.l curselection] } {1 1 2} test listbox-30.1 {Bug 3607326} -setup { destroy .l unset -nocomplain a } -body { array set a {} listbox .l -listvariable a } -cleanup { destroy .l unset -nocomplain a } -result * -match glob -returnCodes error test listbox-31.1 {<> event} -setup { destroy .l unset -nocomplain res } -body { pack [listbox .l -state normal] update bind .l <> {lappend res [%W curselection]} .l insert end a b c focus -force .l event generate .l <1> -x 5 -y 5 ; # <> fires .l configure -state disabled focus -force .l event generate .l ; # <> does NOT fire .l configure -state normal focus -force .l event generate .l ; # <> fires .l selection clear 0 end ; # <> does NOT fire .l selection set 1 1 ; # <> does NOT fire lappend res [.l curselection] } -cleanup { destroy .l unset -nocomplain res } -result {0 2 1} test listbox-31.2 {<> event on lost selection} -setup { destroy .l } -body { pack [listbox .l -exportselection true] update bind .l <> {lappend res [list [selection own] [%W curselection]]} .l insert end a b c focus -force .l event generate .l <1> -x 5 -y 5 ; # <> fires selection clear ; # <> fires again set res } -cleanup { destroy .l } -result {{.l 0} {{} {}}} resetGridInfo deleteWindows option clear # cleanup cleanupTests return tk8.5.19/tests/winSend.test0000644003604700454610000003325312612445655014244 0ustar dgp771div# This file is a Tcl script to test out the "send" command and the # other procedures in the file tkSend.c. It is organized in the # standard fashion for Tcl tests. # # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # Compute a script that will load Tk into a child interpreter. foreach pkg [info loaded] { if {[lindex $pkg 1] == "Tk"} { set loadTk "load $pkg" break } } # Procedure to create a new application with a given name and class. proc newApp {name {safe {}}} { global loadTk if {[string compare $safe "-safe"] == 0} { interp create -safe $name } else { interp create $name } $name eval [list set argv [list -name $name]] catch {eval $loadTk $name} } set currentInterps [winfo interps] if { [testConstraint win] && [llength [info commands send]] && [catch {exec [interpreter] &}] == 0 } then { # Wait until the child application has launched. while {[llength [winfo interps]] == [llength $currentInterps]} {} # Now find an interp to send to set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch -exact $currentInterps $interp] < 0} { break } } # Now we have found our interpreter we are going to send to. # Make sure that it works first. testConstraint winSend [expr {![catch { send $interp { console hide update } }]}] } else { testConstraint winSend 0 } # setting up dde server is done when the first interp is created and # cannot be tested very easily. test winSend-1.1 {Tk_SetAppName - changing name of interp} winSend { newApp testApp list [testApp eval tk appname testApp2] [interp delete testApp] } {testApp2 {}} test winSend-1.2 {Tk_SetAppName - changing name - not front of linked list} winSend { newApp testApp newApp testApp2 list [testApp eval tk appname testApp3] [interp delete testApp] [interp delete testApp2] } {testApp3 {} {}} test winSend-1.3 {Tk_SetAppName - unique name - no conflicts} winSend { newApp testApp list [testApp eval tk appname testApp] [interp delete testApp] } {testApp {}} test winSend-1.4 {Tk_SetAppName - unique name - one conflict} winSend { newApp testApp newApp foobar list [foobar eval tk appname testApp] [interp delete foobar] [interp delete testApp] } {{testApp #2} {} {}} test winSend-1.5 {Tk_SetAppName - unique name - one conflict} winSend { newApp testApp newApp foobar newApp blaz foobar eval tk appname testApp list [blaz eval tk appname testApp] [interp delete foobar] [interp delete testApp] [interp delete blaz] } {{testApp #3} {} {} {}} test winSend-1.6 {Tk_SetAppName - safe interps} winSend { newApp testApp -safe list [catch {testApp eval send testApp {set foo a}} msg] $msg [interp delete testApp] } {1 {invalid command name "send"} {}} test winSend-2.1 {Tk_SendObjCmd - # of args} winSend { list [catch {send tktest} msg] $msg } {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} test winSend-2.1a {Tk_SendObjCmd: arguments} winSend { list [catch {send -bogus tktest} msg] $msg } {1 {bad option "-bogus": must be -async, -displayof, or --}} test winSend-2.1b {Tk_SendObjCmd: arguments} winSend { list [catch {send -async bogus foo} msg] $msg } {1 {no registered server named "bogus"}} test winSend-2.1c {Tk_SendObjCmd: arguments} winSend { list [catch {send -displayof . bogus foo} msg] $msg } {1 {no registered server named "bogus"}} test winSend-2.1d {Tk_SendObjCmd: arguments} winSend { list [catch {send -- -bogus foo} msg] $msg } {1 {no registered server named "-bogus"}} test winSend-2.2 {Tk_SendObjCmd - sending to ourselves} winSend { list [send [tk appname] {set foo a}] } {a} test winSend-2.3 {Tk_SendObjCmd - sending to ourselves in a different interpreter} winSend { newApp testApp list [catch {send testApp {set foo b}} msg] $msg [interp delete testApp] } {0 b {}} test winSend-2.4 {Tk_SendObjCmd - sending to ourselves in a different interp with errors} winSend { newApp testApp list [catch {send testApp {expr 2 / 0}} msg] $msg $errorCode $errorInfo [interp delete testApp] } "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send testApp {expr 2 / 0}\"} {}" test winSend-2.5 {Tk_SendObjCmd - sending to another app async} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {send -async $interp {set foo a}} msg] $msg } {0 {}} test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {send $interp {set foo a}} msg] $msg } {0 a} test winSend-2.7 {Tk_SendObjCmd - sending to another app - error} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {send $interp {expr 2 / 0}} msg] $msg $errorCode $errorInfo } "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send \$interp {expr 2 / 0}\"}" test winSend-3.1 {TkGetInterpNames} winSend { set origLength [llength $currentInterps] set newLength [llength [winfo interps]] expr {($newLength - 2) == $origLength} } {1} test winSend-4.1 {DeleteProc - changing name of app} winSend { newApp a list [a eval tk appname foo] [interp delete a] } {foo {}} test winSend-4.2 {DeleteProc - normal} winSend { newApp a list [interp delete a] } {{}} test winSend-5.1 {ExecuteRemoteObject - no error} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [send $interp {send [tk appname] {expr 2 / 1}}] } {2} test winSend-5.2 {ExecuteRemoteObject - error} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {send $interp {send [tk appname] {expr 2 / 0}}} msg] $msg } {1 {divide by zero}} test winSend-6.1 {SendDDEServer - XTYP_CONNECT} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "dde request Tk [tk appname] foo" list [catch "send \{$interp\} \{$command\}" msg] $msg } {0 {Hello, World}} test winSend-6.2 {SendDDEServer - XTYP_CONNECT_CONFIRM} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "dde request Tk [tk appname] foo" list [catch "send \{$interp\} \{$command\}" msg] $msg } {0 {Hello, World}} test winSend-6.3 {SendDDEServer - XTYP_DISCONNECT} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "dde request Tk [tk appname] foo" list [catch "send \{$interp\} \{$command\}" msg] $msg } {0 {Hello, World}} test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "dde request Tk [tk appname] foo" list [catch "send \{$interp\} \{$command\}" msg] $msg } {0 {Hello, World}} test winSend-6.5 {SendDDEServer - XTYP_REQUEST array} winSend { catch {unset foo} set foo(test) "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "dde request Tk [tk appname] foo(test)" list [catch "send \{$interp\} \{$command\}" msg] $msg [catch {unset foo}] } {0 {Hello, World} 0} test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} winSend { set foo 3 set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "send [tk appname] {expr $foo + 1}" list [catch "send \{$interp\} \{$command\}" msg] $msg } {0 4} test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "send [tk appname] {expr 4 / 2}" list [catch "send \{$interp\} \{$command\}" msg] $msg } {0 2} test winSend-6.8 {SendDDEServer - XTYP_WILDCONNECT} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } set command "dde services Tk {}" list [catch "send \{$interp\} \{$command\}"] } {0} test winSend-7.1 {DDEExitProc} winSend { newApp testApp list [interp delete testApp] } {{}} test winSend-8.1 {SendDdeConnect} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [send $interp {set tk foo}] } {foo} test winSend-9.1 {SetDDEError} winSend { list [catch {dde execute Tk foo {set foo hello}} msg] $msg } {1 {dde command failed}} test winSend-10.1 {Tk_DDEObjCmd - wrong num args} winSend { list [catch {dde} msg] $msg } {1 {wrong # args: should be "dde ?-async? serviceName topicName value"}} test winSend-10.2 {Tk_DDEObjCmd - unknown subcommand} winSend { list [catch {dde foo} msg] $msg } {1 {bad command "foo": must be execute, request, or services}} test winSend-10.3 {Tk_DDEObjCmd - execute - wrong num args} winSend { list [catch {dde execute} msg] $msg } {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}} test winSend-10.4 {Tk_DDEObjCmd - execute - wrong num args} winSend { list [catch {dde execute 3 4 5 6 7} msg] $msg } {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}} test winSend-10.5 {Tk_DDEObjCmd - execute async - wrong num args} winSend { list [catch {dde execute -async} msg] $msg } {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}} test winSend-10.6 {Tk_DDEObjCmd - request - wrong num args} winSend { list [catch {dde request} msg] $msg } {1 {wrong # args: should be "dde request serviceName topicName value"}} test winSend-10.7 {Tk_DDEObjCmd - services wrong num args} winSend { list [catch {dde services} msg] $msg } {1 {wrong # args: should be "dde services serviceName topicName"}} test winSend-10.8 {Tk_DDEObjCmd - null service name} winSend { list [catch {dde services {} {tktest #2}}] } {0} test winSend-10.9 {Tk_DDEObjCmd - null topic name} winSend { list [catch {dde services {Tk} {}}] } {0} test winSend-10.10 {Tk_DDEObjCmd - execute - nothing to execute} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {dde execute Tk $interp {}} msg] $msg } {1 {cannot execute null data}} test winSend-10.11 {Tk_DDEObjCmd - execute - no such conversation} winSend { list [catch {dde execute Tk foo {set foo hello}} msg] $msg } {1 {dde command failed}} test winSend-10.12 {Tk_DDEObjCmd - execute - async} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {dde execute -async Tk $interp {set foo hello}} msg] $msg } {0 {}} test winSend-10.13 {Tk_DDEObjCmd - execute} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {dde execute Tk $interp {set foo goodbye}} msg] $msg } {0 {}} test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {dde request Tk $interp {}} msg] $msg } {1 {cannot request value of null data}} test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } list [catch {dde request Tk foo foo} msg] $msg } {1 {dde command failed}} test winSend-10.16 {Tk_DDEObjCmd - invalid variable} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } send $interp {unset foo} list [catch {dde request Tk $interp foo} msg] $msg } {1 {remote server cannot handle this command}} test winSend-10.17 {Tk_DDEObjCmd - valid variable} winSend { set newInterps [winfo interps] foreach interp $newInterps { if {[lsearch $currentInterps $interp] < 0} { break } } send $interp {set foo winSend-10.17} list [catch {dde request Tk $interp foo} msg] $msg } {0 winSend-10.17} test winSend-10.18 {Tk_DDEObjCmd - services} winSend { set currentService [list Tk [tk appname]] list [catch {dde services Tk {}} msg] [expr [lsearch $msg $currentService] >= 0] } {0 1} # Get rid of the other app and all of its interps set newInterps [winfo interps] while {[llength $newInterps] != [llength $currentInterps]} { foreach interp $newInterps { if {[lsearch -exact $currentInterps $interp] < 0} { catch {send $interp exit} set newInterps [winfo interps] break } } } # cleanup cleanupTests return tk8.5.19/tests/image.test0000644003604700454610000003531112612445655013714 0ustar dgp771div# This file is a Tcl script to test out the "image" command and the # other procedures in the file tkImage.c. It is organized in the # standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force ::tk::test::loadTkCommand eval image delete [image names] canvas .c -highlightthickness 2 pack .c update test image-1.1 {Tk_ImageCmd procedure, "create" option} { list [catch image msg] $msg } {1 {wrong # args: should be "image option ?args?"}} test image-1.2 {Tk_ImageCmd procedure, "create" option} { list [catch {image gorp} msg] $msg } {1 {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width}} test image-1.3 {Tk_ImageCmd procedure, "create" option} { list [catch {image create} msg] $msg } {1 {wrong # args: should be "image create type ?name? ?options?"}} test image-1.4 {Tk_ImageCmd procedure, "create" option} { list [catch {image c bad_type} msg] $msg } {1 {image type "bad_type" doesn't exist}} test image-1.5 {Tk_ImageCmd procedure, "create" option} testImageType { list [image create test myimage] [image names] } {myimage myimage} test image-1.6 {Tk_ImageCmd procedure, "create" option} testImageType { scan [image create test] image%d first image create test myimage scan [image create test -variable x] image%d second expr $second-$first } {1} test image-1.7 {Tk_ImageCmd procedure, "create" option} testImageType { image delete myimage image create test myimage -variable x .c create image 100 50 -image myimage .c create image 100 150 -image myimage update set x {} image create test myimage -variable x update set x } {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} test image-1.8 {Tk_ImageCmd procedure, "create" option} testImageType { .c delete all image create test myimage -variable x .c create image 100 50 -image myimage .c create image 100 150 -image myimage image delete myimage update set x {} image create test myimage -variable x update set x } {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} test image-1.9 {Tk_ImageCmd procedure, "create" option} testImageType { .c delete all eval image delete [image names] list [catch {image create test -badName foo} msg] $msg [image names] } {1 {bad option name "-badName"} {}} test image-1.10 {Tk_ImageCmd procedure, "create" option with same name as main window} { set code [loadTkCommand] append code { update puts [list [catch {image create photo .} msg] $msg] exit } set script [makeFile $code script] set x [list [catch {exec [interpreter] <$script} msg] $msg] removeFile script set x } {0 {1 {images may not be named the same as the main window}}} test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} { set code [loadTkCommand] append code { update puts [list [catch {rename . foo;image create photo foo} msg] $msg] exit } set script [makeFile $code script] set x [list [catch {exec [interpreter] <$script} msg] $msg] removeFile script set x } {0 {1 {images may not be named the same as the main window}}} test image-1.12 {Tk_ImageCmd, "create" option: do not generated command name in use} -setup { set i [image create bitmap] regexp {^image(\d+)$} $i -> serial incr serial proc image$serial {} {return works} set j [image create bitmap] } -body { image$serial } -cleanup { rename image$serial {} image delete $i $j } -result works test image-2.1 {Tk_ImageCmd procedure, "delete" option} { list [catch {image delete} msg] $msg } {0 {}} test image-2.2 {Tk_ImageCmd procedure, "delete" option} testImageType { .c delete all eval image delete [image names] image create test myimage image create test img2 set result {} lappend result [lsort [image names]] image d myimage img2 lappend result [image names] } {{img2 myimage} {}} test image-2.3 {Tk_ImageCmd procedure, "delete" option} testImageType { .c delete all eval image delete [image names] image create test myimage image create test img2 list [catch {image delete myimage gorp img2} msg] $msg [image names] } {1 {image "gorp" doesn't exist} img2} test image-3.1 {Tk_ImageCmd procedure, "height" option} { list [catch {image height} msg] $msg } {1 {wrong # args: should be "image height name"}} test image-3.2 {Tk_ImageCmd procedure, "height" option} { list [catch {image height a b} msg] $msg } {1 {wrong # args: should be "image height name"}} test image-3.3 {Tk_ImageCmd procedure, "height" option} { list [catch {image height foo} msg] $msg } {1 {image "foo" doesn't exist}} test image-3.4 {Tk_ImageCmd procedure, "height" option} testImageType { image create test myimage set x [image h myimage] myimage changed 0 0 0 0 60 50 list $x [image height myimage] } {15 50} test image-4.1 {Tk_ImageCmd procedure, "names" option} { list [catch {image names x} msg] $msg } {1 {wrong # args: should be "image names"}} test image-4.2 {Tk_ImageCmd procedure, "names" option} testImageType { .c delete all eval image delete [image names] image create test myimage image create test img2 image create test 24613 lsort [image names] } {24613 img2 myimage} test image-4.3 {Tk_ImageCmd procedure, "names" option} { .c delete all eval image delete [image names] lsort [image names] } {} test image-5.1 {Tk_ImageCmd procedure, "type" option} { list [catch {image type} msg] $msg } {1 {wrong # args: should be "image type name"}} test image-5.2 {Tk_ImageCmd procedure, "type" option} { list [catch {image type a b} msg] $msg } {1 {wrong # args: should be "image type name"}} test image-5.3 {Tk_ImageCmd procedure, "type" option} { list [catch {image type foo} msg] $msg } {1 {image "foo" doesn't exist}} test image-5.4 {Tk_ImageCmd procedure, "type" option} testImageType { image create test myimage image type myimage } {test} test image-5.5 {Tk_ImageCmd procedure, "type" option} testImageType { image create test myimage .c create image 50 50 -image myimage image delete myimage list [catch {image type myimage} msg] $msg } {1 {image "myimage" doesn't exist}} test image-5.6 {Tk_ImageCmd procedure, "type" option} testOldImageType { image create oldtest myimage image type myimage } {oldtest} test image-5.7 {Tk_ImageCmd procedure, "type" option} testOldImageType { image create oldtest myimage .c create image 50 50 -image myimage image delete myimage list [catch {image type myimage} msg] $msg } {1 {image "myimage" doesn't exist}} test image-6.1 {Tk_ImageCmd procedure, "types" option} { list [catch {image types x} msg] $msg } {1 {wrong # args: should be "image types"}} test image-6.2 {Tk_ImageCmd procedure, "types" option} testImageType { lsort [image types] } {bitmap oldtest photo test} test image-7.1 {Tk_ImageCmd procedure, "width" option} { list [catch {image width} msg] $msg } {1 {wrong # args: should be "image width name"}} test image-7.2 {Tk_ImageCmd procedure, "width" option} { list [catch {image width a b} msg] $msg } {1 {wrong # args: should be "image width name"}} test image-7.3 {Tk_ImageCmd procedure, "width" option} { list [catch {image width foo} msg] $msg } {1 {image "foo" doesn't exist}} test image-7.4 {Tk_ImageCmd procedure, "width" option} testImageType { image create test myimage set x [image w myimage] myimage changed 0 0 0 0 60 50 list $x [image width myimage] } {30 60} test image-8.1 {Tk_ImageCmd procedure, "inuse" option} testImageType { catch {image delete myimage2} image create test myimage2 set res {} lappend res [image inuse myimage2] catch {destroy .b} button .b -image myimage2 lappend res [image inuse myimage2] catch {destroy .b} image delete myimage2 set res } [list 0 1] test image-9.1 {Tk_ImageChanged procedure} testImageType { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 50 -image foo update set x {} foo changed 5 6 7 8 30 15 update set x } {{foo display 5 6 7 8 30 30}} test image-9.2 {Tk_ImageChanged procedure} testImageType { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 50 -image foo .c create image 90 100 -image foo update set x {} foo changed 5 6 7 8 30 15 update set x } {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}} test image-10.1 {Tk_GetImage procedure} { list [catch {.c create image 100 10 -image bad_name} msg] $msg } {1 {image "bad_name" doesn't exist}} test image-10.2 {Tk_GetImage procedure} testImageType { image create test mytest catch {destroy .l} label .l -image mytest image delete mytest set result [list [catch {label .l2 -image mytest} msg] $msg] destroy .l set result } {1 {image "mytest" doesn't exist}} test image-11.1 {Tk_FreeImage procedure} testImageType { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 50 -image foo -tags i1 .c create image 90 100 -image foo -tags i2 pack forget .c update set x {} .c delete i1 pack .c update list [image names] $x } {foo {{foo free} {foo display 0 0 30 15 103 121}}} test image-11.2 {Tk_FreeImage procedure} testImageType { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 50 -image foo -tags i1 set names [image names] image delete foo update set names2 [image names] set x {} .c delete i1 pack forget .c pack .c update list $names $names2 [image names] $x } {foo {} {} {}} # Non-portable, apparently due to differences in rounding: test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} \ {testImageType nonPortable} { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 30 40 55 65 -width 0 -fill black -outline {} set x {} update set x } {{foo display 0 0 5 5 50 50}} test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} \ {testImageType nonPortable} { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 60 40 100 65 -width 0 -fill black -outline {} set x {} update set x } {{foo display 10 0 20 5 30 50}} test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} \ {testImageType nonPortable} { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 60 70 100 200 -width 0 -fill black -outline {} set x {} update set x } {{foo display 10 10 20 5 30 30}} test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} \ {testImageType nonPortable} { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 30 70 55 200 -width 0 -fill black -outline {} set x {} update set x } {{foo display 0 10 5 5 50 30}} test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} \ {testImageType nonPortable} { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 10 20 120 130 -width 0 -fill black -outline {} set x {} update set x } {{foo display 0 0 30 15 70 70}} test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} \ {testImageType nonPortable} { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 55 65 75 70 -width 0 -fill black -outline {} set x {} update set x } {{foo display 5 5 20 5 30 30}} test image-13.1 {Tk_SizeOfImage procedure} testImageType { eval image delete [image names] image create test foo -variable x set result [list [image width foo] [image height foo]] foo changed 0 0 0 0 85 60 lappend result [image width foo] [image height foo] } {30 15 85 60} test image-13.2 {DeleteImage procedure} testImageType { .c delete all eval image delete [image names] image create test foo -variable x .c create image 50 50 -image foo -tags i1 .c create image 90 100 -image foo -tags i2 set x {} image delete foo lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] | } {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |} test image-13.3 {Tk_SizeOfImage procedure} testOldImageType { eval image delete [image names] image create oldtest foo -variable x set result [list [image width foo] [image height foo]] foo changed 0 0 0 0 85 60 lappend result [image width foo] [image height foo] } {30 15 85 60} test image-13.4 {DeleteImage procedure} testOldImageType { .c delete all eval image delete [image names] image create oldtest foo -variable x .c create image 50 50 -image foo -tags i1 .c create image 90 100 -image foo -tags i2 set x {} image delete foo lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] | } {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |} catch {image delete hidden} set l [image names] set h [interp hidden] test image-14.1 {image command vs hidden commands} { catch {image delete hidden} image create photo hidden interp hide {} hidden image delete hidden list [image names] [interp hidden] } [list $l $h] eval image delete [image names] test image-15.1 {deleting image does not make widgets forget about it} { .c delete all image create photo foo -width 10 -height 10 .c create image 10 10 -image foo -tags i1 -anchor nw update set x [.c bbox i1] lappend x [image names] image delete foo lappend x [image names] image create photo foo -width 20 -height 20 lappend x [.c bbox i1] [image names] } {10 10 20 20 foo {} {10 10 30 30} foo} destroy .c eval image delete [image names] # cleanup cleanupTests return tk8.5.19/tests/README0000644003604700454610000000032712612445655012610 0ustar dgp771divREADME -- Tk test suite design document. This directory contains a set of validation tests for the Tk commands. Please see the tests/README file in the Tcl source distribution for information about the test suite. tk8.5.19/tests/window.test0000644003604700454610000002015612612445655014142 0ustar dgp771div# This file is a Tcl script to test the procedures in the file # tkWindow.c. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint unthreaded [expr { (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)) }] namespace import -force ::tk::test::loadTkCommand update # XXX This file is woefully incomplete. Right now it only tests # a few parts of a few procedures in tkWindow.c test window-1.1 {Tk_CreateWindowFromPath procedure, parent dead} { proc bgerror msg { global x errorInfo set x [list $msg $errorInfo] } set x unchanged catch {destroy .t} frame .t -width 100 -height 50 place .t -x 10 -y 10 bind .t {button .t.b -text hello; pack .t.b} update destroy .t update rename bgerror {} set x } {{can't create window: parent has been destroyed} {can't create window: parent has been destroyed while executing "button .t.b -text hello" (command bound to event)}} # Most of the tests below don't produce meaningful results; they # will simply dump core if there are bugs. test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} { toplevel .t -width 300 -height 200 wm geometry .t +0+0 frame .t.f -width 200 -height 200 -relief raised -bd 2 place .t.f -x 0 -y 0 frame .t.f.f -width 100 -height 100 -relief raised -bd 2 place .t.f.f -relx 1 -rely 1 -anchor se bind .t.f {destroy .t} update destroy .t.f } {} test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} { toplevel .t -width 300 -height 200 wm geometry .t +0+0 frame .t.f -width 200 -height 200 -relief raised -bd 2 place .t.f -x 0 -y 0 frame .t.f.f -width 100 -height 100 -relief raised -bd 2 place .t.f.f -relx 1 -rely 1 -anchor se bind .t.f.f {destroy .t} update destroy .t.f } {} test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} { frame .f -width 80 -height 120 -relief raised -bd 2 place .f -relx 0.5 -rely 0.5 -anchor center toplevel .f.t -width 300 -height 200 wm geometry .f.t +0+0 frame .f.t.f -width 200 -height 200 -relief raised -bd 2 place .f.t.f -x 0 -y 0 frame .f.t.f.f -width 100 -height 100 -relief raised -bd 2 place .f.t.f.f -relx 1 -rely 1 -anchor se update destroy .f } {} test window-2.4 {Tk_DestroyWindow, cleanup half dead window at exit} \ unixOrWin { set code [loadTkCommand] append code { update bind . exit destroy . } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 {}} test window-2.5 {Tk_DestroyWindow, cleanup half dead windows at exit} \ unixOrWin { set code [loadTkCommand] append code { toplevel .t update bind .t exit destroy .t } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 {}} test window-2.6 {Tk_DestroyWindow, cleanup half dead windows at exit} \ unixOrWin { set code [loadTkCommand] append code { toplevel .t update bind .t exit destroy . } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 {}} test window-2.7 {Tk_DestroyWindow, cleanup half dead windows at exit} \ unixOrWin { set code [loadTkCommand] append code { toplevel .t toplevel .t.f update bind .t.f exit destroy . } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 {}} test window-2.8 {Tk_DestroyWindow, cleanup half dead windows at exit} \ unixOrWin { set code [loadTkCommand] append code { toplevel .t1 toplevel .t2 toplevel .t3 update bind .t3 {destroy .t2} bind .t2 {destroy .t1} bind .t1 {exit 0} destroy .t3 } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 {}} # window-2.9 deadlocks threaded Tk [Bug 1715716] test window-2.9 {Tk_DestroyWindow, Destroy bindings evaluated after exit} {unixOrWin unthreaded} { set code [loadTkCommand] append code { toplevel .t1 toplevel .t2 update bind .t2 {puts "Destroy .t2" ; exit 1} bind .t1 {puts "Destroy .t1" ; exit 0} destroy .t2 } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 {Destroy .t2 Destroy .t1}} test window-2.10 {Tk_DestroyWindow, Destroy binding evaluated once} unixOrWin { set code [loadTkCommand] append code { update bind . { puts "Destroy ." bind . {puts "Re-Destroy ."} exit 0 } destroy . } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 {Destroy .}} test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} \ unixOrWin { set code [loadTkCommand] append code { toplevel .t1 toplevel .t2 update bind .t1 { if {[catch {entry .t2.newchild}]} { puts YES } else { puts NO } } bind .t2 {exit} destroy .t2 } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } removeFile script list $error $msg } {0 YES} test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 pack [entry .t.e] frame .t.f -bd 2 -relief raised testmenubar window .t .t.f update # If stacking order isn't handle properly, generates an X error. } {} test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \ {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 pack [entry .t.e] pack [entry .t.e2] update frame .t.f -bd 2 -relief raised raise .t.f .t.e testmenubar window .t .t.f update # If stacking order isn't handled properly, generates an X error. } {} test window-4.1 {Tk_NameToWindow procedure} {testmenubar} { catch {destroy .t} list [catch {winfo geometry .t} msg] $msg } {1 {bad window path name ".t"}} test window-4.2 {Tk_NameToWindow procedure} {testmenubar} { catch {destroy .t} frame .t -width 100 -height 50 place .t -x 10 -y 10 update list [catch {winfo geometry .t} msg] $msg } {0 100x50+10+10} test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 pack [entry .t.e] pack [entry .t.e2] frame .t.f -bd 2 -relief raised testmenubar window .t .t.f update lower .t.e2 .t.f update # If stacking order isn't handled properly, generates an X error. } {} # cleanup cleanupTests return tk8.5.19/tests/canvPsArc.tcl0000644003604700454610000000340412612445655014313 0ustar dgp771div# This file creates a screen to exercise Postscript generation # for bitmaps in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. catch {destroy .t} toplevel .t wm title .t "Postscript Tests for Canvases" wm iconname .t "Postscript" wm geom .t +0+0 wm minsize .t 1 1 set c .t.c message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for arcs. Click on "Print" to print the canvas to your default printer. You can click on items in the canvas to delete them.} -width 6i pack .t.m -side top -fill both frame .t.bot pack .t.bot -side bottom -fill both button .t.bot.quit -text Quit -command {destroy .t} button .t.bot.print -text Print -command "lpr $c" pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1 canvas $c -width 6i -height 6i -bd 2 -relief sunken pack $c -expand yes -fill both -padx 2m -pady 2m $c create arc .5i .5i 2i 2i -style pieslice -start 20 -extent 90 \ -fill black -outline {} $c create arc 2.5i 0 4.5i 1i -style pieslice -start -45 -extent -135 \ -fill {} -outline black -outlinestipple gray50 -width 3m $c create arc 5.0i .5i 6.5i 2i -style pieslice -start 45 -extent 315 \ -fill black -stipple gray25 -outline black -width 1m $c create arc -.5i 2.5i 2.0i 3.5i -style chord -start 90 -extent 270 \ -fill black -outline {} $c create arc 2.5i 2i 4i 6i -style chord -start 20 -extent 140 \ -fill black -stipple gray50 -outline black -width 2m $c create arc 4i 2.5i 8i 4.5i -style chord -start 60 -extent 60 \ -fill {} -outline black $c create arc .5i 4.5i 2i 6i -style arc -start 135 -extent 315 -width 3m \ -outline black -outlinestipple gray25 $c create arc 3.5i 4.5i 5.5i 5.5i -style arc -start 45 -extent -90 -width 1m \ -outline black tk8.5.19/tests/textImage.test0000644003604700454610000002624312612445655014565 0ustar dgp771div# textImage.test -- test images embedded in text widgets # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # One time setup. Create a font to insure the tests are font metric invariant. catch {destroy .t} font create test_font -family courier -size 14 text .t -font test_font destroy .t test textImage-1.1 {basic argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image} msg] $msg } {1 {wrong # args: should be ".t image option ?arg arg ...?"}} test textImage-1.2 {basic argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image c} msg] $msg } {1 {ambiguous option "c": must be cget, configure, create, or names}} test textImage-1.3 {cget argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image cget} msg] $msg } {1 {wrong # args: should be ".t image cget index option"}} test textImage-1.4 {cget argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image cget blurf -flurp} msg] $msg } {1 {bad text index "blurf"}} test textImage-1.5 {cget argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image cget 1.1 -flurp} msg] $msg } {1 {no embedded image at index "1.1"}} test textImage-1.6 {configure argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image configure } msg] $msg } {1 {wrong # args: should be ".t image configure index ?option value ...?"}} test textImage-1.7 {configure argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image configure blurf } msg] $msg } {1 {bad text index "blurf"}} test textImage-1.8 {configure argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image configure 1.1 } msg] $msg } {1 {no embedded image at index "1.1"}} test textImage-1.9 {create argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create} msg] $msg } {1 {wrong # args: should be ".t image create index ?option value ...?"}} test textImage-1.10 {create argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create blurf } msg] $msg } {1 {bad text index "blurf"}} test textImage-1.11 {basic argument checking} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create 1000.1000 -image small} msg] $msg } {0 small} test textImage-1.12 {names argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image names dates places} msg] $msg } {1 {wrong # args: should be ".t image names"}} test textImage-1.13 {names argument checking} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t set result "" lappend result [.t image names] .t image create insert -image small lappend result [.t image names] .t image create insert -image small lappend result [.t image names] .t image create insert -image small -name little lappend result [.t image names] } {{} small {small#1 small} {small#1 small little}} test textImage-1.14 {basic argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image huh} msg] $msg } {1 {bad option "huh": must be cget, configure, create, or names}} test textImage-1.15 {align argument checking} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create end -image small -align wrong} msg] $msg } {1 {bad align "wrong": must be baseline, bottom, center, or top}} test textImage-1.16 {configure} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small .t image configure small } {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}} test textImage-1.17 {basic cget options} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small set result "" foreach i {align padx pady image name} { lappend result $i:[.t image cget small -$i] } set result } {align:center padx:0 pady:0 image:small name:} test textImage-1.18 {basic configure options} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small set result "" foreach {option value} {align top padx 5 pady 7 image large name none} { .t image configure small -$option $value } update .t image configure small } {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}} test textImage-1.19 {basic image naming} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small .t image create end -image small -name small .t image create end -image small -name small#6342 .t image create end -image small -name small lsort [.t image names] } {small small#1 small#6342 small#6343} test textImage-2.1 {debug} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t debug 1 .t insert end front .t image create end -image small .t insert end back .t delete small .t image names .t debug 0 } {} test textImage-3.1 {image change propagation} { catch { image create photo vary -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image vary -align top update set result "" lappend result base:[.t bbox vary] foreach i {10 20 40} { vary configure -width $i -height $i update lappend result $i:[.t bbox vary] } set result } {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} test textImage-3.2 {delayed image management, see also bug 1591493} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -name test update set result "" foreach {x1 y1 w1 h1} [.t bbox test] {} lappend result [list $x1 $w1 $h1] .t image configure test -image small -align top update foreach {x2 y2 w2 h2} [.t bbox test] {} lappend result [list [expr {$x1==$x2}] [expr {$w2>0}] [expr {$h2>0}]] } {{0 0 0} {1 1 1}} # some temporary random tests test textImage-4.1 {alignment checking - except baseline} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small .t insert end test update set result "" lappend result default:[.t bbox small] foreach i {top bottom center} { .t image configure small -align $i update lappend result [.t image cget small -align]:[.t bbox small] } set result } {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}} test textImage-4.2 {alignment checking - baseline} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} font create test_font2 -size 5 text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -align baseline .t insert end test set result "" # Sizes larger than 25 can be too big and lead to a negative 'norm', # at least on Windows XP with certain settings. foreach size {10 15 20 25} { font configure test_font2 -size $size array set Metrics [font metrics test_font2] update foreach {x y w h} [.t bbox small] {} set norm [expr { (([image height large] - $Metrics(-linespace))/2 + $Metrics(-ascent) - [image height small] - $y) }] lappend result "$size $norm" } font delete test_font2 unset Metrics set result } {{10 0} {15 0} {20 0} {25 0}} test textImage-4.3 {alignment and padding checking} {fonts} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -padx 5 -pady 10 .t insert end test update set result "" lappend result default:[.t bbox small] foreach i {top bottom center baseline} { .t image configure small -align $i update lappend result $i:[.t bbox small] } set result } {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}} test textImage-5.0 {peer widget images} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t .tt} pack [text .t] toplevel .tt pack [.t peer create .tt.t] .t image create end -image large .t image create end -image small -padx 5 -pady 10 .t insert end test update destroy .t .tt } {} # cleanup catch {destroy .t} foreach image [image names] {image delete $image} font delete test_font # cleanup cleanupTests return tk8.5.19/tests/geometry.test0000644003604700454610000001647712612445655014501 0ustar dgp771div# This file is a Tcl script to test the procedures in the file # tkGeometry.c (generic support for geometry managers). It is # organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands wm geometry . 300x300 raise . update frame .f -bd 2 -relief raised frame .f.f -bd 2 -relief sunken frame .f.f.f -bd 2 -relief raised button .b1 -text .b1 button .b2 -text .b2 button .b3 -text .b3 button .f.f.b4 -text .b4 test geometry-1.1 {Tk_ManageGeometry procedure} { place .b1 -x 120 -y 80 update list [winfo x .b1] [winfo y .b1] } {120 80} test geometry-1.2 {Tk_ManageGeometry procedure} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .b1 -in .f -x 40 -y 30 update pack .b1 -side top -anchor w place .f -x 30 -y 40 update list [winfo x .b1] [winfo y .b1] } {0 0} test geometry-2.1 {Tk_GeometryRequest procedure} { frame .f2 set result [list [winfo reqwidth .f2] [winfo reqheight .f2]] .f2 configure -width 150 -height 300 update lappend result [winfo reqwidth .f2] [winfo reqheight .f2] \ [winfo geom .f2] place .f2 -x 10 -y 20 update lappend result [winfo geom .f2] .f2 configure -width 100 -height 80 update lappend result [winfo geom .f2] } {1 1 150 300 1x1+0+0 150x300+10+20 100x80+10+20} catch {destroy .f2} test geometry-3.1 {Tk_SetInternalBorder procedure} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .b1 -in .f -x 50 -y 5 update set x [list [winfo x .b1] [winfo y .b1]] .f configure -bd 5 update lappend x [winfo x .b1] [winfo y .b1] } {72 37 75 40} .f configure -bd 2 test geometry-4.1 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 update list [winfo x .b1] [winfo y .b1] } {91 46} test geometry-4.2 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 place .b2 -in .f.f.f -x 10 -y 25 place .b3 -in .f.f.f -x 50 -y 25 update place .f -x 30 -y 25 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ [winfo x .b3] [winfo y .b3] } {101 41 61 61 101 61} test geometry-4.3 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 place .b2 -in .f.f.f -x 10 -y 25 place .b3 -in .f.f.f -x 50 -y 25 update destroy .b1 button .b1 -text .b1 place .f.f -x 10 -y 25 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ [winfo x .b3] [winfo y .b3] } {0 0 46 86 86 86} test geometry-4.4 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 place .b2 -in .f.f.f -x 10 -y 25 place .b3 -in .f.f.f -x 50 -y 25 update destroy .b2 button .b2 -text .b2 place .f.f.f -x 2 -y 3 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ [winfo x .b3] [winfo y .b3] } {93 49 0 0 93 69} test geometry-4.5 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 place .b2 -in .f.f.f -x 10 -y 25 place .b3 -in .f.f.f -x 50 -y 25 update destroy .b3 button .b3 -text .b3 place .f.f.f -x 2 -y 3 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ [winfo x .b3] [winfo y .b3] } {93 49 53 69 0 0} test geometry-4.6 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3 .f.f.b4} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .f.f.b4 -in .f.f.f -x 50 -y 5 place .b2 -in .f.f.f -x 10 -y 25 update place .f -x 25 -y 35 update list [winfo x .f.f.b4] [winfo y .f.f.b4] [winfo x .b2] [winfo y .b2] } {54 9 56 71} test geometry-4.7 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3 .f.f.b4} { place forget $w } bind .b1 {lappend x configure} place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .f.f.b4 -in .f.f.f -x 50 -y 5 place .b1 -in .f.f.f -x 10 -y 25 update set x init place .f -x 25 -y 35 update lappend x | place .f -x 30 -y 40 place .f.f -x 10 -y 0 update bind .b1 {} set x } {init configure |} test geometry-4.8 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 place .b2 -in .f.f.f -x 10 -y 25 place .b3 -in .f.f.f -x 50 -y 25 update destroy .f.f frame .f.f -bd 2 -relief raised frame .f.f.f -bd 2 -relief raised place .f -x 30 -y 25 update list [winfo x .b1] [winfo y .b1] [winfo ismapped .b1] \ [winfo x .b2] [winfo y .b2] [winfo ismapped .b2] \ [winfo x .b3] [winfo y .b3] [winfo ismapped .b3] } {91 46 0 51 66 0 91 66 0} test geometry-4.9 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 update set result [winfo ismapped .b1] place forget .f.f update lappend result [winfo ismapped .b1] place .f.f -x 15 -y 5 -width 150 -height 120 update lappend result [winfo ismapped .b1] } {1 0 1} test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { toplevel .t wm geometry .t +0+0 tkwait visibility .t update frame .t.f pack .t.f button .t.quit -text Quit -command exit pack .t.quit -in .t.f wm iconify .t set x 0 after 500 {set x 1} tkwait variable x wm deiconify .t update winfo ismapped .t.quit } {1} catch {destroy .t} # cleanup cleanupTests return tk8.5.19/tests/unixMenu.test0000644003604700454610000010025412612445655014441 0ustar dgp771div# This file is a Tcl script to test menus in Tk. It is # organized in the standard fashion for Tcl tests. This # file tests the Macintosh-specific features of the menu # system. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands test unixMenu-1.1 {TkpNewMenu - normal menu} unix { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} test unixMenu-1.2 {TkpNewMenu - help menu} unix { catch {destroy .m1} menu .m1 -tearoff 0 . configure -menu .m1 .m1 add cascade -label Help -menu .m1.help list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] } {0 .m1.help {} {}} test unixMenu-2.1 {TkpDestroyMenu - nothing to do} {} {} test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} {} {} test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label test list [catch {.m1 entryconfigure test -label foo} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m2 -label test menu .m1.foo -tearoff 0 list [catch {.m1 entryconfigure test -menu .m1.foo} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} {} {} test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo . configure -menu .m1 list [catch {. configure -menu ""} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-6.2 {TkpSetWindowMenuBar - menu} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} {} {} test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -indicatoron 0 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} {unix testImageType} { catch {destroy .m1} catch {image delete image1} menu .m1 image create test image1 .m1 add checkbutton -image image1 -label foo .m1 invoke foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] } {0 {} {}} test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -bitmap questhead -label foo .m1 invoke foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo .m1 invoke foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} {unix testImageType} { catch {destroy .m1} catch {image delete image1} menu .m1 image create test image1 .m1 add radiobutton -image image1 -label foo .m1 invoke foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] } {0 {} {}} test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} unix { catch {destroy .m1} menu .m1 .m1 add radiobutton -bitmap questhead -label foo .m1 invoke foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} unix { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo .m1 invoke foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} unix { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo -hidemargin 1 .m1 invoke foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+S" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-9.3 {GetMenuAccelGeometry - null label} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo . configure -menu .m1 .m1 activate 1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-10.2 {DrawMenuEntryBackground - active} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] $tearoff activate 0 list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-10.3 {DrawMenuEntryBackground - non-active} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} # drawArrow parameter is never false under Unix test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -indicatoron 0 set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} unix { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo -indicatoron 0 set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} unix { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} unix { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-13.1 {DrawMenuSeparator - menubar case} unix { catch {destroy .m1} menu .m1 .m1 add separator . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-13.2 {DrawMenuSepartor - normal menu} unix { catch {destroy .m1} menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-14.1 {DrawMenuEntryLabel} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-15.1 {DrawMenuUnderline - menubar} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -underline 0 . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-15.2 {DrawMenuUnderline - no menubar} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -underline 0 set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-16.1 {TkpPostMenu} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-17.1 {GetMenuSeparatorGeometry} unix { catch {destroy .m1} menu .m1 .m1 add separator list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test unixMenu-18.1 {GetTearoffEntryGeometry} {unix nonUnixUserInteraction} { catch {destroy .m1} menubutton .mb -text "test" -menu .mb.m menu .mb.m .mb.m add command -label test pack .mb raise . list [catch {tk::MbPost .mb} msg] $msg [tk::MenuUnpost .mb.m] [destroy .mb] } {0 {} {} {}} # Don't know how to reproduce the case where the tkwin has been deleted. test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} unix { catch {destroy .m1} menu .m1 . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} # Don't know how to generate one width windows test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label File . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} unix { catch {destroy .m1} menu .m1 -font "Courier 24" .m1 add cascade -label File -font "Helvetica 18" . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} unix { catch {destroy .m1} menu .m1 .m1 add separator . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File -font "Times 72" . configure -menu .m1 wm geometry . 10x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File .m1 add cascade -label Edit . configure -menu .m1 wm geometry . 200x200 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File .m1 add cascade -label Edit -font "Times 72" . configure -menu .m1 wm geometry . 100x100 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File -font "Times 72" .m1 add cascade -label Edit . configure -menu .m1 wm geometry . 100x100 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} unix { catch {destroy .m1} menu .m1 -tearoff 0 -font "Times 72" .m1 add cascade -label File .m1 add cascade -label Edit . configure -menu .m1 wm geometry . 10x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} # ABC notation; capital A means first window fits, small a means it # does not. capital B menu means second window fist, etc. test unixMenu-19.11 {TkpComputeMenubarGeometry - abc} unix { catch {destroy .m1} menu .m1 -tearoff 0 -font "Times 72" .m1 add cascade -label "aaaaa" .m1 add cascade -label "bbbbb" .m1 add cascade -label "ccccc" . configure -menu .m1 wm geometry . 10x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.12 {TkpComputeMenubarGeometry - abC} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label "aaaaa" -font "Times 72" .m1 add cascade -label "bbbbb" -font "Times 72" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 10x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.13 {TkpComputeMenubarGeometry - aBc} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label "aaaaa" -font "Times 72" .m1 add cascade -label "B" .m1 add cascade -label "ccccc" -font "Times 72" . configure -menu .m1 wm geometry . 10x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.14 {TkpComputeMenubarGeometry - aBC} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label "aaaaa" -font "Times 72" .m1 add cascade -label "B" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 60x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.15 {TkpComputeMenubarGeometry - Abc} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "bbbbb" -font "Times 72" .m1 add cascade -label "ccccc" -font "Times 72" . configure -menu .m1 wm geometry . 60x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.16 {TkpComputeMenubarGeometry - AbC} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "bbbbb" -font "Times 72" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 60x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.17 {TkpComputeMenubarGeometry - ABc} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "B" .m1 add cascade -label "ccccc" -font "Times 72" . configure -menu .m1 wm geometry . 60x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.18 {TkpComputeMenubarGeometry - ABC} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "B" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 100x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label Help -menu .m1.help menu .m1.help -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 .m1 add cascade -label Edit -menu .m1.edit menu .m1.edit -tearoff 0 . configure -menu .m1 wm geometry . 100x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label Edit -menu .m1.edit menu .m1.edit -tearoff 0 .m1 add cascade -label Help -menu .m1.help menu .m1.help -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 . configure -menu .m1 wm geometry . 100x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 .m1 add cascade -label Edit -menu .m1.edit menu .m1.edit -tearoff 0 .m1 add cascade -label Help -menu .m1.help menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 .m1 add cascade -label Help -menu .m1.help menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 .m1 add cascade -label Help -menu .m1.help -font "Helvetica 72" menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label Help -menu .m1.help menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-20.1 {DrawTearoffEntry - menubar} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label File . configure -menu .m1 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} test unixMenu-20.2 {DrawTearoffEntry - non-menubar} {unix nonUnixUserInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label foo .m1 post 40 40 list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} {} {} test unixMenu-22.1 {SetHelpMenu - no menubars} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label test -menu .m1.test list [catch {menu .m1.test} msg] $msg [destroy .m1] } {0 .m1.test {}} # Don't know how to automate missing tkwins test unixMenu-22.2 {SetHelpMenu - menubar but no help menu} unix { catch {destroy .m1} menu .m1 -tearoff 0 . configure -menu .m1 .m1 add cascade -label .m1.file list [catch {menu .m1.file} msg] $msg [. configure -menu ""] [destroy .m1] } {0 .m1.file {} {}} test unixMenu-22.3 {SetHelpMenu - menubar with help menu} unix { catch {destroy .m1} menu .m1 -tearoff 0 . configure -menu .m1 .m1 add cascade -label .m1.help list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] } {0 .m1.help {} {}} test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} unix { catch {destroy .m1} catch {destroy .t2} toplevel .t2 wm geometry .t2 +40+40 menu .m1 -tearoff 0 . configure -menu .m1 .t2 configure -menu .m1 .m1 add cascade -label .m1.help list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2] } {0 .m1.help {} {} {}} test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} test unixMenu-23.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground red set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} unix { catch {destroy .m1} menu .m1 set tk_strictMotif 1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} test unixMenu-23.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} unix { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} unix { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} unix { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -foreground red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -selectcolor orange .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -activebackground green set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} test unixMenu-23.12 {TkpDrawMenuEntry - border} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} unix { catch {destroy .m1} set tk_strictMotif 1 menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} test unixMenu-23.14 {TkpDrawMenuEntry - active border - custom entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground yellow set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} test unixMenu-23.15 {TkpDrawMenuEntry - active border} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label foo -font "Helvectica 72" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.17 {TkpDrawMenuEntry - font} unix { catch {destroy .m1} menu .m1 -font "Courier 72" .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.18 {TkpDrawMenuEntry - separator} unix { catch {destroy .m1} menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.19 {TkpDrawMenuEntry - standard} unix { catch {destroy .mb} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label File -menu .m1.file menu .m1.file .m1.file add command -label foo .m1 entryconfigure File -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.21 {TkpDrawMenuEntry - indicator} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label Foo .m1 invoke Foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label Foo -hidemargin 1 .m1 invoke Foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test unixMenu-24.1 {GetMenuLabelGeometry - image} {testImageType unix} { catch {destroy .m1} catch {image delete image1} menu .m1 image create test image1 .m1 add command -image image1 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} test unixMenu-24.2 {GetMenuLabelGeometry - bitmap} unix { catch {destroy .m1} menu .m1 .m1 add command -bitmap questhead list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-24.3 {GetMenuLabelGeometry - no text} unix { catch {destroy .m1} menu .m1 .m1 add command list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-24.4 {GetMenuLabelGeometry - text} unix { catch {destroy .m1} menu .m1 .m1 add command -label "This is a test." list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} unix { catch {destroy .m1} menu .m1 list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label "one" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.3 {TkpComputeStandardMenuGeometry - more than one entry} unix { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} unix { catch {destroy .m1} menu .m1 .m1 add separator list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unix nonUnixUserInteraction} { catch {destroy .m1} menubutton .mb -text "test" -menu .mb.m menu .mb.m .mb.m add command -label test pack .mb catch {tk::MbPost .mb} list [update] [tk::MenuUnpost .mb.m] [destroy .mb] } {{} {} {}} test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} unix { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} unix { catch {destroy .m1} menu .m1 -font "Helvetica 12" .m1 add command -label "test" -font "Courier 12" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.8 {TkpComputeStandardMenuGeometry - second entry larger} unix { catch {destroy .m1} menu .m1 .m1 add command -label "test" .m1 add command -label "test test" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.9 {TkpComputeStandardMenuGeometry - first entry larger} unix { catch {destroy .m1} menu .m1 .m1 add command -label "test test" .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.10 {TkpComputeStandardMenuGeometry - accelerator} unix { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "Ctrl+S" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.11 {TkpComputeStandardMenuGeometry - second accel larger} unix { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "1" .m1 add command -label "test" -accel "1 1" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.12 {TkpComputeStandardMenuGeometry - second accel smaller} unix { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "1 1" .m1 add command -label "test" -accel "1" list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.13 {TkpComputeStandardMenuGeometry - indicator} unix { catch {destroy .m1} menu .m1 .m1 add checkbutton -label test .m1 invoke 1 list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } {unix testImageType} { catch {destroy .m1} catch {image delete image1} image create test image1 menu .m1 .m1 add checkbutton -image image1 .m1 invoke 1 .m1 add checkbutton -label test .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unix testImageType} { catch {destroy .m1} catch {image delete image1} image create test image1 menu .m1 .m1 add checkbutton -image image1 .m1 invoke 1 .m1 add checkbutton -label test .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} test unixMenu-25.16 {TkpComputeStandardMenuGeometry - zero sized menus} unix { catch {destroy .m1} menu .m1 -tearoff 0 list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.17 {TkpComputeStandardMenuGeometry - first column bigger} unix { catch {destroy .m1} menu .m1 .m1 add command -label one .m1 add command -label two .m1 add command -label three -columnbreak 1 list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.18 {TkpComputeStandardMenuGeometry - second column bigger} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two -columnbreak 1 .m1 add command -label three list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two -columnbreak 1 .m1 add command -label three .m1 add command -label four .m1 add command -label five -columnbreak 1 .m1 add command -label six list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} unix { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add checkbutton -label one -hidemargin 1 list [update idletasks] [destroy .m1] } {{} {}} test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {} # cleanup deleteWindows cleanupTests return tk8.5.19/tests/flagup.xbm0000644003604700454610000000353012612445655013715 0ustar dgp771div#define flagup_width 48 #define flagup_height 48 static char flagup_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xef, 0x6a, 0x00, 0x00, 0x00, 0xc0, 0x7b, 0x75, 0x00, 0x00, 0x00, 0xe0, 0xe0, 0x6a, 0x00, 0x00, 0x00, 0x30, 0x60, 0x75, 0x00, 0x00, 0x00, 0x18, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x0c, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x06, 0xe0, 0x04, 0x00, 0x00, 0x00, 0x03, 0xe0, 0x04, 0x00, 0x00, 0x80, 0x01, 0xe0, 0x06, 0x00, 0x00, 0xc0, 0x1f, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x7f, 0xe0, 0x07, 0x00, 0x00, 0x70, 0xe0, 0xe0, 0x05, 0x00, 0x00, 0x38, 0x80, 0xe1, 0x04, 0x00, 0x00, 0x18, 0x80, 0xf1, 0x04, 0x00, 0x00, 0x0c, 0x00, 0xfb, 0x04, 0x00, 0x00, 0x0c, 0x00, 0xff, 0x04, 0x00, 0x00, 0x86, 0x1f, 0xee, 0x04, 0x00, 0x00, 0x06, 0x06, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0x66, 0x04, 0x00, 0x7f, 0x56, 0x52, 0x06, 0xe4, 0xff, 0x00, 0x76, 0x55, 0x06, 0x04, 0x00, 0x00, 0x56, 0x57, 0x06, 0x04, 0x00, 0x00, 0x56, 0x55, 0x06, 0x06, 0x00, 0x00, 0x56, 0xd5, 0x06, 0x03, 0x00, 0x00, 0x06, 0x00, 0x86, 0x01, 0x00, 0x54, 0x06, 0x00, 0xc6, 0x54, 0x55, 0xaa, 0x06, 0x00, 0x66, 0xaa, 0x2a, 0x54, 0x06, 0x00, 0x36, 0x55, 0x55, 0xaa, 0x06, 0x00, 0xbe, 0xaa, 0x2a, 0x54, 0xfe, 0xff, 0x6f, 0x55, 0x55, 0xaa, 0xfc, 0xff, 0xa7, 0xaa, 0x2a, 0x54, 0x01, 0x88, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a, 0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a, 0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a, 0x54, 0x55, 0x8d, 0x50, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa8, 0xaa, 0x2a, 0x54, 0x55, 0x95, 0x54, 0x55, 0x55, 0xaa, 0xaa, 0xaa, 0xaa, 0xaa, 0x2a, 0x54, 0x55, 0x55, 0x55, 0x55, 0x15, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; tk8.5.19/tests/canvPsText.tcl0000644003604700454610000001001712612445655014530 0ustar dgp771div# This file creates a screen to exercise Postscript generation # for text in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. catch {destroy .t} toplevel .t wm title .t "Postscript Tests for Canvases" wm iconname .t "Postscript" wm geom .t +0+0 wm minsize .t 1 1 set c .t.c message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for text. Click on "Print" to print the canvas to your default printer. The "Stipple" button can be used to turn stippling on and off for the text, but beware: many Postscript printers cannot handle stippled text. You can click on items in the canvas to delete them.} -width 6i pack .t.m -side top -fill both set stipple {} checkbutton .t.stipple -text Stippling -variable stipple -onvalue gray50 \ -offvalue {} -command "setStipple $c" -relief flat pack .t.stipple -side top -pady 2m -expand 1 -anchor w frame .t.bot pack .t.bot -side bottom -fill both button .t.bot.quit -text Quit -command {destroy .t} button .t.bot.print -text Print -command "lpr $c" pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1 canvas $c -width 6i -height 7i -bd 2 -relief sunken pack $c -expand yes -fill both -padx 2m -pady 2m $c create rect 2.95i 0.45i 3.05i 0.55i -fill {} -outline black $c create text 3.0i 0.5i -text "Center Courier Oblique 24" \ -anchor center -tags text -font {Courier 24 italic} -stipple $stipple $c create rect 2.95i 0.95i 3.05i 1.05i -fill {} -outline black $c create text 3.0i 1.0i -text "Northwest Helvetica 24" \ -anchor nw -tags text -font {Helvetica 24} -stipple $stipple $c create rect 2.95i 1.45i 3.05i 1.55i -fill {} -outline black $c create text 3.0i 1.5i -text "North Helvetica Oblique 12 " \ -anchor n -tags text -font {Helvetica 12 italic} -stipple $stipple $c create rect 2.95i 1.95i 3.05i 2.05i -fill {} -outline blue $c create text 3.0i 2.0i -text "Northeast Helvetica Bold 24" \ -anchor ne -tags text -font {Helvetica 24 bold} -stipple $stipple $c create rect 2.95i 2.45i 3.05i 2.55i -fill {} -outline black $c create text 3.0i 2.5i -text "East Helvetica Bold Oblique 18" \ -anchor e -tags text -font {Helvetica 18 {bold italic}} -stipple $stipple $c create rect 2.95i 2.95i 3.05i 3.05i -fill {} -outline black $c create text 3.0i 3.0i -text "Southeast Times 10" \ -anchor se -tags text -font {Times 10} -stipple $stipple $c create rect 2.95i 3.45i 3.05i 3.55i -fill {} -outline black $c create text 3.0i 3.5i -text "South Times Italic 24" \ -anchor s -tags text -font {Times 24 italic} -stipple $stipple $c create rect 2.95i 3.95i 3.05i 4.05i -fill {} -outline black $c create text 3.0i 4.0i -text "Southwest Times Bold 18" \ -anchor sw -tags text -font {Times 18 bold} -stipple $stipple $c create rect 2.95i 4.45i 3.05i 4.55i -fill {} -outline black $c create text 3.0i 4.5i -text "West Times Bold Italic 24"\ -anchor w -tags text -font {Times 24 {bold italic}} -stipple $stipple $c create rect 0.95i 5.20i 1.05i 5.30i -fill {} -outline black $c create text 1.0i 5.25i -width 1.9i -anchor c -justify left -tags text \ -font {Times 18 bold} -stipple $stipple \ -text "This is a sample text item to see how left justification works" $c create rect 2.95i 5.20i 3.05i 5.30i -fill {} -outline black $c create text 3.0i 5.25i -width 1.8i -anchor c -justify center -tags text \ -font {Times 18 bold} -stipple $stipple \ -text "This is a sample text item to see how center justification works" $c create rect 4.95i 5.20i 5.05i 5.30i -fill {} -outline black $c create text 5.0i 5.25i -width 1.8i -anchor c -justify right -tags text \ -font {Times 18 bold} -stipple $stipple \ -text "This is a sample text item to see how right justification works" $c create text 3.0i 6.0i -width 5.0i -anchor n -justify right -tags text \ -text "This text is\nright justified\nwith a line length equal to\n\ the size of the enclosing rectangle.\nMake sure it prints right\ justified as well." $c create rect 0.5i 6.0i 5.5i 6.9i -fill {} -outline black proc setStipple c { global stipple $c itemconfigure text -stipple $stipple } tk8.5.19/tests/textDisp.test0000644003604700454610000045624412656403262014446 0ustar dgp771div# This file is a Tcl script to test the code in the file tkTextDisp.c. # This file is organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test # The procedure below is used as the scrolling command for the text; # it just saves the scrolling information in a variable "scrollInfo". proc scroll args { global scrollInfo set scrollInfo $args } # The procedure below is used to generate errors during scrolling commands. proc scrollError args { error "scrolling error" } # Create entries in the option database to be sure that geometry options # like border width have predictable values. set twbw 2 set twht 2 option add *Text.borderWidth $twbw option add *Text.highlightThickness $twht # The frame .f is needed to make sure that the overall window is always # fairly wide, even if the text window is very narrow. This is needed # because some window managers don't allow the overall width of a window # to get very narrow. catch {destroy .f .t} frame .f -width 100 -height 20 pack append . .f left set fixedFont {Courier -12} # 15 on XP, 13 on Solaris 8 set fixedHeight [font metrics $fixedFont -linespace] # 7 on all platforms set fixedWidth [font measure $fixedFont m] # 12 on XP set fixedAscent [font metrics $fixedFont -ascent] set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP set varFont {Times -14} # 16 on XP, 15 on Solaris 8 set varHeight [font metrics $varFont -linespace] # 13 on XP set varAscent [font metrics $varFont -ascent] set varDiff [expr {$varHeight - 15}] ;# 1 on XP set bigFont {Helvetica -24} # 27 on XP, 27 on Solaris 8 set bigHeight [font metrics $bigFont -linespace] # 21 on XP set bigAscent [font metrics $bigFont -ascent] set ascentDiff [expr {$bigAscent - $fixedAscent}] text .t -font $fixedFont -width 20 -height 10 -yscrollcommand scroll pack append . .t {top expand fill} .t tag configure big -font $bigFont .t debug on wm geometry . {} # The statements below reset the main window; it's needed if the window # manager is mwm to make mwm forget about a previous minimum size setting. wm withdraw . wm minsize . 1 1 wm positionfrom . user wm deiconify . update # Some window managers (like olwm under SunOS 4.1.3) misbehave in a way # that tends to march windows off the top and left of the screen. If # this happens, some tests will fail because parts of the window will # not need to be displayed (because they're off-screen). To keep this # from happening, move the window if it's getting near the left or top # edges of the screen. if {([winfo rooty .] < 50) || ([winfo rootx .] < 50)} { wm geom . +50+50 } test textDisp-0.1 {double tag elide transition} { # Example from tkchat crash. For some reason can only # get this test case to crash when first. catch {destroy .top} pack [text .top] foreach val {0 1 2 3} { .top insert 1.0 "hello\n" .top tag configure tag$val .top tag add tag$val 1.0 2.0 set ::Options(tag$val) 0 } proc DoVis {tag} { .top tag config $tag -elide $::Options($tag) } proc NickVis {val} { foreach t [array names ::Options ] { if {$::Options($t) != $val} { set ::Options($t) $val DoVis $t } } } NickVis 1 unset ::Options destroy .top } {} test textDisp-0.2 {double tag elide transition} { # Example from tkchat crash. For some reason can only # get this test case to crash when first. catch {destroy .top} pack [text .top] foreach val {0 1 2 3} { .top insert 1.0 "hello" .top tag configure tag$val .top tag add tag$val 1.0 1.5 set ::Options(tag$val) 0 } proc DoVis {tag} { .top tag config $tag -elide $::Options($tag) } proc NickVis {val} { foreach t [array names ::Options ] { if {$::Options($t) != $val} { set ::Options($t) $val DoVis $t } } } NickVis 1 unset ::Options destroy .top } {} test textDisp-0.3 {double tag elide transition} { catch {destroy .txt} pack [text .txt] # Note that TRAFFIC should have a higher priority than SYSTEM # in terms of the tag effects. .txt tag configure SYSTEM -elide 0 .txt tag configure TRAFFIC -elide 1 .txt insert end "\n" {TRAFFIC SYSTEM} update destroy .txt } {} test textDisp-0.4 {double tag elide transition} { catch {destroy .txt} pack [text .txt] # Note that TRAFFIC should have a higher priority than SYSTEM # in terms of the tag effects. .txt tag configure SYSTEM -elide 0 .txt tag configure TRAFFIC -elide 1 .txt insert end "\n" {SYSTEM TRAFFIC} # Crash was here. update destroy .txt } {} test textDisp-0.5 {double tag elide transition} { catch {destroy .txt} pack [text .txt] .txt tag configure WELCOME -elide 1 .txt tag configure SYSTEM -elide 0 .txt tag configure TRAFFIC -elide 1 .txt insert end "\n" {SYSTEM TRAFFIC} .txt insert end "\n" WELCOME # Crash was here. update destroy .txt } {} test textDisp-1.1 {GetStyle procedure, priorities and tab stops} { .t delete 1.0 end .t insert 1.0 "x\ty" .t tag delete x y z .t tag configure x -tabs {50} .t tag configure y -foreground black .t tag configure z -tabs {70} .t tag add x 1.0 1.end .t tag add y 1.0 1.end .t tag add z 1.0 1.end update idletasks set x [lindex [.t bbox 1.2] 0] .t tag configure z -tabs {} lappend x [lindex [.t bbox 1.2] 0] .t tag configure z -tabs {30} .t tag raise x update idletasks lappend x [lindex [.t bbox 1.2] 0] } [list 75 55 55] .t tag delete x y z test textDisp-1.2 {GetStyle procedure, wrapmode} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcd\nefg hijkl mnop qrstuv wxyz" .t tag configure x -wrap word .t tag configure y -wrap none .t tag raise y update set result [list [.t bbox 2.20]] .t tag add x 2.0 2.1 lappend result [.t bbox 2.20] .t tag add y 1.end 2.2 lappend result [.t bbox 2.20] } [list [list 5 [expr {5+2*$fixedHeight}] 7 $fixedHeight] [list 40 [expr {5+2*$fixedHeight}] 7 $fixedHeight] {}] .t tag delete x y test textDisp-2.1 {LayoutDLine, basics} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "This is some sample text for testing." list [.t bbox 1.19] [.t bbox 1.20] } [list [list [expr 5 + $fixedWidth * 19] 5 $fixedWidth $fixedHeight] [list 5 [expr 5 + $fixedHeight] $fixedWidth $fixedHeight]] test textDisp-2.2 {LayoutDLine, basics} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "This isx some sample text for testing." list [.t bbox 1.19] [.t bbox 1.20] } [list [list 138 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-2.3 {LayoutDLine, basics} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "This isxxx some sample text for testing." list [.t bbox 1.19] [.t bbox 1.20] } [list [list 138 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-2.4 {LayoutDLine, word wrap} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "This is some sample text for testing." list [.t bbox 1.19] [.t bbox 1.20] } [list [list 138 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-2.5 {LayoutDLine, word wrap} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "This isx some sample text for testing." list [.t bbox 1.13] [.t bbox 1.14] [.t bbox 1.19] } [list [list 96 5 49 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 40 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-2.6 {LayoutDLine, word wrap} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "This isxxx some sample text for testing." list [.t bbox 1.15] [.t bbox 1.16] } [list [list 110 5 35 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-2.7 {LayoutDLine, marks and tags} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "This isxxx some sample text for testing." .t tag add foo 1.4 1.6 .t mark set insert 1.8 list [.t bbox 1.2] [.t bbox 1.5] [.t bbox 1.11] } [list [list 19 5 7 $fixedHeight] [list 40 5 7 $fixedHeight] [list 82 5 7 $fixedHeight]] foreach m [.t mark names] { catch {.t mark unset $m} } scan [wm geom .] %dx%d width height test textDisp-2.8 {LayoutDLine, extra chunk at end of dline} {textfonts} { wm geom . [expr $width+1]x$height update .t configure -wrap char .t delete 1.0 end .t insert 1.0 "This isxx some sample text for testing." .t mark set foo 1.20 list [.t bbox 1.19] [.t bbox 1.20] } [list [list 138 5 8 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight]] wm geom . {} update test textDisp-2.9 {LayoutDLine, marks and tags} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "This is a very_very_long_word_that_wraps." list [.t bbox 1.9] [.t bbox 1.10] [.t bbox 1.25] } [list [list 68 5 77 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 110 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-2.10 {LayoutDLine, marks and tags} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "This is a very_very_long_word_that_wraps." .t tag add foo 1.13 .t tag add foo 1.15 .t tag add foo 1.17 .t tag add foo 1.19 list [.t bbox 1.9] [.t bbox 1.10] [.t bbox 1.25] } [list [list 68 5 77 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 110 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-2.11 {LayoutDLine, newline width} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a\nbb\nccc\ndddd" list [.t bbox 2.2] [.t bbox 3.3] } [list [list 19 [expr {$fixedDiff + 18}] 126 $fixedHeight] [list 26 [expr {2*$fixedDiff + 31}] 119 $fixedHeight]] test textDisp-2.12 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "\na\nbb\nccc\ndddd" .t tag configure x -justify center .t tag add x 1.0 end .t tag add y 3.0 3.2 list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 4.0] [.t bbox 4.2] } [list [list 75 5 70 $fixedHeight] [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 64 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] [list 78 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] test textDisp-2.13 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "\na\nbb\nccc\ndddd" .t tag configure x -justify right .t tag add x 1.0 end .t tag add y 3.0 3.2 list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 4.0] [.t bbox 4.2] } [list [list 145 5 0 $fixedHeight] [list 138 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 124 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] [list 138 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] test textDisp-2.14 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "\na\nbb\nccc\ndddd" .t tag configure x -justify center .t tag add x 2.0 3.1 .t tag configure y -justify right .t tag add y 3.0 4.0 .t tag raise y list [.t bbox 2.0] [.t bbox 3.0] [.t bbox 3.end] [.t bbox 4.0] } [list [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 131 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 145 [expr {2*$fixedDiff + 31}] 0 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] test textDisp-2.15 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "\na\nbb\nccc\ndddd" .t tag configure x -justify center .t tag add x 2.0 3.1 .t tag configure y -justify right .t tag add y 3.0 4.0 .t tag lower y list [.t bbox 2.0] [.t bbox 3.0] [.t bbox 3.end] [.t bbox 4.0] } [list [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 68 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 82 [expr {2*$fixedDiff + 31}] 63 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] test textDisp-2.16 {LayoutDLine, justification} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines" .t tag configure x -justify center .t tag add x 1.1 1.20 .t tag add x 1.21 1.end list [.t bbox 1.0] [.t bbox 1.20] [.t bbox 1.36] [.t bbox 2.0] } [list [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 43 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] test textDisp-2.17 {LayoutDLine, justification} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines" .t tag configure x -justify center .t tag add x 1.20 list [.t bbox 1.0] [.t bbox 1.20] [.t bbox 1.36] [.t bbox 2.0] } [list [list 5 5 7 $fixedHeight] [list 19 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] test textDisp-2.18 {LayoutDLine, justification} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert 1.0 "Lots of long words, enough to extend out of the window\n" .t insert end "Then\nmore lines\nThat are shorter" .t tag configure x -justify center .t tag configure y -justify right .t tag add x 2.0 .t tag add y 3.0 .t xview scroll 5 units list [.t bbox 2.0] [.t bbox 3.0] } [list [list 26 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 40 [expr {2*$fixedDiff + 31}] 7 $fixedHeight]] .t tag delete x .t tag delete y test textDisp-2.19 {LayoutDLine, margins} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines" .t tag configure x -lmargin1 20 -lmargin2 40 -rmargin 15 .t tag add x 1.0 end list [.t bbox 1.0] [.t bbox 1.12] [.t bbox 1.13] [.t bbox 2.0] } [list [list 25 5 7 $fixedHeight] [list 109 5 36 $fixedHeight] [list 45 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 25 [expr {5*$fixedDiff + 70}] 7 $fixedHeight]] test textDisp-2.20 {LayoutDLine, margins} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines" .t tag configure x -lmargin1 20 -lmargin2 10 -rmargin 3 .t tag configure y -lmargin1 15 -lmargin2 5 -rmargin 0 .t tag raise y .t tag add x 1.0 end .t tag add y 1.13 list [.t bbox 1.0] [.t bbox 1.13] [.t bbox 1.30] [.t bbox 2.0] } [list [list 25 5 7 $fixedHeight] [list 10 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 15 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 25 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] test textDisp-2.21 {LayoutDLine, margins} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Sample text" .t tag configure x -lmargin1 80 -lmargin2 80 -rmargin 100 .t tag add x 1.0 end list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2] } [list [list 85 5 60 $fixedHeight] [list 85 [expr {$fixedDiff + 18}] 60 $fixedHeight] [list 85 [expr {2*$fixedDiff + 31}] 60 $fixedHeight]] .t tag delete x .t tag delete y test textDisp-2.22 {LayoutDLine, spacing options} {textfonts} { .t configure -wrap word .t delete 1.0 end .t tag delete x y .t insert end "Short line\nLine 2 is long enough " .t insert end "to wrap around a couple of times" .t insert end "\nLine 3\nLine 4" set i [.t dlineinfo 1.0] set b1 [expr [lindex $i 1] + [lindex $i 4]] set i [.t dlineinfo 2.0] set b2 [expr [lindex $i 1] + [lindex $i 4]] set i [.t dlineinfo 2.end] set b3 [expr [lindex $i 1] + [lindex $i 4]] set i [.t dlineinfo 3.0] set b4 [expr [lindex $i 1] + [lindex $i 4]] .t configure -spacing1 2 -spacing2 1 -spacing3 3 set i [.t dlineinfo 1.0] set b1 [expr [lindex $i 1] + [lindex $i 4] - $b1] set i [.t dlineinfo 2.0] set b2 [expr [lindex $i 1] + [lindex $i 4] - $b2] set i [.t dlineinfo 2.end] set b3 [expr [lindex $i 1] + [lindex $i 4] - $b3] set i [.t dlineinfo 3.0] set b4 [expr [lindex $i 1] + [lindex $i 4] - $b4] list $b1 $b2 $b3 $b4 } [list 2 7 10 15] .t configure -spacing1 0 -spacing2 0 -spacing3 0 test textDisp-2.23 {LayoutDLine, spacing options} {textfonts} { .t configure -wrap word .t delete 1.0 end .t tag delete x y .t insert end "Short line\nLine 2 is long enough " .t insert end "to wrap around a couple of times" .t insert end "\nLine 3\nLine 4" set i [.t dlineinfo 1.0] set b1 [expr [lindex $i 1] + [lindex $i 4]] set i [.t dlineinfo 2.0] set b2 [expr [lindex $i 1] + [lindex $i 4]] set i [.t dlineinfo 2.end] set b3 [expr [lindex $i 1] + [lindex $i 4]] set i [.t dlineinfo 3.0] set b4 [expr [lindex $i 1] + [lindex $i 4]] .t configure -spacing1 4 -spacing2 4 -spacing3 4 .t tag configure x -spacing1 1 -spacing2 2 -spacing3 3 .t tag add x 1.0 end .t tag configure y -spacing1 0 -spacing2 3 .t tag add y 2.19 end .t tag raise y set i [.t dlineinfo 1.0] set b1 [expr [lindex $i 1] + [lindex $i 4] - $b1] set i [.t dlineinfo 2.0] set b2 [expr [lindex $i 1] + [lindex $i 4] - $b2] set i [.t dlineinfo 2.end] set b3 [expr [lindex $i 1] + [lindex $i 4] - $b3] set i [.t dlineinfo 3.0] set b4 [expr [lindex $i 1] + [lindex $i 4] - $b4] list $b1 $b2 $b3 $b4 } [list 1 5 13 16] .t configure -spacing1 0 -spacing2 0 -spacing3 0 test textDisp-2.24 {LayoutDLine, tabs, saving from first chunk} {textfonts} { .t delete 1.0 end .t tag delete x y .t tag configure x -tabs 70 .t tag configure y -tabs 80 .t insert 1.0 "ab\tcde" .t tag add x 1.0 end .t tag add y 1.1 end lindex [.t bbox 1.3] 0 } {75} test textDisp-2.25 {LayoutDLine, tabs, breaking chunks at tabs} {textfonts} { .t delete 1.0 end .t tag delete x .t tag configure x -tabs [list 30 60 90 120] .t insert 1.0 "a\tb\tc\td\te" .t mark set dummy1 1.1 .t mark set dummy2 1.2 .t tag add x 1.0 end list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] \ [lindex [.t bbox 1.6] 0] [lindex [.t bbox 1.8] 0] } [list 35 65 95 125] test textDisp-2.26 {LayoutDLine, tabs, breaking chunks at tabs} {textfonts} { .t delete 1.0 end .t tag delete x .t tag configure x -tabs [list 30 60 90 120] -justify right .t insert 1.0 "a\tb\tc\td\te" .t mark set dummy1 1.1 .t mark set dummy2 1.2 .t tag add x 1.0 end list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] \ [lindex [.t bbox 1.6] 0] [lindex [.t bbox 1.8] 0] } [list 117 124 131 138] test textDisp-2.27 {LayoutDLine, tabs, calling AdjustForTab} {textfonts} { .t delete 1.0 end .t tag delete x .t tag configure x -tabs [list 30 60] .t insert 1.0 "a\tb\tcd" .t tag add x 1.0 end list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] } [list 35 65] test textDisp-2.28 {LayoutDLine, tabs, running out of space in dline} {textfonts} { .t delete 1.0 end .t insert 1.0 "a\tb\tc\td" .t bbox 1.6 } [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] test textDisp-2.29 {LayoutDLine, tabs, running out of space in dline} {textfonts} { .t delete 1.0 end .t insert 1.0 "a\tx\tabcd" .t bbox 1.4 } [list 117 5 7 $fixedHeight] test textDisp-2.30 {LayoutDLine, tabs, running out of space in dline} {textfonts} { .t delete 1.0 end .t insert 1.0 "a\tx\tabc" .t bbox 1.4 } [list 117 5 7 $fixedHeight] test textDisp-3.1 {different character sizes} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert end "Some sample text, including both large\n" .t insert end "characters and\nsmall\n" .t insert end "abc\nd\ne\nfghij" .t tag add big 1.5 1.10 .t tag add big 2.11 2.14 list [.t bbox 1.1] [.t bbox 1.6] [.t dlineinfo 1.0] [.t dlineinfo 3.0] } [list [list 12 [expr {5+$ascentDiff}] 7 $fixedHeight] [list 52 5 13 27] [list 5 5 114 27 [font metrics $bigFont -ascent]] [list 5 [expr {2* $fixedDiff + 85}] 35 $fixedHeight [expr {$fixedDiff + 10}]]] .t configure -wrap char test textDisp-4.1 {UpdateDisplayInfo, basic} {textfonts} { .t delete 1.0 end .t insert end "Line 1\nLine 2\nLine 3\n" update .t delete 2.0 2.end update set res $tk_textRelayout .t insert 2.0 "New Line 2" update lappend res [.t bbox 1.0] [.t bbox 2.0] [.t bbox 3.0] $tk_textRelayout } [list 2.0 [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] 2.0] test textDisp-4.2 {UpdateDisplayInfo, re-use tail of text line} {textfonts} { .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update .t mark set x 2.21 .t delete 2.2 update set res $tk_textRelayout .t insert 2.0 X update lappend res [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout } [list 2.0 2.20 [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 12 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] {2.0 2.20}] test textDisp-4.3 {UpdateDisplayInfo, tail of text line shifts} {textfonts} { .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update .t mark set x 2.21 .t delete 2.2 update list [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout } [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] {2.0 2.20}] .t mark unset x test textDisp-4.4 {UpdateDisplayInfo, wrap-mode "none"} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update list [.t bbox 2.0] [.t bbox 2.25] [.t bbox 3.0] $tk_textRelayout } [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] {1.0 2.0 3.0}] test textDisp-4.5 {UpdateDisplayInfo, tiny window} {textfonts} { if {$tcl_platform(platform) == "windows"} { wm overrideredirect . 1 } wm geom . 103x$height update .t configure -wrap none .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update list [.t bbox 2.0] [.t bbox 2.1] [.t bbox 3.0] $tk_textRelayout } [list [list 5 [expr {$fixedDiff + 18}] 1 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 1 $fixedHeight] {1.0 2.0 3.0}] if {$tcl_platform(platform) == "windows"} { wm overrideredirect . 0 } test textDisp-4.6 {UpdateDisplayInfo, tiny window} { # This test was failing on Windows because the title bar on . # was a certain minimum size and it was interfering with the size # requested. The "overrideredirect" gets rid of the titlebar so # the toplevel can shrink to the appropriate size. On Unix, setting # the overrideredirect on "." confuses the window manager and # causes subsequent tests to fail. if {$tcl_platform(platform) == "windows"} { wm overrideredirect . 1 } frame .f2 -width 20 -height 100 pack before .f .f2 top wm geom . 103x103 update .t configure -wrap none -borderwidth 2 .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update set x [list [.t bbox 1.0] [.t bbox 2.0] $tk_textRelayout] wm overrideredirect . 0 update set x } [list [list 5 5 1 1] {} 1.0] catch {destroy .f2} .t configure -borderwidth 0 -wrap char wm geom . {} update set bw [.t cget -borderwidth] set px [.t cget -padx] set py [.t cget -pady] set hlth [.t cget -highlightthickness] test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} { # This test was failing on Windows because the title bar on . # was a certain minimum size and it was interfering with the size # requested. The "overrideredirect" gets rid of the titlebar so # the toplevel can shrink to the appropriate size. On Unix, setting # the overrideredirect on "." confuses the window manager and # causes subsequent tests to fail. if {$tcl_platform(platform) == "windows"} { wm overrideredirect . 1 } .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" .t yview 1.0 update .t yview 16.0 update set x [list [.t index @0,0] $tk_textRelayout $tk_textRedraw] wm overrideredirect . 0 update set x } {8.0 {16.0 17.0 15.0 14.0 13.0 12.0 11.0 10.0 9.0 8.0} {8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0 16.0 17.0}} test textDisp-4.8 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" .t yview 16.0 update .t delete 5.0 14.0 update set x [list [.t index @0,0] $tk_textRelayout $tk_textRedraw] } {1.0 {5.0 4.0 3.0 2.0 1.0} {1.0 2.0 3.0 4.0 5.0 eof}} test textDisp-4.9 {UpdateDisplayInfo, filling in extra vertical space} {textfonts} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" .t yview 16.0 update .t delete 15.0 end list [.t bbox 7.0] [.t bbox 12.0] } [list [list [expr {$hlth + $px + $bw}] [expr {$hlth + $py + $bw + $fixedHeight}] $fixedWidth $fixedHeight] [list [expr {$hlth + $px + $bw}] [expr {$hlth + $py + $bw + 6 * $fixedHeight}] $fixedWidth $fixedHeight]] test textDisp-4.10 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" .t yview end update .t delete 13.0 end update list [.t index @0,0] $tk_textRelayout $tk_textRedraw } {6.0 {13.0 7.0 6.40 6.20 6.0} {6.0 6.20 6.40 7.0 13.0}} test textDisp-4.11 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around, not once but really quite a few times.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" .t yview end update .t delete 14.0 end update list [.t index @0,0] $tk_textRelayout $tk_textRedraw } {6.60 {14.0 7.0 6.80 6.60} {6.60 6.80 7.0 14.0}} test textDisp-4.12 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16" button .b -text "Test" -bd 2 -highlightthickness 2 .t window create 3.end -window .b .t yview moveto 1 update .t yview moveto 0 update .t yview moveto 1 update winfo ismapped .b } {0} .t configure -wrap word .t delete 1.0 end .t insert end "Line 1\nLine 2\nLine 3\nLine 4\nLine 5\nLine 6\nLine 7\n" .t insert end "Line 8\nLine 9\nLine 10\nLine 11\nLine 12\nLine 13\n" .t insert end "Line 14\nLine 15\nLine 16" .t tag delete x .t tag configure x -relief raised -borderwidth 2 -background white test textDisp-4.13 {UpdateDisplayInfo, special handling for top/bottom lines} { .t tag add x 1.0 end .t yview 1.0 update .t yview scroll 3 units update list $tk_textRelayout $tk_textRedraw } {{11.0 12.0 13.0} {4.0 10.0 11.0 12.0 13.0}} test textDisp-4.14 {UpdateDisplayInfo, special handling for top/bottom lines} { .t tag remove x 1.0 end .t yview 1.0 update .t yview scroll 3 units update list $tk_textRelayout $tk_textRedraw } {{11.0 12.0 13.0} {11.0 12.0 13.0}} test textDisp-4.15 {UpdateDisplayInfo, special handling for top/bottom lines} { .t tag add x 1.0 end .t yview 4.0 update .t yview scroll -2 units update list $tk_textRelayout $tk_textRedraw } {{2.0 3.0} {2.0 3.0 4.0 11.0}} test textDisp-4.16 {UpdateDisplayInfo, special handling for top/bottom lines} { .t tag remove x 1.0 end .t yview 4.0 update .t yview scroll -2 units update list $tk_textRelayout $tk_textRedraw } {{2.0 3.0} {2.0 3.0}} test textDisp-4.17 {UpdateDisplayInfo, horizontal scrolling} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally" .t insert end "\nLine 3\nLine 4" update .t xview scroll 3 units update list $tk_textRelayout $tk_textRedraw [.t bbox 2.0] [.t bbox 2.5] \ [.t bbox 2.23] } [list {} {1.0 2.0 3.0 4.0} {} [list 17 [expr {$fixedDiff + 16}] 7 $fixedHeight] {}] test textDisp-4.18 {UpdateDisplayInfo, horizontal scrolling} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally" .t insert end "\nLine 3\nLine 4" update .t xview scroll 100 units update list $tk_textRelayout $tk_textRedraw [.t bbox 2.25] } [list {} {1.0 2.0 3.0 4.0} [list 10 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-4.19 {UpdateDisplayInfo, horizontal scrolling} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally" .t insert end "\nLine 3\nLine 4" update .t xview moveto 0 .t xview scroll -10 units update list $tk_textRelayout $tk_textRedraw [.t bbox 2.5] } [list {} {1.0 2.0 3.0 4.0} [list 38 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-4.20 {UpdateDisplayInfo, horizontal scrolling} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally" .t insert end "\nLine 3\nLine 4" .t xview moveto 0.0 .t xview scroll 100 units update .t delete 2.30 2.44 update list $tk_textRelayout $tk_textRedraw [.t bbox 2.25] } [list 2.0 {1.0 2.0 3.0 4.0} [list 108 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-4.21 {UpdateDisplayInfo, horizontal scrolling} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally" .t insert end "\nLine 3\nLine 4" .t xview moveto .9 update .t xview moveto .6 update list $tk_textRelayout $tk_textRedraw } {{} {}} test textDisp-4.22 {UpdateDisplayInfo, no horizontal scrolling except for -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally" .t insert end "\nLine 3\nLine 4" .t xview scroll 25 units update .t configure -wrap word list [.t bbox 2.0] [.t bbox 2.16] } [list [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 10 [expr {2*$fixedDiff + 29}] 7 $fixedHeight]] test textDisp-4.23 {UpdateDisplayInfo, no horizontal scrolling except for -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally" .t insert end "\nLine 3\nLine 4" .t xview scroll 25 units update .t configure -wrap char list [.t bbox 2.0] [.t bbox 2.16] } [list [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 115 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-5.1 {DisplayDLine, handling of spacing} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijkl\nmnopqrstuvwzyz" .t tag configure spacing -spacing1 8 -spacing3 2 .t tag add spacing 1.0 end frame .t.f1 -width 10 -height 4 -bg black frame .t.f2 -width 10 -height 4 -bg black frame .t.f3 -width 10 -height 4 -bg black frame .t.f4 -width 10 -height 4 -bg black .t window create 1.3 -window .t.f1 -align top .t window create 1.7 -window .t.f2 -align center .t window create 2.1 -window .t.f3 -align bottom .t window create 2.10 -window .t.f4 -align baseline update list [winfo geometry .t.f1] [winfo geometry .t.f2] \ [winfo geometry .t.f3] [winfo geometry .t.f4] } [list 10x4+24+11 10x4+55+[expr {$fixedDiff/2 + 15}] 10x4+10+[expr {2*$fixedDiff + 43}] 10x4+76+[expr {2*$fixedDiff + 40}]] .t tag delete spacing # Although the following test produces a useful result, its main # effect is to produce a core dump if Tk doesn't handle display # relayout that occurs during redisplay. test textDisp-5.2 {DisplayDLine, line resizes during display} { .t delete 1.0 end frame .t.f -width 20 -height 20 -bd 2 -relief raised bind .t.f {.t.f configure -width 30 -height 30} .t window create insert -window .t.f update list [winfo width .t.f] [winfo height .t.f] } [list 30 30] .t configure -wrap char test textDisp-6.1 {scrolling in DisplayText, scroll up} { .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 2.0 3.0 update list $tk_textRelayout $tk_textRedraw } {{2.0 10.0} {2.0 10.0}} test textDisp-6.2 {scrolling in DisplayText, scroll down} { .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t insert 2.0 "New Line 2\n" update list $tk_textRelayout $tk_textRedraw } {{2.0 3.0} {2.0 3.0}} test textDisp-6.3 {scrolling in DisplayText, multiple scrolls} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t insert 2.end "is so long that it wraps" .t insert 4.end "is so long that it wraps" update list $tk_textRelayout $tk_textRedraw } {{2.0 2.20 4.0 4.20} {2.0 2.20 4.0 4.20}} test textDisp-6.4 {scrolling in DisplayText, scrolls interfere} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t insert 2.end "is so long that it wraps around, not once but three times" .t insert 4.end "is so long that it wraps" update list $tk_textRelayout $tk_textRedraw } {{2.0 2.20 2.40 2.60 4.0 4.20} {2.0 2.20 2.40 2.60 4.0 4.20 6.0}} test textDisp-6.5 {scrolling in DisplayText, scroll source obscured} {nonPortable} { .t configure -wrap char frame .f2 -bg red place .f2 -in .t -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5 .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 1.6 1.end update destroy .f2 list $tk_textRelayout $tk_textRedraw } {{1.0 9.0 10.0} {1.0 4.0 5.0 9.0 10.0}} test textDisp-6.6 {scrolling in DisplayText, Expose events after scroll} {unix nonPortable} { # this test depends on all of the expose events being handled at once .t configure -wrap char frame .f2 -bg #ff0000 place .f2 -in .t -relx 0.2 -rely 0.5 -relwidth 0.5 -relheight 0.5 .t configure -bd 2 -relief raised .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 1.6 1.end destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{1.0 9.0 10.0} {borders 1.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0}} .t configure -bd 0 test textDisp-6.7 {DisplayText, vertical scrollbar updates} { .t configure -wrap char .t delete 1.0 end update ; .t count -update -ypixels 1.0 end ; update set scrollInfo } {0.0 1.0} test textDisp-6.8 {DisplayText, vertical scrollbar updates} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" update set scrollInfo "unchanged" foreach i {2 3 4 5 6 7 8 9 10 11 12 13} { .t insert end "\nLine $i" } update ; .t count -update -ypixels 1.0 end ; update set scrollInfo } [list 0.0 [expr {10.0/13}]] .t configure -yscrollcommand {} -xscrollcommand scroll test textDisp-6.9 {DisplayText, horizontal scrollbar updates} { .t configure -wrap none .t delete 1.0 end update set scrollInfo unchanged .t insert end xxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx update set scrollInfo } [list 0.0 [expr {4.0/11}]] # The following group of tests is marked non-portable because # they result in a lot of extra redisplay under Ultrix. I don't # know why this is so. .t configure -bd 2 -relief raised -wrap char .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } test textDisp-7.1 {TkTextRedrawRegion} {nonPortable} { frame .f2 -bg #ff0000 place .f2 -in .t -relx 0.2 -relwidth 0.6 -rely 0.22 -relheight 0.55 update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {1.40 2.0 3.0 4.0 5.0 6.0}} test textDisp-7.2 {TkTextRedrawRegion} {nonPortable} { frame .f2 -bg #ff0000 place .f2 -in .t -relx 0 -relwidth 0.5 -rely 0 -relheight 0.5 update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {borders 1.0 1.20 1.40 2.0 3.0}} test textDisp-7.3 {TkTextRedrawRegion} {nonPortable} { frame .f2 -bg #ff0000 place .f2 -in .t -relx 0.5 -relwidth 0.5 -rely 0.5 -relheight 0.5 update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {borders 4.0 5.0 6.0 7.0 8.0}} test textDisp-7.4 {TkTextRedrawRegion} {nonPortable} { frame .f2 -bg #ff0000 place .f2 -in .t -relx 0.4 -relwidth 0.2 -rely 0 -relheight 0.2 \ -bordermode ignore update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {borders 1.0 1.20}} test textDisp-7.5 {TkTextRedrawRegion} {nonPortable} { frame .f2 -bg #ff0000 place .f2 -in .t -relx 0.4 -relwidth 0.2 -rely 1.0 -relheight 0.2 \ -anchor s -bordermode ignore update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {borders 7.0 8.0}} test textDisp-7.6 {TkTextRedrawRegion} {nonPortable} { frame .f2 -bg #ff0000 place .f2 -in .t -relx 0 -relwidth 0.2 -rely 0.55 -relheight 0.2 \ -anchor w -bordermode ignore update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {borders 3.0 4.0 5.0}} test textDisp-7.7 {TkTextRedrawRegion} {nonPortable} { frame .f2 -bg #ff0000 place .f2 -in .t -relx 1.0 -relwidth 0.2 -rely 0.55 -relheight 0.2 \ -anchor e -bordermode ignore update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {borders 3.0 4.0 5.0}} test textDisp-7.8 {TkTextRedrawRegion} {nonPortable} { .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2\nLine 3\nLine 4\nLine 5\nLine 6\n" frame .f2 -bg #ff0000 place .f2 -in .t -relx 0.0 -relwidth 0.4 -rely 0.35 -relheight 0.4 \ -anchor nw -bordermode ignore update destroy .f2 update list $tk_textRelayout $tk_textRedraw } {{} {borders 4.0 5.0 6.0 7.0 eof}} .t configure -bd 0 test textDisp-8.1 {TkTextChanged: redisplay whole lines} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is so long that it wraps around, two times" foreach i {3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 2.36 2.38 update list $tk_textRelayout $tk_textRedraw [.t bbox 2.32] } [list {2.0 2.18 2.38} {2.0 2.18 2.38} [list 101 [expr {2*$fixedDiff + 29}] 7 $fixedHeight]] .t configure -wrap char test textDisp-8.2 {TkTextChanged, redisplay whole lines} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t insert 1.2 xx update list $tk_textRelayout $tk_textRedraw } {{1.0 1.20 1.40} {1.0 1.20 1.40}} test textDisp-8.3 {TkTextChanged} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t insert 2.0 xx update list $tk_textRelayout $tk_textRedraw } {2.0 2.0} test textDisp-8.4 {TkTextChanged} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 1.5 update list $tk_textRelayout $tk_textRedraw } {{1.0 1.20 1.40} {1.0 1.20 1.40}} test textDisp-8.5 {TkTextChanged} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 1.40 1.44 update list $tk_textRelayout $tk_textRedraw } {{1.0 1.20 1.40} {1.0 1.20 1.40}} test textDisp-8.6 {TkTextChanged} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 1.41 1.44 update list $tk_textRelayout $tk_textRedraw } {{1.0 1.20 1.40} {1.0 1.20 1.40}} test textDisp-8.7 {TkTextChanged} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 1.2 1.end update list $tk_textRelayout $tk_textRedraw } {{1.0 9.0 10.0} {1.0 9.0 10.0}} test textDisp-8.8 {TkTextChanged} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 2.2 update list $tk_textRelayout $tk_textRedraw } {2.0 2.0} test textDisp-8.9 {TkTextChanged} { .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, two times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } update .t delete 2.0 3.0 update list $tk_textRelayout $tk_textRedraw } {{2.0 8.0} {2.0 8.0}} test textDisp-8.10 {TkTextChanged} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" .t tag add big 2.19 update .t delete 2.19 update set tk_textRedraw } {2.0 2.20 eof} test textDisp-8.11 {TkTextChanged, scrollbar notification when changes are off-screen} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n" .t configure -yscrollcommand scroll update set scrollInfo "" .t insert end "a\nb\nc\n" # We need to wait for our asychronous callbacks to update the # scrollbar update ; .t count -update -ypixels 1.0 end ; update .t configure -yscrollcommand "" set scrollInfo } {0.0 0.625} test textDisp-8.12 {TkTextChanged, moving the insert cursor redraws only past and new lines} { .t delete 1.0 end .t configure -wrap none for {set i 1} {$i < 25} {incr i} { .t insert end "Line $i Line $i\n" } .t tag add hidden 5.0 8.0 .t tag configure hidden -elide true .t mark set insert 9.0 update .t mark set insert 8.0 ; # up one line update set res [list $tk_textRedraw] .t mark set insert 12.2 ; # in the visible text update lappend res $tk_textRedraw .t mark set insert 6.5 ; # in the hidden text update lappend res $tk_textRedraw .t mark set insert 3.5 ; # in the visible text again update lappend res $tk_textRedraw .t mark set insert 3.8 ; # within the same line update lappend res $tk_textRedraw } {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {3.0 4.0}} test textDisp-8.13 {TkTextChanged, used to crash, see [06c1433906]} { .t delete 1.0 end .t insert 1.0 \nLine2\nLine3\n update .t insert 3.0 "" .t delete 1.0 2.0 update idletasks } {} test textDisp-9.1 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 2.2 2.4 update list $tk_textRelayout $tk_textRedraw } {{2.0 2.18} {2.0 2.18}} test textDisp-9.2 {TkTextRedrawTag} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 1.2 2.4 update list $tk_textRelayout $tk_textRedraw } {{1.0 2.0 2.17} {1.0 2.0 2.17}} test textDisp-9.3 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 2.2 2.4 update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw } {{2.0 2.20} {2.0 2.20 eof}} test textDisp-9.4 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 2.2 2.20 update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw } {{2.0 2.20} {2.0 2.20 eof}} test textDisp-9.5 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4" update .t tag add big 2.2 2.end update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw } {{2.0 2.20} {2.0 2.20 eof}} test textDisp-9.6 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap" update .t tag add big 2.2 3.5 update .t tag remove big 1.0 end update list $tk_textRelayout $tk_textRedraw } {{2.0 2.20 3.0 3.20} {2.0 2.20 3.0 3.20 eof}} test textDisp-9.7 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" .t tag add big 2.19 update .t tag remove big 2.19 update set tk_textRedraw } {2.0 2.20 eof} test textDisp-9.8 {TkTextRedrawTag} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" .t tag add big 1.0 2.0 update .t tag add big 2.0 2.5 update set tk_textRedraw } {2.0 2.17} test textDisp-9.9 {TkTextRedrawTag} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" .t tag add big 1.0 2.0 update .t tag add big 1.5 2.5 update set tk_textRedraw } {2.0 2.17} test textDisp-9.10 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" .t tag add big 1.0 2.0 update set tk_textRedraw {none} .t tag add big 1.3 1.5 update set tk_textRedraw } {none} test textDisp-9.11 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" .t tag add big 1.0 2.0 update .t tag add big 1.0 2.0 update set tk_textRedraw } {} test textDisp-9.12 {TkTextRedrawTag} { .t configure -wrap char .t delete 1.0 end for {set i 1} {$i < 5} {incr i} { .t insert end "Line $i+++Line $i\n" } .t tag configure hidden -elide true .t tag add hidden 2.6 3.6 update .t tag add hidden 3.11 4.6 update list $tk_textRelayout $tk_textRedraw } {2.0 {2.0 eof}} test textDisp-9.13 {TkTextRedrawTag} { .t configure -wrap none .t delete 1.0 end for {set i 1} {$i < 10} {incr i} { .t insert end "Line $i - This is Line [format %c [expr 64+$i]]\n" } .t tag add hidden 2.8 2.17 .t tag add hidden 6.8 7.17 .t tag configure hidden -background red .t tag configure hidden -elide true update .t tag configure hidden -elide false update list $tk_textRelayout $tk_textRedraw } {{2.0 6.0 7.0} {2.0 6.0 7.0}} test textDisp-9.14 {TkTextRedrawTag} { pack [text .tnocrash] for {set i 1} {$i < 6} {incr i} { .tnocrash insert end \nfoo$i } .tnocrash tag configure mytag1 -relief raised .tnocrash tag configure mytag2 -relief solid update proc doit {} { .tnocrash tag add mytag1 4.0 5.0 .tnocrash tag add mytag2 4.0 5.0 after idle { .tnocrash tag remove mytag1 1.0 end .tnocrash tag remove mytag2 1.0 end } .tnocrash delete 1.0 2.0 } doit ; # must not crash after 500 { destroy .tnocrash set done 1 } vwait done } {} test textDisp-10.1 {TkTextRelayoutWindow} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" update .t configure -bg black update list $tk_textRelayout $tk_textRedraw } {{1.0 2.0 2.20 3.0 3.20 4.0} {borders 1.0 2.0 2.20 3.0 3.20 4.0 eof}} .t configure -bg [lindex [.t configure -bg] 3] catch {destroy .top} test textDisp-10.2 {TkTextRelayoutWindow} { toplevel .top -width 300 -height 200 wm geometry .top +0+0 text .top.t -font $fixedFont -width 20 -height 10 -relief raised -bd 2 place .top.t -x 0 -y 0 -width 20 -height 20 .top.t insert end "First line" .top.t see insert tkwait visibility .top.t place .top.t -width 150 -height 100 update .top.t index @0,0 } {1.0} catch {destroy .top} .t delete 1.0 end .t insert end "Line 1" for {set i 2} {$i <= 200} {incr i} { .t insert end "\nLine $i" } update test textDisp-11.1 {TkTextSetYView} { .t yview 30.0 update .t index @0,0 } {30.0} test textDisp-11.2 {TkTextSetYView} { .t yview 30.0 update .t yview 32.0 update list [.t index @0,0] $tk_textRedraw } {32.0 {40.0 41.0}} test textDisp-11.3 {TkTextSetYView} { .t yview 30.0 update .t yview 28.0 update list [.t index @0,0] $tk_textRedraw } {28.0 {28.0 29.0}} test textDisp-11.4 {TkTextSetYView} { .t yview 30.0 update .t yview 31.4 update list [.t index @0,0] $tk_textRedraw } {31.0 40.0} test textDisp-11.5 {TkTextSetYView} { .t yview 30.0 update set tk_textRedraw {} .t yview -pickplace 31.0 update list [.t index @0,0] $tk_textRedraw } {30.0 {}} test textDisp-11.6 {TkTextSetYView} { .t yview 30.0 update set tk_textRedraw {} .t yview -pickplace 28.0 update list [.t index @0,0] $tk_textRedraw } {28.0 {28.0 29.0}} test textDisp-11.7 {TkTextSetYView} { .t yview 30.0 update ; update set tk_textRedraw {} .t yview -pickplace 26.0 update list [.t index @0,0] $tk_textRedraw } {21.0 {21.0 22.0 23.0 24.0 25.0 26.0 27.0 28.0 29.0}} test textDisp-11.8 {TkTextSetYView} { .t yview 30.0 update set tk_textRedraw {} .t yview -pickplace 41.0 update list [.t index @0,0] $tk_textRedraw } {32.0 {40.0 41.0}} test textDisp-11.9 {TkTextSetYView} { .t yview 30.0 update set tk_textRedraw {} .t yview -pickplace 43.0 update list [.t index @0,0] $tk_textRedraw } {38.0 {40.0 41.0 42.0 43.0 44.0 45.0 46.0 47.0 48.0}} test textDisp-11.10 {TkTextSetYView} { .t yview 30.0 update set tk_textRedraw {} .t yview 10000.0 update list [.t index @0,0] $tk_textRedraw } {191.0 {191.0 192.0 193.0 194.0 195.0 196.0 197.0 198.0 199.0 200.0}} test textDisp-11.11 {TkTextSetYView} { .t yview 195.0 update set tk_textRedraw {} .t yview 197.0 update list [.t index @0,0] $tk_textRedraw } {191.0 {191.0 192.0 193.0 194.0 195.0 196.0}} test textDisp-11.12 {TkTextSetYView, wrapped line is off-screen} { .t insert 10.0 "Long line with enough text to wrap\n" .t yview 1.0 update set tk_textRedraw {} .t see 10.30 update list [.t index @0,0] $tk_textRedraw } {2.0 10.20} .t delete 10.0 11.0 test textDisp-11.13 {TkTestSetYView, partially visible last line} { catch {destroy .top} toplevel .top wm geometry .top +0+0 text .top.t -width 20 -height 5 pack .top.t .top.t insert end "Line 1" for {set i 2} {$i <= 100} {incr i} { .top.t insert end "\nLine $i" } update scan [wm geometry .top] "%dx%d" w2 h2 wm geometry .top ${w2}x[expr $h2-2] update .top.t yview 1.0 update set tk_textRedraw {} .top.t see 5.0 update # Note, with smooth scrolling, the results of this test # have changed, and the old '2.0 {5.0 6.0}' is quite wrong. list [.top.t index @0,0] $tk_textRedraw } {1.0 5.0} catch {destroy .top} toplevel .top wm geometry .top +0+0 text .top.t -width 30 -height 3 pack .top.t .top.t insert end "Line 1" for {set i 2} {$i <= 20} {incr i} { .top.t insert end "\nLine $i" } update test textDisp-11.14 {TkTextSetYView, only a few lines visible} { .top.t yview 5.0 update .top.t see 10.0 .top.t index @0,0 } {8.0} test textDisp-11.15 {TkTextSetYView, only a few lines visible} { .top.t yview 5.0 update .top.t see 11.0 .top.t index @0,0 # The index 9.0 should be just visible by a couple of pixels } {9.0} test textDisp-11.16 {TkTextSetYView, only a few lines visible} { .top.t yview 8.0 update .top.t see 5.0 .top.t index @0,0 } {5.0} test textDisp-11.17 {TkTextSetYView, only a few lines visible} { .top.t yview 8.0 update .top.t see 4.0 .top.t index @0,0 # The index 2.0 should be just visible by a couple of pixels } {2.0} test textDisp-11.18 {TkTextSetYView, see in elided lines} { .top.t delete 1.0 end for {set i 1} {$i < 20} {incr i} { .top.t insert end [string repeat "Line $i" 10] .top.t insert end "\n" } .top.t yview 4.0 .top.t tag add hidden 4.10 "4.10 lineend" .top.t tag add hidden 5.15 10.3 .top.t tag configure hidden -elide true update .top.t see "8.0 lineend" # The index "8.0 lineend" is on screen despite elided -> no scroll .top.t index @0,0 } {4.0} test textDisp-11.19 {TkTextSetYView, see in elided lines} { .top.t delete 1.0 end for {set i 1} {$i < 50} {incr i} { .top.t insert end "Line $i\n" } # button just for having a line with a larger height button .top.t.b -text "Test" -bd 2 -highlightthickness 2 .top.t window create 21.0 -window .top.t.b .top.t tag add hidden 15.36 21.0 .top.t tag configure hidden -elide true .top.t configure -height 15 wm geometry .top 300x200+0+0 # Indices 21.0, 17.0 and 15.0 are all on the same display line # therefore index @0,0 shall be the same for all of them .top.t see end update .top.t see 21.0 update set ind1 [.top.t index @0,0] .top.t see end update .top.t see 17.0 update set ind2 [.top.t index @0,0] .top.t see end update .top.t see 15.0 update set ind3 [.top.t index @0,0] list [expr {$ind1 == $ind2}] [expr {$ind1 == $ind3}] } {1 1} test textDisp-11.20 {TkTextSetYView, see in elided lines} { .top.t delete 1.0 end .top.t configure -wrap none for {set i 1} {$i < 5} {incr i} { .top.t insert end [string repeat "Line $i " 50] .top.t insert end "\n" } .top.t delete 3.11 3.14 .top.t tag add hidden 3.0 4.0 # this shall not crash (null chunkPtr in TkTextSeeCmd is tested) .top.t see 3.0 } {} test textDisp-11.21 {TkTextSetYView, window height smaller than the line height} { .top.t delete 1.0 end for {set i 1} {$i <= 10} {incr i} { .top.t insert end "Line $i\n" } set lineheight [font metrics [.top.t cget -font] -linespace] wm geometry .top 200x[expr {$lineheight / 2}] update .top.t see 1.0 .top.t index @0,[expr {$lineheight - 2}] } {1.0} .t configure -wrap word .t delete 50.0 51.0 .t insert 50.0 "This is a long line, one that will wrap around twice.\n" test textDisp-12.1 {MeasureUp} { .t yview 100.0 update .t yview -pickplace 52.0 update .t index @0,0 } {49.0} test textDisp-12.2 {MeasureUp} { .t yview 100.0 update .t yview -pickplace 53.0 update .t index @0,0 } {50.0} test textDisp-12.3 {MeasureUp} { .t yview 100.0 update .t yview -pickplace 50.10 update .t index @0,0 } {45.0} .t configure -wrap none test textDisp-12.4 {MeasureUp} { .t yview 100.0 update .t yview -pickplace 53.0 update .t index @0,0 } {48.0} test textDisp-12.5 {MeasureUp} { .t yview 100.0 update .t yview -pickplace 50.10 update .t index @0,0 } {45.0} .t configure -wrap none .t delete 1.0 end for {set i 1} {$i < 99} {incr i} { .t insert end "Line $i\n" } .t insert end "Line 100" .t insert 30.end { is quite long, so that it flows way off the end of the window and we can use it to test out the horizontal positioning features of the "see" command.} test textDisp-13.1 {TkTextSeeCmd procedure} { list [catch {.t see} msg] $msg } {1 {wrong # args: should be ".t see index"}} test textDisp-13.2 {TkTextSeeCmd procedure} { list [catch {.t see a b} msg] $msg } {1 {wrong # args: should be ".t see index"}} test textDisp-13.3 {TkTextSeeCmd procedure} { list [catch {.t see badIndex} msg] $msg } {1 {bad text index "badIndex"}} test textDisp-13.4 {TkTextSeeCmd procedure} { .t xview moveto 0 .t yview moveto 0 update .t see 4.2 .t index @0,0 } {1.0} test textDisp-13.5 {TkTextSeeCmd procedure} { .t configure -wrap char .t xview moveto 0 .t yview moveto 0 update .t see 12.1 .t index @0,0 } {3.0} test textDisp-13.6 {TkTextSeeCmd procedure} { .t configure -wrap char .t xview moveto 0 .t yview moveto 0 update .t see 30.50 set x [.t index @0,0] .t configure -wrap none set x } {27.0} test textDisp-13.7 {TkTextSeeCmd procedure} {textfonts} { .t xview moveto 0 .t yview moveto 0 .t tag add sel 30.20 .t tag add sel 30.40 update .t see 30.50 .t yview 25.0 .t see 30.50 set x [list [.t bbox 30.50]] .t see 30.39 lappend x [.t bbox 30.39] .t see 30.38 lappend x [.t bbox 30.38] .t see 30.20 lappend x [.t bbox 30.20] } [list [list 73 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 3 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 3 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 73 [expr {5*$fixedDiff + 68}] 7 $fixedHeight]] test textDisp-13.8 {TkTextSeeCmd procedure} {textfonts} { .t xview moveto 0 .t yview moveto 0 .t tag add sel 30.20 .t tag add sel 30.50 update .t see 30.50 set x [list [.t bbox 30.50]] .t see 30.60 lappend x [.t bbox 30.60] .t see 30.65 lappend x [.t bbox 30.65] .t see 30.90 lappend x [.t bbox 30.90] } [list [list 73 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 73 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight]] test textDisp-13.9 {TkTextSeeCmd procedure} {textfonts} { wm geom . [expr $width-2]x$height .t xview moveto 0 .t yview moveto 0 .t tag add sel 30.20 .t tag add sel 30.50 update .t see 30.50 set x [list [.t bbox 30.50]] .t see 30.60 lappend x [.t bbox 30.60] .t see 30.65 lappend x [.t bbox 30.65] .t see 30.90 lappend x [.t bbox 30.90] } [list [list 74 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 138 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 138 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 74 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight]] test textDisp-13.10 {TkTextSeeCmd procedure} {} { # SF Bug 641778 set w .tsee destroy $w text $w -font {Helvetica 8 normal} -bd 16 $w insert end Hello $w see end set res [$w bbox end] destroy $w set res } {} test textDisp-13.11 {TkTextSeeCmd procedure} {} { # insertion of a character at end of a line containing multi-byte # characters and calling see at the line end shall actually show # this character toplevel .top2 pack [text .top2.t2 -wrap none] for {set i 1} {$i < 5} {incr i} { .top2.t2 insert end [string repeat "Line $i: éèàçù" 5]\n } wm geometry .top2 300x200+0+0 update .top2.t2 see "1.0 lineend" update set ref [.top2.t2 index @0,0] .top2.t2 insert "1.0 lineend" ç .top2.t2 see "1.0 lineend" update set new [.top2.t2 index @0,0] set res [.top2.t2 compare $ref == $new] destroy .top2 set res } {0} wm geom . {} .t configure -wrap none test textDisp-14.1 {TkTextXviewCmd procedure} { .t delete 1.0 end update .t insert end xxxxxxxxx\n .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto .5 .t xview } [list 0.5 [expr {6./7.}]] .t configure -wrap char test textDisp-14.2 {TkTextXviewCmd procedure} { .t delete 1.0 end update .t insert end xxxxxxxxx\n .t insert end "xxxxx\n" .t insert end "xxxx" .t xview } {0.0 1.0} .t configure -wrap none test textDisp-14.3 {TkTextXviewCmd procedure} { .t delete 1.0 end update .t insert end xxxxxxxxx\n .t insert end "xxxxx\n" .t insert end "xxxx" .t xview } {0.0 1.0} test textDisp-14.4 {TkTextXviewCmd procedure} { list [catch {.t xview moveto} msg] $msg } {1 {wrong # args: should be ".t xview moveto fraction"}} test textDisp-14.5 {TkTextXviewCmd procedure} { list [catch {.t xview moveto a b} msg] $msg } {1 {wrong # args: should be ".t xview moveto fraction"}} test textDisp-14.6 {TkTextXviewCmd procedure} { list [catch {.t xview moveto a} msg] $msg } {1 {expected floating-point number but got "a"}} test textDisp-14.7 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto .3 .t xview } [list [expr {118.0/392}] [expr {258.0/392}]] test textDisp-14.8 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto -.4 .t xview } [list 0.0 [expr {5.0/14}]] test textDisp-14.9 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview m 1.4 .t xview } [list [expr {9.0/14}] 1.0] test textDisp-14.10 {TkTextXviewCmd procedure} { list [catch {.t xview scroll a} msg] $msg } {1 {wrong # args: should be ".t xview scroll number units|pages|pixels"}} test textDisp-14.11 {TkTextXviewCmd procedure} { list [catch {.t xview scroll a b c} msg] $msg } {1 {wrong # args: should be ".t xview scroll number units|pages|pixels"}} test textDisp-14.12 {TkTextXviewCmd procedure} { list [catch {.t xview scroll gorp units} msg] $msg } {1 {expected integer but got "gorp"}} test textDisp-14.13 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end "a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto 0 .t xview scroll 2 pa set x [.t index @0,22] .t xview scroll -1 pa lappend x [.t index @0,22] .t xview scroll -2 pages lappend x [.t index @0,22] } {2.36 2.18 2.0} test textDisp-14.14 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end "a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto 0 .t xview scroll 21 u set x [.t index @0,22] .t xview scroll -1 u lappend x [.t index @0,22] .t xview scroll 100 units lappend x [.t index @0,22] .t xview scroll -15 units lappend x [.t index @0,22] } {2.21 2.20 2.99 2.84} test textDisp-14.15 {TkTextXviewCmd procedure} { list [catch {.t xview scroll 14 globs} msg] $msg } {1 {bad argument "globs": must be units, pages, or pixels}} test textDisp-14.16 {TkTextXviewCmd procedure} { list [catch {.t xview flounder} msg] $msg } {1 {bad option "flounder": must be moveto or scroll}} .t configure -wrap char .t delete 1.0 end for {set i 1} {$i < 99} {incr i} { .t insert end "Line $i\n" } .t insert end "Line 100" .t delete 50.0 51.0 .t insert 50.0 "This is a long line, one that will wrap around twice.\n" test textDisp-15.1 {ScrollByLines procedure, scrolling backwards} { .t yview 45.0 update .t yview scroll -3 units .t index @0,0 } {42.0} test textDisp-15.2 {ScrollByLines procedure, scrolling backwards} { .t yview 51.0 update .t yview scroll -2 units .t index @0,0 } {50.20} test textDisp-15.3 {ScrollByLines procedure, scrolling backwards} { .t yview 51.0 update .t yview scroll -4 units .t index @0,0 } {49.0} test textDisp-15.4 {ScrollByLines procedure, scrolling backwards} { .t yview 50.20 update .t yview scroll -2 units .t index @0,0 } {49.0} test textDisp-15.5 {ScrollByLines procedure, scrolling backwards} { .t yview 50.40 update .t yview scroll -2 units .t index @0,0 } {50.0} test textDisp-15.6 {ScrollByLines procedure, scrolling backwards} { .t yview 3.2 update .t yview scroll -5 units .t index @0,0 } {1.0} test textDisp-15.7 {ScrollByLines procedure, scrolling forwards} { .t yview 48.0 update .t yview scroll 4 units .t index @0,0 } {50.40} test textDisp-15.8 {Scrolling near end of window} { set textheight 12 set textwidth 30 toplevel .tf frame .tf.f -relief sunken -borderwidth 2 pack .tf.f -padx 10 -pady 10 text .tf.f.t -font {Courier 9} -height $textheight \ -width $textwidth -yscrollcommand ".tf.f.sb set" scrollbar .tf.f.sb -command ".tf.f.t yview" pack .tf.f.t -side left -expand 1 -fill both pack .tf.f.sb -side right -fill y .tf.f.t tag configure Header -font {Helvetica 14 bold italic} \ -wrap word -spacing1 12 -spacing3 4 .tf.f.t insert end "Foo" Header for {set i 1} {$i < $textheight} {incr i} { .tf.f.t insert end "\nLine $i" } update ; after 1000 ; update # Should scroll and should not crash! .tf.f.t yview scroll 1 unit # Check that it has scrolled set res [.tf.f.t index @0,[expr [winfo height .tf.f.t] - 15]] destroy .tf set res } {12.0} .t configure -wrap char .t delete 1.0 end .t insert insert "Line 1" for {set i 2} {$i <= 200} {incr i} { .t insert end "\nLine $i" } .t tag add big 100.0 105.0 .t insert 151.end { has a lot of extra text, so that it wraps around on the screen several times over.} .t insert 153.end { also has enoug extra text to wrap.} update ; .t count -update -ypixels 1.0 end test textDisp-16.1 {TkTextYviewCmd procedure} { .t yview 21.0 set x [.t yview] .t yview 1.0 list [expr {int([lindex $x 0]*100)}] [expr {int ([lindex $x 1] * 100)}] } {9 14} test textDisp-16.2 {TkTextYviewCmd procedure} { list [catch {.t yview 2 3} msg] $msg } {1 {bad option "2": must be moveto or scroll}} test textDisp-16.3 {TkTextYviewCmd procedure} { list [catch {.t yview -pickplace} msg] $msg } {1 {wrong # args: should be ".t yview -pickplace lineNum|index"}} test textDisp-16.4 {TkTextYviewCmd procedure} { list [catch {.t yview -pickplace 2 3} msg] $msg } {1 {wrong # args: should be ".t yview -pickplace lineNum|index"}} test textDisp-16.5 {TkTextYviewCmd procedure} { list [catch {.t yview -bogus 2} msg] $msg } {1 {bad option "-bogus": must be moveto or scroll}} test textDisp-16.6 {TkTextYviewCmd procedure, integer position} { .t yview 100.0 update .t yview 98 .t index @0,0 } {99.0} test textDisp-16.7 {TkTextYviewCmd procedure} { .t yview 2.0 .t yv -pickplace 13.0 .t index @0,0 } {4.0} test textDisp-16.8 {TkTextYviewCmd procedure} { list [catch {.t yview bad_mark_name} msg] $msg } {1 {bad text index "bad_mark_name"}} test textDisp-16.9 {TkTextYviewCmd procedure, "moveto" option} { list [catch {.t yview moveto a b} msg] $msg } {1 {wrong # args: should be ".t yview moveto fraction"}} test textDisp-16.10 {TkTextYviewCmd procedure, "moveto" option} { list [catch {.t yview moveto gorp} msg] $msg } {1 {expected floating-point number but got "gorp"}} test textDisp-16.11 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto 0.5 .t index @0,0 } {103.0} test textDisp-16.12 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto -1 .t index @0,0 } {1.0} test textDisp-16.13 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto 1.1 .t index @0,0 } {191.0} test textDisp-16.14 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto .75 .t index @0,0 } {151.60} test textDisp-16.15 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto .752 .t index @0,0 } {151.60} test textDisp-16.16 {TkTextYviewCmd procedure, "moveto" option} {textfonts} { set count [expr {5 * $bigHeight + 150 * $fixedHeight}] set extra [expr {0.04 * double($fixedDiff * 150) / double($count)}] .t yview moveto [expr {.753 - $extra}] .t index @0,0 } {151.60} test textDisp-16.17 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto .755 .t index @0,0 } {151.80} test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {textfonts} { catch {destroy .top1} toplevel .top1 wm geometry .top1 +0+0 text .top1.t -height 3 -width 4 -wrap none -setgrid 1 -padx 6 \ -spacing3 6 pack .top1.t update .top1.t insert end "1\n2\n3\n4\n5\n6" .top1.t yview moveto 0.3333 set result [.top1.t yview] destroy .top1 set result } [list [expr {1.0/3}] [expr {5.0/6}]] test textDisp-16.19 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll a} msg] $msg } {1 {wrong # args: should be ".t yview scroll number units|pages|pixels"}} test textDisp-16.20 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll a b c} msg] $msg } {1 {wrong # args: should be ".t yview scroll number units|pages|pixels"}} test textDisp-16.21 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll badInt bogus} msg] $msg } {1 {bad argument "bogus": must be units, pages, or pixels}} test textDisp-16.21.2 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll badInt units} msg] $msg } {1 {expected integer but got "badInt"}} test textDisp-16.22 {TkTextYviewCmd procedure, "scroll" option, back pages} { .t yview 50.0 update .t yview scroll -1 pages .t index @0,0 } {42.0} test textDisp-16.22.1 {TkTextYviewCmd procedure, "scroll" option, back pages} { list [catch {.t yview scroll -3 p} res] $res } {1 {ambiguous argument "p": must be units, pages, or pixels}} test textDisp-16.23 {TkTextYviewCmd procedure, "scroll" option, back pages} { .t yview 50.0 update .t yview scroll -3 pa .t index @0,0 } {26.0} test textDisp-16.24 {TkTextYviewCmd procedure, "scroll" option, back pages} { .t yview 5.0 update .t yview scroll -3 pa .t index @0,0 } {1.0} test textDisp-16.25 {TkTextYviewCmd procedure, "scroll" option, back pages} { .t configure -height 1 update .t yview 50.0 update .t yview scroll -1 pages set x [.t index @0,0] .t configure -height 10 update set x } {49.0} test textDisp-16.26 {TkTextYviewCmd procedure, "scroll" option, forward pages} { .t yview 50.0 update .t yview scroll 1 pages .t index @0,0 } {58.0} test textDisp-16.27 {TkTextYviewCmd procedure, "scroll" option, forward pages} { .t yview 50.0 update .t yview scroll 2 pages .t index @0,0 } {66.0} test textDisp-16.28 {TkTextYviewCmd procedure, "scroll" option, forward pages} {textfonts} { .t yview 98.0 update .t yview scroll 1 page set res [expr int([.t index @0,0])] if {$fixedDiff > 1} { incr res -1 } set res } {102} test textDisp-16.29 {TkTextYviewCmd procedure, "scroll" option, forward pages} { .t configure -height 1 update .t yview 50.0 update .t yview scroll 1 pages set x [.t index @0,0] .t configure -height 10 update set x } {51.0} test textDisp-16.30 {TkTextYviewCmd procedure, "scroll units" option} { .t yview 45.0 update .t yview scroll -3 units .t index @0,0 } {42.0} test textDisp-16.31 {TkTextYviewCmd procedure, "scroll units" option} { .t yview 149.0 update .t yview scroll 4 units .t index @0,0 } {151.40} test textDisp-16.32 {TkTextYviewCmd procedure} { list [catch {.t yview scroll 12 bogoids} msg] $msg } {1 {bad argument "bogoids": must be units, pages, or pixels}} test textDisp-16.33 {TkTextYviewCmd procedure} { list [catch {.t yview bad_arg 1 2} msg] $msg } {1 {bad option "bad_arg": must be moveto or scroll}} test textDisp-16.34 {TkTextYviewCmd procedure} { set res {} .t yview 1.0 lappend res [format %.12g [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]] .t yview scroll 1 pixels lappend res [format %.12g [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]] .t yview scroll 1 pixels lappend res [format %.12g [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]] .t yview scroll 1 pixels lappend res [format %.12g [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]] .t yview scroll 1 pixels lappend res [format %.12g [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]] .t yview scroll 1 pixels lappend res [format %.12g [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]] } {0 1 2 3 4 5} test textDisp-16.35 {TkTextYviewCmd procedure} { set res {} .t yview 1.0 lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] .t yview scroll 13 pixels lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] .t yview scroll -4 pixels lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] .t yview scroll -9 pixels lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] } {0 13 9 0} test textDisp-16.36 {TkTextYviewCmd procedure} { set res {} .t yview 1.0 .t yview scroll 5 pixels .t yview scroll -1 pages lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}] .t yview scroll 5 pixels .t yview scroll -1 units lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}] } {0.0 0.0} test textDisp-16.37 {TkTextYviewCmd procedure} { list [catch {.t yview scroll 1.3 pixels} msg] $msg } {0 {}} test textDisp-16.38 {TkTextYviewCmd procedure} { list [catch {.t yview scroll 1.3blah pixels} msg] $msg } {1 {bad screen distance "1.3blah"}} test textDisp-16.39 {TkTextYviewCmd procedure} { list [catch {.t yview scroll 1.3i pixels} msg] $msg } {0 {}} test textDisp-16.40 {text count -xpixels} { set res {} lappend res [.t count -xpixels 1.0 1.5] \ [.t count -xpixels 1.5 1.0] \ [.t count -xpixels 1.0 13.0] \ [.t count -xpixels 1.0 "1.0 displaylineend"] \ [.t count -xpixels 1.0 "1.0 lineend"] \ [.t count -xpixels 1.0 "1.0 displaylineend"] \ [.t count -xpixels 1.0 end] } {35 -35 0 42 42 42 0} test textDisp-16.41 {text count -xpixels with indices in elided lines} { set res {} .t delete 1.0 end for {set i 1} {$i < 40} {incr i} { .t insert end [string repeat "Line $i" 20] .t insert end "\n" } .t configure -wrap none .t tag add hidden 5.15 20.15 .t tag configure hidden -elide true lappend res [.t count -xpixels 5.15 6.0] \ [.t count -xpixels 5.15 6.1] \ [.t count -xpixels 6.0 6.1] \ [.t count -xpixels 6.1 6.2] \ [.t count -xpixels 6.1 6.0] \ [.t count -xpixels 6.0 7.0] \ [.t count -xpixels 6.1 7.1] \ [.t count -xpixels 15.0 20.15] \ [.t count -xpixels 20.15 20.16] \ [.t count -xpixels 20.16 20.15] .t tag remove hidden 20.0 20.15 lappend res [expr {[.t count -xpixels 5.0 20.0] != 0}] } [list 0 0 0 0 0 0 0 0 $fixedWidth -$fixedWidth 1] test textDisp-16.42 {TkTextYviewCmd procedure with indices in elided lines} { .t configure -wrap none .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { .t insert end [string repeat "Line $i" 20] .t insert end "\n" } .t tag add hidden 5.15 20.15 .t tag configure hidden -elide true .t yview 35.0 .t yview scroll [expr {- 15 * $fixedHeight}] pixels update .t index @0,0 } {5.0} test textDisp-16.43 {TkTextYviewCmd procedure with indices in elided lines} { .t configure -wrap none .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { .t insert end [string repeat "Line $i" 20] .t insert end "\n" } .t tag add hidden 5.15 20.15 .t tag configure hidden -elide true .t yview 35.0 .t yview scroll -15 units update .t index @0,0 } {5.0} test textDisp-16.44 {TkTextYviewCmd procedure, scroll down, with elided lines} { .t configure -wrap none .t delete 1.0 end foreach x [list 0 1 2 3 4 5 6 7 8 9 0] { .t insert end "$x aaa1\n$x bbb2\n$x ccc3\n$x ddd4\n$x eee5\n$x fff6" .t insert end "$x 1111\n$x 2222\n$x 3333\n$x 4444\n$x 5555\n$x 6666" hidden } .t tag configure hidden -elide true ; # 5 hidden lines update .t see [expr {5 + [winfo height .t] / $fixedHeight} + 1].0 update .t index @0,0 } {2.0} .t delete 1.0 end foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { .t insert end "\nLine $i 11111 $i 22222 $i 33333 $i 44444 $i 55555" .t insert end " $i 66666 $i 77777 $i 88888 $i" } .t configure -wrap none test textDisp-17.1 {TkTextScanCmd procedure} { list [catch {.t scan a b} msg] $msg } {1 {wrong # args: should be ".t scan mark x y" or ".t scan dragto x y ?gain?"}} test textDisp-17.2 {TkTextScanCmd procedure} { list [catch {.t scan a b c d} msg] $msg } {1 {expected integer but got "b"}} test textDisp-17.3 {TkTextScanCmd procedure} { list [catch {.t scan stupid b 20} msg] $msg } {1 {expected integer but got "b"}} test textDisp-17.4 {TkTextScanCmd procedure} { list [catch {.t scan stupid -2 bogus} msg] $msg } {1 {expected integer but got "bogus"}} test textDisp-17.5 {TkTextScanCmd procedure} { list [catch {.t scan stupid 123 456} msg] $msg } {1 {bad scan option "stupid": must be mark or dragto}} test textDisp-17.6 {TkTextScanCmd procedure} {textfonts} { .t yview 1.0 .t xview moveto 0 .t scan mark 40 60 .t scan dragto 35 55 .t index @0,0 } {4.7} test textDisp-17.7 {TkTextScanCmd procedure} {textfonts} { .t yview 10.0 .t xview moveto 0 .t xview scroll 20 units .t scan mark -10 60 .t scan dragto -5 65 .t index @0,0 set x [.t index @0,0] .t scan dragto 0 [expr {70 + $fixedDiff}] list $x [.t index @0,0] } {6.12 2.5} test textDisp-17.8 {TkTextScanCmd procedure} {textfonts} { .t yview 1.0 .t xview moveto 0 .t scan mark 0 60 .t scan dragto 30 100 .t scan dragto 25 95 .t index @0,0 } {4.7} test textDisp-17.9 {TkTextScanCmd procedure} {textfonts} { .t yview end .t xview moveto 0 .t xview scroll 100 units .t scan mark 90 60 .t scan dragto 10 0 .t scan dragto 14 5 .t index @0,0 } {18.44} .t configure -wrap word test textDisp-17.10 {TkTextScanCmd procedure, word wrapping} {textfonts} { .t yview 10.0 .t scan mark -10 60 .t scan dragto -5 65 set x [.t index @0,0] .t scan dragto 0 [expr {70 + $fixedDiff}] list $x [.t index @0,0] } {9.15 8.31} .t configure -xscrollcommand scroll -yscrollcommand {} test textDisp-18.1 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx update set scrollInfo } [list 0.0 [expr {4.0/11}]] test textDisp-18.2 {GetXView procedure} { .t configure -wrap char .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx update set scrollInfo } {0.0 1.0} test textDisp-18.3 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end update set scrollInfo } {0.0 1.0} test textDisp-18.4 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end xxxxxx\n .t insert end xxxxxxxxxxxxxxxxx update set scrollInfo } {0.0 1.0} test textDisp-18.5 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx .t xview scroll 31 units update set scrollInfo } [list [expr {31.0/55}] [expr {51.0/55}]] test textDisp-18.6 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto 0 .t xview scroll 31 units update set x {} lappend x $scrollInfo .t configure -wrap char update lappend x $scrollInfo .t configure -wrap word update lappend x $scrollInfo .t configure -wrap none update lappend x $scrollInfo } [list [list [expr {31.0/56}] [expr {51.0/56}]] {0.0 1.0} {0.0 1.0} [list 0.0 [expr {5.0/14}]]] test textDisp-18.7 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end update set scrollInfo unchanged .t insert end xxxxxx\n .t insert end xxx update set scrollInfo } {unchanged} test textDisp-18.8 {GetXView procedure} { proc bgerror msg { global x errorInfo set x [list $msg $errorInfo] } proc bogus args { error "bogus scroll proc" } .t configure -wrap none .t delete 1.0 end .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n update .t delete 1.0 end .t configure -xscrollcommand scrollError update set x } {{scrolling error} {scrolling error while executing "error "scrolling error"" (procedure "scrollError" line 2) invoked from within "scrollError 0.0 1.0" (horizontal scrolling command executed by text)}} catch {rename bgerror {}} catch {rename bogus {}} .t configure -xscrollcommand {} -yscrollcommand scroll .t configure -xscrollcommand {} -yscrollcommand scroll test textDisp-19.1 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end update set scrollInfo } {0.0 1.0} test textDisp-19.2 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end update set scrollInfo "unchanged" .t insert 1.0 "Line1\nLine2" update set scrollInfo } {unchanged} test textDisp-19.3 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end update; after 10 ; update set scrollInfo "unchanged" .t insert 1.0 "Line 1\nLine 2 is so long that it wraps around\nLine 3" update set scrollInfo } {unchanged} test textDisp-19.4 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" update set scrollInfo "unchanged" foreach i {2 3 4 5 6 7 8 9 10 11 12 13} { .t insert end "\nLine $i" } update set scrollInfo } [list 0.0 [expr {70.0/91}]] test textDisp-19.5 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13} { .t insert end "\nLine $i" } .t insert 2.end " is really quite long; in fact it's so long that it wraps three times" update ; after 100 set x $scrollInfo } {0.0 0.625} test textDisp-19.6 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13} { .t insert end "\nLine $i" } .t insert 2.end " is really quite long; in fact it's so long that it wraps three times" .t yview 4.0 update set x $scrollInfo } {0.375 1.0} test textDisp-19.7 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13} { .t insert end "\nLine $i" } .t insert 2.end " is really quite long; in fact it's so long that it wraps three times" .t yview 2.26 update; after 1; update set x $scrollInfo } {0.125 0.75} test textDisp-19.8 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13} { .t insert end "\nLine $i" } .t insert 10.end " is really quite long; in fact it's so long that it wraps three times" .t yview 2.0 update .t count -update -ypixels 1.0 end set x $scrollInfo } {0.0625 0.6875} test textDisp-19.9 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t yview 3.0 update set scrollInfo } [list [expr {4.0/30}] 0.8] test textDisp-19.10 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t yview 11.0 update set scrollInfo } [list [expr {1.0/3}] 1.0] test textDisp-19.10.1 {Widget manipulation causes height miscount} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t yview 11.0 update .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t insert end "\nThis last line wraps around four " .t insert end "times with a bit left on the last line." .t yview insert update .t count -update -ypixels 1.0 end set scrollInfo } {0.5 1.0} test textDisp-19.11 {GetYView procedure} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t insert end "\nThis last line wraps around four " .t insert end "times with a bit left on the last line." .t yview insert update .t count -update -ypixels 1.0 end set scrollInfo } {0.5 1.0} test textDisp-19.11.2 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 1.0 end } {20} test textDisp-19.11.3 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines end 1.0 } {-20} test textDisp-19.11.4 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 1.1 1.3 } {0} test textDisp-19.11.5 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 16.0 16.1 } {0} test textDisp-19.11.5.1 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 16.0 16.5 } {0} test textDisp-19.11.6 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 16.0 16.20 } {1} test textDisp-19.11.7 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 16.0 16.40 } {2} test textDisp-19.11.8 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines "16.0 displaylineend +1c" "16.0 lineend" } {3} test textDisp-19.11.9 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 16.0 "16.0 lineend" } {4} test textDisp-19.11.10 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 16.0 "16.0 +4displaylines" } {4} test textDisp-19.11.11 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines 16.0 "16.0 +2displaylines" } {2} test textDisp-19.11.12 {TextWidgetCmd procedure, "count -displaylines"} { .t count -displaylines "16.0 +1displayline" "16.0 +2displaylines -1c" } {0} .t tag configure elide -elide 1 test textDisp-19.11.13 {TextWidgetCmd procedure, "count -displaylines"} { .t tag remove elide 1.0 end .t tag add elide "16.0 +1displaylines" "16.0 +1displaylines +6c" .t count -displaylines 16.0 "16.0 +4displaylines" } {4} test textDisp-19.11.14 {TextWidgetCmd procedure, "count -displaylines"} { .t tag remove elide 1.0 end .t tag add elide "16.0 +1displaylines" "16.0 +1displaylines displaylineend" .t count -displaylines 16.0 "16.0 +4displaylines" } {4} test textDisp-19.11.15 {TextWidgetCmd procedure, "count -displaylines"} { .t tag remove elide 1.0 end .t tag add elide "16.0 +1displaylines" "16.0 +2displaylines" .t count -displaylines 16.0 "16.0 +4displaylines -1c" } {3} test textDisp-19.11.15a {TextWidgetCmd procedure, "count -displaylines"} { .t tag remove elide 1.0 end .t tag add elide "16.0 +1displaylines" "16.0 +2displaylines" .t count -displaylines 16.0 "16.0 +4displaylines" } {4} test textDisp-19.11.16 {TextWidgetCmd procedure, "count -displaylines"} { .t tag remove elide 1.0 end .t tag add elide "12.0" "14.0" .t count -displaylines 12.0 16.0 } {2} test textDisp-19.11.17 {TextWidgetCmd procedure, "index +displaylines"} { .t tag remove elide 1.0 end .t tag add elide "12.0" "14.0" list [.t index "11.5 +2d lines"] \ [.t index "12.0 +2d lines"] [.t index "11.0 +2d lines"] \ [.t index "13.0 +2d lines"] [.t index "13.1 +3d lines"] \ [.t index "13.0 +4d lines"] } {15.5 16.0 15.0 16.0 16.15 16.33} test textDisp-19.11.18 {TextWidgetCmd procedure, "index +displaylines"} { .t tag remove elide 1.0 end .t tag add elide "12.0" "14.0" list [.t index "15.5 -2d lines"] \ [.t index "16.0 -2d lines"] [.t index "15.0 -2d lines"] \ [.t index "16.0 -3d lines"] [.t index "16.17 -4d lines"] \ [.t index "16.36 -5d lines"] } {11.5 14.0 11.0 11.0 11.2 11.3} test textDisp-19.11.19 {TextWidgetCmd procedure, "count -displaylines"} { .t tag remove elide 1.0 end .t tag add elide "12.0" "16.0 +1displaylines" .t count -displaylines 12.0 17.0 } {4} test textDisp-19.11.20 {TextWidgetCmd procedure, "index +displaylines"} { .t tag remove elide 1.0 end .t tag add elide "12.0" "16.0 +1displaylines" list [.t index "11.5 +2d lines"] \ [.t index "12.0 +2d lines"] [.t index "11.0 +2d lines"] \ [.t index "13.0 +2d lines"] [.t index "13.0 +3d lines"] \ [.t index "13.0 +4d lines"] } {16.38 16.50 16.33 16.50 16.67 17.0} test textDisp-19.11.21 {TextWidgetCmd procedure, "index +displaylines"} { .t tag remove elide 1.0 end .t tag add elide "12.0" "16.0 +1displaylines" list [.t index "16.38 -2d lines"] \ [.t index "16.50 -3d lines"] [.t index "16.33 -2d lines"] \ [.t index "16.53 -4d lines"] [.t index "16.69 -4d lines"] \ [.t index "17.1 -5d lines"] } {11.5 11.0 11.0 10.3 11.2 11.0} test textDisp-19.11.22 {TextWidgetCmd procedure, "index +displaylines"} { .t tag remove elide 1.0 end list [.t index "end +5d lines"] \ [.t index "end -3d lines"] [.t index "1.0 -2d lines"] \ [.t index "1.0 +4d lines"] [.t index "1.0 +50d lines"] \ [.t index "end -50d lines"] } {17.0 16.33 1.0 5.0 17.0 1.0} test textDisp-19.11.23 {TextWidgetCmd procedure, "index +displaylines"} { .t tag remove elide 1.0 end .t tag add elide "12.3" "16.0 +1displaylines" list [.t index "11.5 +1d lines"] [.t index "11.5 +2d lines"] \ [.t index "12.0 +1d lines"] \ [.t index "12.0 +2d lines"] [.t index "11.0 +2d lines"] \ [.t index "13.0 +2d lines"] [.t index "13.0 +3d lines"] \ [.t index "13.0 +4d lines"] } {16.17 16.33 16.28 16.46 16.28 16.49 16.65 16.72} .t tag remove elide 1.0 end test textDisp-19.11.24 {TextWidgetCmd procedure, "index +/-displaylines"} { list [.t index "11.5 + -1 display lines"] \ [.t index "11.5 + +1 disp lines"] \ [.t index "11.5 - -1 disp lines"] \ [.t index "11.5 - +1 disp lines"] \ [.t index "11.5 -1 disp lines"] \ [.t index "11.5 +1 disp lines"] \ [.t index "11.5 +0 disp lines"] } {10.5 12.5 12.5 10.5 10.5 12.5 11.5} .t tag remove elide 1.0 end test textDisp-19.12 {GetYView procedure, partially visible last line} { catch {destroy .top} toplevel .top wm geometry .top +0+0 text .top.t -width 40 -height 5 -font $fixedFont pack .top.t -expand yes -fill both .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4\nLine 5" # Need to wait for asychronous calculations to complete. update ; after 10 scan [wm geom .top] %dx%d twidth theight wm geom .top ${twidth}x[expr $theight - 3] update .top.t yview } [list 0.0 [expr {(5.0 * $fixedHeight - 3.0)/ (5.0 * $fixedHeight)}]] test textDisp-19.13 {GetYView procedure, partially visible last line} {textfonts} { catch {destroy .top} toplevel .top wm geometry .top +0+0 text .top.t -width 40 -height 5 -font $fixedFont pack .top.t -expand yes -fill both .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4 has enough text to wrap around at least once" # Need to wait for asychronous calculations to complete. update ; after 10 scan [wm geom .top] %dx%d twidth theight wm geom .top ${twidth}x[expr $theight - 3] update .top.t yview } [list 0.0 [expr {(5.0 * $fixedHeight - 3.0)/ (5.0 * $fixedHeight)}]] catch {destroy .top} test textDisp-19.14 {GetYView procedure} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t insert end "\nThis last line wraps around four " .t insert end "times with a bit left on the last line." # Need to update so everything is calculated. update ; .t count -update -ypixels 1.0 end update ; after 10 ; update set scrollInfo "unchanged" .t mark set insert 3.0 .t tag configure x -background red .t tag add x 1.0 5.0 update .t tag delete x set scrollInfo } {unchanged} test textDisp-19.15 {GetYView procedure} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t insert end "\nThis last line wraps around four " .t insert end "times with a bit left on the last line." update .t configure -yscrollcommand scrollError proc bgerror args { global x errorInfo errorCode set x [list $args $errorInfo $errorCode] } .t delete 1.0 end update rename bgerror {} .t configure -yscrollcommand scroll set x } {{{scrolling error}} {scrolling error while executing "error "scrolling error"" (procedure "scrollError" line 2) invoked from within "scrollError 0.0 1.0" (vertical scrolling command executed by text)} NONE} test textDisp-19.16 {count -ypixels} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Line 1" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } .t insert end "\nThis last line wraps around four " .t insert end "times with a bit left on the last line." # Need to update so everything is calculated. update ; .t count -update -ypixels 1.0 end ; update set res {} lappend res \ [.t count -ypixels 1.0 end] \ [.t count -update -ypixels 1.0 end] \ [.t count -ypixels 15.0 16.0] \ [.t count -ypixels 15.0 "16.0 displaylineend +1c"] \ [.t count -ypixels 16.0 "16.0 displaylineend +1c"] \ [.t count -ypixels "16.0 +1 displaylines" "16.0 +4 displaylines +3c"] } [list [expr {260 + 20 * $fixedDiff}] [expr {260 + 20 * $fixedDiff}] $fixedHeight [expr {2*$fixedHeight}] $fixedHeight [expr {3*$fixedHeight}]] test textDisp-19.17 {count -ypixels with indices in elided lines} { .t configure -wrap none .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { .t insert end [string repeat "Line $i" 20] .t insert end "\n" } .t tag add hidden 5.15 20.15 .t tag configure hidden -elide true set res {} update lappend res \ [.t count -ypixels 1.0 6.0] \ [.t count -ypixels 2.0 7.5] \ [.t count -ypixels 5.0 8.5] \ [.t count -ypixels 6.1 6.2] \ [.t count -ypixels 6.1 18.8] \ [.t count -ypixels 18.0 20.50] \ [.t count -ypixels 5.2 20.60] \ [.t count -ypixels 20.60 20.70] \ [.t count -ypixels 5.0 25.0] \ [.t count -ypixels 25.0 5.0] \ [.t count -ypixels 25.4 27.50] \ [.t count -ypixels 35.0 38.0] .t yview 35.0 lappend res [.t count -ypixels 5.0 25.0] } [list [expr {4 * $fixedHeight}] [expr {3 * $fixedHeight}] 0 0 0 0 0 0 [expr {5 * $fixedHeight}] [expr {- 5 * $fixedHeight}] [expr {2 * $fixedHeight}] [expr {3 * $fixedHeight}] [expr {5 * $fixedHeight}]] test textDisp-19.18 {count -ypixels with indices in elided lines} { .t configure -wrap none .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { .t insert end [string repeat "Line $i" 20] .t insert end "\n" } .t tag add hidden 5.15 20.15 .t tag configure hidden -elide true .t yview 35.0 set res {} update lappend res [.t count -ypixels 5.0 25.0] .t yview scroll [expr {- 15 * $fixedHeight}] pixels update lappend res [.t count -ypixels 5.0 25.0] } [list [expr {5 * $fixedHeight}] [expr {5 * $fixedHeight}]] test textDisp-19.19 {count -ypixels with indices in elided lines} { .t configure -wrap char .t delete 1.0 end for {set i 1} {$i < 25} {incr i} { .t insert end [string repeat "Line $i -" 6] .t insert end "\n" } .t tag add hidden 5.27 11.0 .t tag configure hidden -elide true .t yview 5.0 update set res [list [.t count -ypixels 5.0 11.0] [.t count -ypixels 5.0 11.20]] } [list [expr {1 * $fixedHeight}] [expr {2 * $fixedHeight}]] .t delete 1.0 end .t insert end "Line 1" for {set i 2} {$i <= 200} {incr i} { .t insert end "\nLine $i" } .t configure -wrap word .t delete 50.0 51.0 .t insert 50.0 "This is a long line, one that will wrap around twice.\n" test textDisp-20.1 {FindDLine} {textfonts} { .t yview 48.0 list [.t dlineinfo 46.0] [.t dlineinfo 47.0] [.t dlineinfo 49.0] \ [.t dlineinfo 58.0] } [list {} {} [list 3 [expr {$fixedDiff + 16}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] test textDisp-20.2 {FindDLine} {textfonts} { .t yview 100.0 .t yview -pickplace 53.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.14] [.t dlineinfo 50.15] } [list [list 3 [expr {-1 - $fixedDiff/2}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {-1 - $fixedDiff/2}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {12 + $fixedDiff/2}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] test textDisp-20.3 {FindDLine} {textfonts} { .t yview 100.0 .t yview 49.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 57.0] } [list [list 3 [expr {$fixedDiff + 16}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {2*$fixedDiff + 29}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] test textDisp-20.4 {FindDLine} {textfonts} { .t yview 100.0 .t yview 42.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 50.40] } [list [list 3 [expr {8*$fixedDiff + 107}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {9*$fixedDiff + 120}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] .t config -wrap none test textDisp-20.5 {FindDLine} {textfonts} { .t yview 100.0 .t yview 48.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 50.40] } [list [list 3 [expr {3+2*$fixedHeight}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {3+2*$fixedHeight}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {3+2*$fixedHeight}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] .t config -wrap word test textDisp-21.1 {TkTextPixelIndex} {textfonts} { .t yview 48.0 list [.t index @-10,-10] [.t index @6,6] [.t index @22,6] \ [.t index @102,6] [.t index @38,[expr {$fixedHeight * 4 + 3}]] [.t index @44,67] } {48.0 48.0 48.2 48.7 50.40 50.40} .t insert end \n test textDisp-21.2 {TkTextPixelIndex} {textfonts} { .t yview 195.0 list [.t index @11,[expr {$fixedHeight * 5 + 5}]] [.t index @11,[expr {$fixedHeight * 6 + 5}]] [.t index @11,[expr {$fixedHeight * 7 + 5}]] \ [.t index @11,1002] } {197.1 198.1 199.1 201.0} test textDisp-21.3 {TkTextPixelIndex, horizontal scrolling} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "12345\n" .t insert end "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" .t xview scroll 2 units list [.t index @-5,7] [.t index @5,7] [.t index @33,20] } {1.2 1.2 2.6} test textDisp-21.4 {count -displaylines regression} { set message { QOTW: "C/C++, which is used by 16% of users, is the most popular programming language, but Tcl, used by 0%, seems to be the language of choice for the highest scoring users." (new line) Use the Up (cursor) key to scroll up one line at a time. At the second press, the cursor either gets locked or jumps several lines. Connect with Tkcon. The command .u count -displaylines \ 3.10 2.173 should give answer -1; it gives me 5. Using 8.5a4 (ActiveState beta 4) under Linux. No problem with ActiveState beta 3. } toplevel .tt pack [text .tt.u] -side right .tt.u configure -width 30 -height 27 -wrap word -bg #FFFFFF .tt.u insert end $message .tt.u mark set insert 3.10 tkwait visibility .tt.u set res [.tt.u count -displaylines 3.10 2.173] destroy .tt unset message set res } {-1} .t delete 1.0 end .t insert end "Line 1" for {set i 2} {$i <= 200} {incr i} { .t insert end "\nLine $i" } .t configure -wrap word .t delete 50.0 51.0 .t insert 50.0 "This is a long line, one that will wrap around twice.\n" update .t tag add x 50.1 test textDisp-22.1 {TkTextCharBbox} {textfonts} { .t config -wrap word .t yview 48.0 list [.t bbox 47.2] [.t bbox 48.0] [.t bbox 50.5] [.t bbox 50.40] \ [.t bbox 58.0] } [list {} [list 3 3 7 $fixedHeight] [list 38 [expr {3+2*$fixedHeight}] 7 $fixedHeight] [list 38 [expr {3+4*$fixedHeight}] 7 $fixedHeight] {}] test textDisp-22.2 {TkTextCharBbox} {textfonts} { .t config -wrap none .t yview 48.0 list [.t bbox 50.5] [.t bbox 50.40] [.t bbox 57.0] } [list [list 38 [expr {3+2*$fixedHeight}] 7 $fixedHeight] {} [list 3 [expr {3+9*$fixedHeight}] 7 $fixedHeight]] test textDisp-22.3 {TkTextCharBbox, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 wm geom . ${width}x[expr $height-1] update list [.t bbox 19.1] [.t bbox 20.1] } [list [list 10 [expr {3+9*$fixedHeight}] 7 $fixedHeight] [list 10 [expr {3+10*$fixedHeight}] 7 3]] test textDisp-22.4 {TkTextCharBbox, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 wm geom . ${width}x[expr $height+1] update list [.t bbox 19.1] [.t bbox 20.1] } [list [list 10 [expr {3+9*$fixedHeight}] 7 $fixedHeight] [list 10 [expr {3+10*$fixedHeight}] 7 5]] test textDisp-22.5 {TkTextCharBbox, cut-off char} {textfonts} { .t config -wrap none .t yview 10.0 wm geom . [expr $width-95]x$height update .t bbox 15.6 } [list 45 [expr {3+5*$fixedHeight}] 7 $fixedHeight] test textDisp-22.6 {TkTextCharBbox, line visible but not char} {textfonts} { .t config -wrap char .t yview 10.0 .t tag add big 20.2 20.5 wm geom . ${width}x[expr $height+3] update list [.t bbox 19.1] [.t bbox 20.1] [.t bbox 20.2] } [list [list 10 [expr {3+9*$fixedHeight}] 7 $fixedHeight] {} [list 17 [expr {3+10*$fixedHeight}] 14 7]] wm geom . {} update test textDisp-22.7 {TkTextCharBbox, different character sizes} {textfonts} { .t config -wrap char .t yview 10.0 .t tag add big 12.2 12.5 update list [.t bbox 12.1] [.t bbox 12.2] } [list [list 10 [expr {3 + 2*$fixedHeight + $ascentDiff}] 7 $fixedHeight] [list 17 [expr {3+ 2*$fixedHeight}] 14 27]] .t tag remove big 1.0 end test textDisp-22.8 {TkTextCharBbox, horizontal scrolling} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert end "12345\n" .t insert end "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" .t xview scroll 4 units list [.t bbox 1.3] [.t bbox 1.4] [.t bbox 2.3] [.t bbox 2.4] \ [.t bbox 2.23] [.t bbox 2.24] } [list {} [list 3 3 7 $fixedHeight] {} [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 136 [expr {$fixedDiff + 16}] 7 $fixedHeight] {}] test textDisp-22.9 {TkTextCharBbox, handling of spacing} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijkl\nmnopqrstuvwzyz" .t tag configure spacing -spacing1 8 -spacing3 2 .t tag add spacing 1.0 end frame .t.f1 -width 10 -height 4 -bg black frame .t.f2 -width 10 -height 4 -bg black frame .t.f3 -width 10 -height 4 -bg black frame .t.f4 -width 10 -height 4 -bg black .t window create 1.3 -window .t.f1 -align top .t window create 1.7 -window .t.f2 -align center .t window create 2.1 -window .t.f3 -align bottom .t window create 2.10 -window .t.f4 -align baseline update list [.t bbox .t.f1] [.t bbox .t.f2] [.t bbox .t.f3] [.t bbox .t.f4] \ [.t bbox 1.1] [.t bbox 2.9] } [list [list 24 11 10 4] [list 55 [expr {$fixedDiff/2 + 15}] 10 4] [list 10 [expr {2*$fixedDiff + 43}] 10 4] [list 76 [expr {2*$fixedDiff + 40}] 10 4] [list 10 11 7 $fixedHeight] [list 69 [expr {$fixedDiff + 34}] 7 $fixedHeight]] .t tag delete spacing test textDisp-22.10 {TkTextCharBbox, handling of elided lines} {textfonts} { .t configure -wrap char .t delete 1.0 end for {set i 1} {$i < 10} {incr i} { .t insert end "Line $i - Line [format %c [expr 64+$i]]\n" } .t tag add hidden 2.8 2.13 .t tag add hidden 6.8 7.13 .t tag configure hidden -elide true update list \ [expr {[lindex [.t bbox 2.9] 0] - [lindex [.t bbox 2.8] 0]}] \ [expr {[lindex [.t bbox 2.10] 0] - [lindex [.t bbox 2.8] 0]}] \ [expr {[lindex [.t bbox 2.13] 0] - [lindex [.t bbox 2.8] 0]}] \ [expr {[lindex [.t bbox 6.9] 0] - [lindex [.t bbox 6.8] 0]}] \ [expr {[lindex [.t bbox 6.10] 0] - [lindex [.t bbox 6.8] 0]}] \ [expr {[lindex [.t bbox 6.13] 0] - [lindex [.t bbox 6.8] 0]}] \ [expr {[lindex [.t bbox 6.14] 0] - [lindex [.t bbox 6.8] 0]}] \ [expr {[lindex [.t bbox 6.15] 0] - [lindex [.t bbox 6.8] 0]}] \ [expr {[lindex [.t bbox 7.0] 0] - [lindex [.t bbox 6.8] 0]}] \ [expr {[lindex [.t bbox 7.1] 0] - [lindex [.t bbox 6.8] 0]}] \ [expr {[lindex [.t bbox 7.12] 0] - [lindex [.t bbox 6.8] 0]}] } [list 0 0 0 0 0 0 0 0 0 0 0] test textDisp-22.11 {TkTextCharBbox, handling of wrapped elided lines} {textfonts} { .t configure -wrap char .t delete 1.0 end for {set i 1} {$i < 10} {incr i} { .t insert end "Line $i - Line _$i - Lines .$i - Line [format %c [expr 64+$i]]\n" } .t tag add hidden 1.30 2.5 .t tag configure hidden -elide true update list \ [expr {[lindex [.t bbox 1.30] 0] - [lindex [.t bbox 2.4] 0]}] \ [expr {[lindex [.t bbox 1.30] 0] - [lindex [.t bbox 2.5] 0]}] } [list 0 0] .t delete 1.0 end .t insert end "Line 1" for {set i 2} {$i <= 200} {incr i} { .t insert end "\nLine $i" } .t configure -wrap word .t delete 50.0 51.0 .t insert 50.0 "This is a long line, one that will wrap around twice.\n" update test textDisp-23.1 {TkTextDLineInfo} {textfonts} { .t config -wrap word .t yview 48.0 list [.t dlineinfo 47.3] [.t dlineinfo 48.0] [.t dlineinfo 50.40] \ [.t dlineinfo 56.0] } [list {} [list 3 3 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {4*$fixedDiff + 55}] 126 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] test textDisp-23.2 {TkTextDLineInfo} {textfonts} { .t config -bd 4 -wrap word update .t yview 48.0 .t dlineinfo 50.40 } [list 7 [expr {4*$fixedDiff + 59}] 126 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] .t config -bd 0 test textDisp-23.3 {TkTextDLineInfo} {textfonts} { .t config -wrap none update .t yview 48.0 list [.t dlineinfo 50.40] [.t dlineinfo 57.3] } [list [list 3 [expr {2*$fixedDiff + 29}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {9*$fixedDiff + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] test textDisp-23.4 {TkTextDLineInfo, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 wm geom . ${width}x[expr $height-1] update list [.t dlineinfo 19.0] [.t dlineinfo 20.0] } [list [list 3 [expr {9*$fixedDiff + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {10*$fixedDiff + 133}] 49 3 [expr {$fixedDiff + 10}]]] test textDisp-23.5 {TkTextDLineInfo, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 wm geom . ${width}x[expr $height+1] update list [.t dlineinfo 19.0] [.t dlineinfo 20.0] } [list [list 3 [expr {9*$fixedDiff + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {10*$fixedDiff + 133}] 49 5 [expr {$fixedDiff + 10}]]] wm geom . {} update test textDisp-23.6 {TkTextDLineInfo, horizontal scrolling} {textfonts} { .t config -wrap none .t delete 1.0 end .t insert end "First line\n" .t insert end "Second line is a very long one that doesn't all fit.\n" .t insert end "Third" .t xview scroll 6 units update list [.t dlineinfo 1.0] [.t dlineinfo 2.0] [.t dlineinfo 3.0] } [list [list -39 3 70 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list -39 [expr {$fixedDiff + 16}] 364 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list -39 [expr {2*$fixedDiff + 29}] 35 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] .t xview moveto 0 test textDisp-23.7 {TkTextDLineInfo, centering} {textfonts} { .t config -wrap word .t delete 1.0 end .t insert end "First line\n" .t insert end "Second line is a very long one that doesn't all fit.\n" .t insert end "Third" .t tag configure x -justify center .t tag configure y -justify right .t tag add x 1.0 .t tag add y 3.0 list [.t dlineinfo 1.0] [.t dlineinfo 2.0] [.t dlineinfo 3.0] } [list [list 38 3 70 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {$fixedDiff + 16}] 119 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 108 [expr {4*$fixedDiff + 55}] 35 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] .t tag delete x y test textDisp-24.1 {TkTextCharLayoutProc} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.2 {TkTextCharLayoutProc} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" wm geom . [expr $width+1]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 12 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.3 {TkTextCharLayoutProc} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" wm geom . [expr $width-1]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 10 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.4 {TkTextCharLayoutProc, newline not visible} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 01234567890123456789\n012345678901234567890 wm geom . {} update list [.t bbox 1.19] [.t bbox 1.20] [.t bbox 2.20] } [list [list 136 3 7 $fixedHeight] [list 143 3 0 $fixedHeight] [list 3 [expr {2*$fixedDiff + 29}] 7 $fixedHeight]] test textDisp-24.5 {TkTextCharLayoutProc, char doesn't fit, newline not visible} {unix textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 0\n1\n wm geom . 110x$height update list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 2.0] } [list [list 3 3 4 $fixedHeight] [list 7 3 0 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 4 $fixedHeight]] test textDisp-24.6 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" wm geom . {} update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.7 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" wm geom . [expr $width+1]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 12 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.8 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" wm geom . [expr $width-1]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 10 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.9 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" wm geom . [expr $width-6]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 5 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.10 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" wm geom . [expr $width-7]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 4 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.11 {TkTextCharLayoutProc, line ends with space that doesn't quite fit} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "01234567890123456789 \nabcdefg" wm geom . [expr $width-2]x$height update set result {} lappend result [.t bbox 1.21] [.t bbox 2.0] .t mark set insert 1.21 lappend result [.t bbox 1.21] [.t bbox 2.0] } [list [list 145 3 0 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 145 3 0 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.12 {TkTextCharLayoutProc, tab causes wrap} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghi" .t mark set insert 1.4 .t insert insert \t\t\t list [.t bbox {insert -1c}] [.t bbox insert] } [list [list 115 3 30 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.13 {TkTextCharLayoutProc, -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" wm geom . {} update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] {}] test textDisp-24.14 {TkTextCharLayoutProc, -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" wm geom . [expr $width+1]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 143 3 5 $fixedHeight]] test textDisp-24.15 {TkTextCharLayoutProc, -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" wm geom . [expr $width-1]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 143 3 3 $fixedHeight]] test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {textfonts} { if {$tcl_platform(platform) == "windows"} { wm overrideredirect . 1 } .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" wm geom . 103x$height update list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2] } [list [list 3 3 1 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 1 $fixedHeight] [list 3 [expr {2*$fixedDiff + 29}] 1 $fixedHeight]] if {$tcl_platform(platform) == "windows"} { wm overrideredirect . 0 } test textDisp-24.17 {TkTextCharLayoutProc, -wrap word} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "This is a line that wraps around" wm geom . {} update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.18 {TkTextCharLayoutProc, -wrap word} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "xThis is a line that wraps around" wm geom . {} update list [.t bbox 1.14] [.t bbox 1.15] [.t bbox 1.16] } [list [list 101 3 7 $fixedHeight] [list 108 3 35 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] test textDisp-24.19 {TkTextCharLayoutProc, -wrap word} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "xxThis is a line that wraps around" wm geom . {} update list [.t bbox 1.14] [.t bbox 1.15] [.t bbox 1.16] } [list [list 101 3 7 $fixedHeight] [list 108 3 7 $fixedHeight] [list 115 3 28 $fixedHeight]] test textDisp-24.20 {TkTextCharLayoutProc, vertical offset} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2\nLine 3" set result {} lappend result [.t bbox 2.1] [.t dlineinfo 2.1] .t tag configure up -offset 6 .t tag add up 2.1 lappend result [.t bbox 2.1] [.t dlineinfo 2.1] .t tag configure up -offset -2 lappend result [.t bbox 2.1] [.t dlineinfo 2.1] .t tag delete up set result } [list [list 10 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 42 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 10 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 42 [expr {$fixedDiff + 19}] [expr {$fixedDiff + 16}]] [list 10 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 42 [expr {$fixedDiff + 15}] [expr {$fixedDiff + 10}]]] .t configure -width 30 update test textDisp-24.21 {TkTextCharLayoutProc, word breaks} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Sample text xxxxxxx yyyyy zzzzzzz qqqqq rrrr ssss tt u vvvvv" frame .t.f -width 30 -height 20 -bg black .t window create 1.36 -window .t.f .t bbox 1.26 } [list 3 [expr {$fixedDiff/2 + 19}] 7 $fixedHeight] test textDisp-24.22 {TkTextCharLayoutProc, word breaks} {textfonts} { .t configure -wrap word .t delete 1.0 end frame .t.f -width 30 -height 20 -bg black .t insert 1.0 "Sample text xxxxxxx yyyyyyy" .t window create end -window .t.f .t insert end "zzzzzzz qqqqq rrrr ssss tt u vvvvv" .t bbox 1.28 } [list 33 [expr {$fixedDiff/2 + 19}] 7 $fixedHeight] test textDisp-24.23 {TkTextCharLayoutProc, word breaks} {textfonts} { .t configure -wrap word .t delete 1.0 end frame .t.f -width 30 -height 20 -bg black .t insert 1.0 "Sample text xxxxxxx yyyyyyy " .t insert end "zzzzzzz qqqqq rrrr ssss tt" .t window create end -window .t.f .t insert end "u vvvvv" .t bbox .t.f } [list 3 [expr {2*$fixedDiff + 29}] 30 20] catch {destroy .t.f} .t configure -width 20 update test textDisp-24.24 {TkTextCharLayoutProc, justification and tabs} {textfonts} { .t delete 1.0 end .t tag configure x -justify center .t insert 1.0 aa\tbb\tcc\tdd\t .t tag add x 1.0 end list [.t bbox 1.0] [.t bbox 1.10] } [list [list 45 3 7 $fixedHeight] [list 94 3 7 $fixedHeight]] .t configure -width 40 -bd 0 -relief flat -highlightthickness 0 -padx 0 \ -tabs 100 update test textDisp-25.1 {CharBboxProc procedure, check tab width} {textfonts} { .t delete 1.0 end .t insert 1.0 abc\td\tfgh list [.t bbox 1.3] [.t bbox 1.5] [.t bbox 1.6] } [list [list 21 1 79 $fixedHeight] [list 107 1 93 $fixedHeight] [list 200 1 7 $fixedHeight]] .t configure -width 40 -bd 0 -relief flat -highlightthickness 0 -padx 0 \ -tabs {} update test textDisp-26.1 {AdjustForTab procedure, no tabs} {textfonts} { .t delete 1.0 end .t insert 1.0 a\tbcdefghij\tc\td list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.12] 0] \ [lindex [.t bbox 1.14] 0] } [list 56 126 168] test textDisp-26.1.2 {AdjustForTab procedure, no tabs} {textfonts} { .t delete 1.0 end .t insert 1.0 a\tbcdefghij\tc\td .t configure -tabstyle wordprocessor set res [list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.12] 0] \ [lindex [.t bbox 1.14] 0]] .t configure -tabstyle tabular set res } [list 56 168 224] test textDisp-26.2 {AdjustForTab procedure, not enough tabs specified} { .t delete 1.0 end .t insert 1.0 a\tb\tc\td .t tag delete x .t tag configure x -tabs 40 .t tag add x 1.0 end list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] \ [lindex [.t bbox 1.6] 0] } [list 40 80 120] test textDisp-26.3 {AdjustForTab procedure, not enough tabs specified} { .t delete 1.0 end .t insert 1.0 a\tb\tc\td\te .t tag delete x .t tag configure x -tabs {40 70 right} .t tag add x 1.0 end list [lindex [.t bbox 1.2] 0] \ [expr [lindex [.t bbox 1.4] 0] + [lindex [.t bbox 1.4] 2]] \ [expr [lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]] \ [expr [lindex [.t bbox 1.8] 0] + [lindex [.t bbox 1.8] 2]] } [list 40 70 100 130] test textDisp-26.4 {AdjustForTab procedure, different alignments} { .t delete 1.0 end .t insert 1.0 a\tbc\tde\tfg\thi .t tag delete x .t tag configure x -tabs {40 center 80 left 130 right} .t tag add x 1.0 end .t tag add y 1.2 .t tag add y 1.5 .t tag add y 1.8 list [lindex [.t bbox 1.3] 0] [lindex [.t bbox 1.5] 0] \ [lindex [.t bbox 1.10] 0] } [list 40 80 130] test textDisp-26.5 {AdjustForTab procedure, numeric alignment} { .t delete 1.0 end .t insert 1.0 a\t1.234 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.2 .t tag add y 1.5 lindex [.t bbox 1.3] 0 } {120} test textDisp-26.6 {AdjustForTab procedure, numeric alignment} { .t delete 1.0 end .t insert 1.0 a\t1,456.234 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.2 lindex [.t bbox 1.7] 0 } {120} test textDisp-26.7 {AdjustForTab procedure, numeric alignment} { .t delete 1.0 end .t insert 1.0 a\t1.456.234,7 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.2 lindex [.t bbox 1.11] 0 } {120} test textDisp-26.8 {AdjustForTab procedure, numeric alignment} { .t delete 1.0 end .t insert 1.0 a\ttest .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.2 lindex [.t bbox 1.6] 0 } {120} test textDisp-26.9 {AdjustForTab procedure, numeric alignment} { .t delete 1.0 end .t insert 1.0 a\t1234 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.2 lindex [.t bbox 1.6] 0 } {120} test textDisp-26.10 {AdjustForTab procedure, numeric alignment} { .t delete 1.0 end .t insert 1.0 a\t1.234567 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.5 lindex [.t bbox 1.3] 0 } {120} test textDisp-26.11 {AdjustForTab procedure, numeric alignment} { .t delete 1.0 end .t insert 1.0 a\tx=1.234567 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.7 .t tag add y 1.9 lindex [.t bbox 1.5] 0 } {120} test textDisp-26.12 {AdjustForTab procedure, adjusting chunks} { .t delete 1.0 end .t insert 1.0 a\tx1.234567 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end .t tag add y 1.7 .t tag add y 1.9 button .b -text "=" .t window create 1.3 -window .b update lindex [.t bbox 1.5] 0 } {120} test textDisp-26.13 {AdjustForTab procedure, not enough space} {textfonts} { .t delete 1.0 end .t insert 1.0 "abc\txyz\tqrs\txyz\t0" .t tag delete x .t tag configure x -tabs {10 30 center 50 right 120} .t tag add x 1.0 end list [lindex [.t bbox 1.4] 0] [lindex [.t bbox 1.8] 0] \ [lindex [.t bbox 1.12] 0] [lindex [.t bbox 1.16] 0] } [list 28 56 84 120] test textDisp-26.13.2 {AdjustForTab procedure, not enough space} {textfonts} { .t delete 1.0 end .t insert 1.0 "abc\txyz\tqrs\txyz\t0" .t tag delete x .t tag configure x -tabs {10 30 center 50 right 120} -tabstyle wordprocessor .t tag add x 1.0 end set res [list [lindex [.t bbox 1.4] 0] [lindex [.t bbox 1.8] 0] \ [lindex [.t bbox 1.12] 0] [lindex [.t bbox 1.16] 0]] .t tag configure x -tabstyle tabular set res } [list 28 56 120 190] test textDisp-26.14 {AdjustForTab procedure, not enough space} {textfonts} { .t delete 1.0 end .t insert end "a \tb \tc \td \te \tf \tg\n" .t insert end "Watch the \tX and the \t\t\tY\n" .t tag configure moop -tabs [expr {8*$fixedWidth}] .t insert end "Watch the \tX and the \t\t\tY\n" moop list [lindex [.t bbox 2.11] 0] [lindex [.t bbox 2.24] 0] \ [lindex [.t bbox 3.11] 0] [lindex [.t bbox 3.24] 0] } [list 77 224 77 224] test textDisp-26.14.2 {AdjustForTab procedure, not enough space} {textfonts} { .t delete 1.0 end .t configure -tabstyle wordprocessor .t insert end "a \tb \tc \td \te \tf \tg\n" .t insert end "Watch the \tX and the \t\t\tY\n" .t tag configure moop -tabs [expr {8*$fixedWidth}] .t insert end "Watch the \tX and the \t\t\tY\n" moop set res [list [lindex [.t bbox 2.11] 0] [lindex [.t bbox 2.24] 0] \ [lindex [.t bbox 3.11] 0] [lindex [.t bbox 3.24] 0]] .t configure -tabstyle tabular set res } [list 112 56 112 56] .t configure -width 20 -bd 2 -highlightthickness 2 -relief sunken -tabs {} \ -wrap char update test textDisp-27.1 {SizeOfTab procedure, old-style tabs} {textfonts} { .t delete 1.0 end .t insert 1.0 a\tbcdefghij\tc\td list [.t bbox 1.2] [.t bbox 1.10] [.t bbox 1.12] } [list [list 60 5 7 $fixedHeight] [list 116 5 7 $fixedHeight] [list 130 5 7 $fixedHeight]] test textDisp-27.1.1 {SizeOfTab procedure, old-style tabs} {textfonts} { .t delete 1.0 end .t insert 1.0 a\tbcdefghij\tc\td .t configure -tabstyle wordprocessor set res [list [.t bbox 1.2] [.t bbox 1.10] [.t bbox 1.12]] .t configure -tabstyle tabular set res } [list [list 60 5 7 $fixedHeight] [list 116 5 7 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.2 {SizeOfTab procedure, choosing tabX and alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\tbcd .t tag delete x .t tag configure x -tabs 120 .t tag add x 1.0 end list [.t bbox 1.3] [.t bbox 1.4] } [list [list 131 5 13 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.3 {SizeOfTab procedure, choosing tabX and alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\t\t\tbcd .t tag delete x .t tag configure x -tabs 40 .t tag add x 1.0 end list [.t bbox 1.5] [.t bbox 1.6] } [list [list 131 5 13 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.4 {SizeOfTab procedure, choosing tabX and alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\t\t\tbcd .t tag delete x .t tag configure x -tabs {20 center 70 left} .t tag add x 1.0 end list [.t bbox 1.5] [.t bbox 1.6] } [list [list 131 5 13 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.5 {SizeOfTab procedure, center alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\txyzzyabc .t tag delete x .t tag configure x -tabs {120 center} .t tag add x 1.0 end list [.t bbox 1.6] [.t bbox 1.7] } [list [list 135 5 9 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.6 {SizeOfTab procedure, center alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\txyzzyabc .t tag delete x .t tag configure x -tabs {150 center} .t tag add x 1.0 end list [.t bbox 1.6] [.t bbox 1.7] } [list [list 32 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 39 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.7 {SizeOfTab procedure, center alignment, wrap -none (potential numerical problems)} {textfonts} { .t delete 1.0 end set cm [winfo fpixels .t 1c] .t configure -tabs {1c 2c center 3c 4c 5c 6c 7c 8c} -wrap none -width 40 .t insert 1.0 a\tb\tc\td\te\n012345678934567890a\tbb\tcc\tdd set width [expr {$fixedWidth * 19}] set tab $cm while {$tab < $width} { set tab [expr {$tab + $cm}] } # Now we've calculated to the end of the tab after 'a', add one # more for 'bb\t' and we're there, with 4 for the border. Since # Tk_GetPixelsFromObj uses the standard 'int(0.5 + float)' rounding, # so must we. set tab [expr {4 + int(0.5 + $tab + $cm)}] update set res [.t bbox 2.23] lset res 0 [expr {[lindex $res 0] - $tab}] set res } [list -28 [expr {$fixedDiff + 18}] 7 $fixedHeight] test textDisp-27.7.1 {SizeOfTab procedure, center alignment, wrap -none (potential numerical problems)} {textfonts} { .t delete 1.0 end .t configure -tabstyle wordprocessor set cm [winfo fpixels .t 1c] .t configure -tabs {1c 2c center 3c 4c 5c 6c 7c 8c} -wrap none -width 40 .t insert 1.0 a\tb\tc\td\te\n012345678934567890a\tbb\tcc\tdd set width [expr {$fixedWidth * 19}] set tab $cm while {$tab < $width} { set tab [expr {$tab + $cm}] } # Now we've calculated to the end of the tab after 'a', add one # more for 'bb\t' and we're there, with 4 for the border. Since # Tk_GetPixelsFromObj uses the standard 'int(0.5 + float)' rounding, # so must we. set tab [expr {4 + int(0.5 + $tab + $cm)}] update set res [.t bbox 2.23] .t configure -tabstyle tabular lset res 0 [expr {[lindex $res 0] - $tab}] set res } [list 0 [expr {$fixedDiff + 18}] 7 $fixedHeight] test textDisp-27.7.2 {SizeOfTab procedure, fractional tab interpolation problem} { .t delete 1.0 end set interpolatetab {1c 2c} set precisetab {} for {set i 1} {$i < 20} {incr i} { lappend precisetab "${i}c" } .t configure -tabs $interpolatetab -wrap none -width 150 .t insert 1.0 [string repeat "a\t" 20] update set res [.t bbox 1.20] # Now, Tk's interpolated tabs should be the same as # non-interpolated. .t configure -tabs $precisetab update expr {[lindex $res 0] - [lindex [.t bbox 1.20] 0]} } {0} .t configure -wrap char -tabs {} -width 20 update test textDisp-27.8 {SizeOfTab procedure, right alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\t\txyzzyabc .t tag delete x .t tag configure x -tabs {100 left 140 right} .t tag add x 1.0 end list [.t bbox 1.6] [.t bbox 1.7] } [list [list 137 5 7 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.9 {SizeOfTab procedure, left alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\txyzzyabc .t tag delete x .t tag configure x -tabs {120} .t tag add x 1.0 end list [.t bbox 1.3] [.t bbox 1.4] } [list [list 131 5 13 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.10 {SizeOfTab procedure, numeric alignment} {textfonts} { .t delete 1.0 end .t insert 1.0 a\t123.4 .t tag delete x .t tag configure x -tabs {120 numeric} .t tag add x 1.0 end list [.t bbox 1.3] [.t bbox 1.4] } [list [list 117 5 27 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] test textDisp-27.11 {SizeOfTab procedure, making tabs at least as wide as a space} {textfonts} { .t delete 1.0 end .t insert 1.0 abc\tdefghijklmnopqrst .t tag delete x .t tag configure x -tabs {120} .t tag add x 1.0 end list [.t bbox 1.5] [.t bbox 1.6] } [list [list 131 5 13 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] proc bizarre_scroll args { .t2.t delete 5.0 end } test textDisp-28.1 {"yview" option with bizarre scroll command} { catch {destroy .t2} toplevel .t2 text .t2.t -width 40 -height 4 .t2.t insert end "1\n2\n3\n4\n5\n6\n7\n8\n" pack .t2.t wm geometry .t2 +0+0 update .t2.t configure -yscrollcommand bizarre_scroll .t2.t yview 100.0 set result [.t2.t index @0,0] update lappend result [.t2.t index @0,0] } {6.0 2.0} test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ -wrap char -xscrollcommand ".t2.s set" pack .t2.t -side top scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] } [list [list 0.0 [expr {20.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]] test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ -wrap char -xscrollcommand ".t2.s set" pack .t2.t -side top scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update .t2.t xview scroll 1 unit update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] } [list [list [expr {1.0*$fixedWidth/300}] [expr {21.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - $fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - $fixedWidth}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]] test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ -wrap none -xscrollcommand ".t2.s set" pack .t2.t -side top scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 1\n .t2.t insert end [string repeat "abc" 30] update .t2.t xview scroll 5 unit update .t2.t xview } [list [expr {5.0/90}] [expr {25.0/90}]] test textDisp-29.2.2 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ -wrap char -xscrollcommand ".t2.s set" pack .t2.t -side top scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update .t2.t xview scroll 2 unit update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] } [list [list [expr {2.0*$fixedWidth/300}] [expr {22.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - 2*$fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}] test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ -wrap char -xscrollcommand ".t2.s set" pack .t2.t -side top scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update .t2.t xview scroll 7 pixels update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] } [list [list [expr {7.0/300}] [expr {(20.0*$fixedWidth + 7)/300}]] 300x50+[expr {$twbw + $twht + 1 - 7}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - 7}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]] test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ -wrap char -xscrollcommand ".t2.s set" pack .t2.t -side top scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update .t2.t xview scroll 17 pixels update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] } [list [list [expr {17.0/300}] [expr {(20.0*$fixedWidth + 17)/300}]] 300x50+[expr {$twbw + $twht + 1 - 17}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}] test textDisp-29.2.5 {miscellaneous: can show last character} { catch {destroy .t2} toplevel .t2 wm geometry .t2 121x141+200+200 text .t2.t -width 5 -height 5 -font {Arial 10} \ -wrap none -xscrollcommand ".t2.s set" \ -bd 2 -highlightthickness 0 -padx 1 .t2.t insert end "WWWWWWWWWWWWi" scrollbar .t2.s -orient horizontal -command ".t2.t xview" grid .t2.t -row 0 -column 0 -sticky nsew grid .t2.s -row 1 -column 0 -sticky ew grid columnconfigure .t2 0 -weight 1 grid rowconfigure .t2 0 -weight 1 grid rowconfigure .t2 1 -weight 0 update ; update set xv [.t2.t xview] set xd [expr {[lindex $xv 1] - [lindex $xv 0]}] .t2.t xview moveto [expr {1.0-$xd}] set iWidth [lindex [.t2.t bbox end-2c] 2] .t2.t xview scroll 2 units set iWidth2 [lindex [.t2.t bbox end-2c] 2] if {($iWidth == $iWidth2) && $iWidth >= 2} { set result "correct" } else { set result "last character is not completely visible when it should be" } } {correct} test textDisp-29.3 {miscellaneous: lines wrap but are still too long} {textfonts} { catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ -wrap char -xscrollcommand ".t2.s set" pack .t2.t -side top scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update .t2.t xview scroll 200 units update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] } [list [list [expr {16.0/30}] 1.0] 300x50+-155+[expr {$fixedDiff + 18}] {}] test textDisp-30.1 {elidden text joining multiple logical lines} { .t2.t delete 1.0 end .t2.t insert 1.0 "1111\n2222\n3333" .t2.t tag configure elidden -elide 1 -background red .t2.t tag add elidden 1.2 3.2 .t2.t count -displaylines 1.0 end } {1} test textDisp-30.2 {elidden text joining multiple logical lines} { .t2.t delete 1.0 end .t2.t insert 1.0 "1111\n2222\n3333" .t2.t tag configure elidden -elide 1 -background red .t2.t tag add elidden 1.2 2.2 .t2.t count -displaylines 1.0 end } {2} catch {destroy .t2} .t configure -height 1 update test textDisp-31.1 {line embedded window height update} { set res {} .t delete 1.0 end .t insert end "abcd\nefgh\nijkl\nmnop\nqrst\nuvwx\nyx" frame .t.f -background red -width 100 -height 100 .t window create 3.0 -window .t.f lappend res [.t count -update -ypixels 1.0 end] .t.f configure -height 10 lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res } [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 6}] [expr {$fixedHeight * 7}]] test textDisp-31.2 {line update index shifting} { set res {} .t.f configure -height 100 update lappend res [.t count -update -ypixels 1.0 end] .t.f configure -height 10 .t insert 1.0 "abc\n" .t insert 1.0 "abc\n" lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] .t.f configure -height 100 .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res } [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-31.3 {line update index shifting} { # Should do exactly the same as the above, as long # as we are correctly tagging the correct lines for # recalculation. The 'update' and 'delay' must be # long enough to ensure all asynchronous updates # have been performed. set res {} .t.f configure -height 100 update lappend res [.t count -update -ypixels 1.0 end] .t.f configure -height 10 .t insert 1.0 "abc\n" .t insert 1.0 "abc\n" lappend res [.t count -ypixels 1.0 end] update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] .t.f configure -height 100 .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] set res } [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-31.4 {line embedded image height update} { set res {} image create photo textest -height 100 -width 10 .t delete 3.0 .t image create 3.0 -image textest update lappend res [.t count -update -ypixels 1.0 end] textest configure -height 10 lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res } [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 6}] [expr {$fixedHeight * 7}]] test textDisp-31.5 {line update index shifting} { set res {} textest configure -height 100 update ; after 1000 ; update lappend res [.t count -update -ypixels 1.0 end] textest configure -height 10 .t insert 1.0 "abc\n" .t insert 1.0 "abc\n" lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] textest configure -height 100 .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res } [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-31.6 {line update index shifting} { # Should do exactly the same as the above, as long # as we are correctly tagging the correct lines for # recalculation. The 'update' and 'delay' must be # long enough to ensure all asynchronous updates # have been performed. set res {} textest configure -height 100 update ; after 1000 ; update lappend res [.t count -update -ypixels 1.0 end] textest configure -height 10 .t insert 1.0 "abc\n" .t insert 1.0 "abc\n" lappend res [.t count -ypixels 1.0 end] update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] textest configure -height 100 .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] set res } [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-31.7 {line update index shifting, elided} { # The 'update' and 'delay' must be long enough to ensure all # asynchronous updates have been performed. set res {} .t delete 1.0 end lappend res [.t count -update -ypixels 1.0 end] .t insert 1.0 "abc\nabc" .t insert 1.0 "abc\n" lappend res [.t count -update -ypixels 1.0 end] .t tag configure elide -elide 1 .t tag add elide 1.3 2.1 lappend res [.t count -ypixels 1.0 end] update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] set res } [list [expr {$fixedHeight * 1}] [expr {$fixedHeight * 3}] [expr {$fixedHeight * 3}] [expr {$fixedHeight * 2}] [expr {$fixedHeight * 1}] [expr {$fixedHeight * 1}]] test textDisp-32.0 {everything elided} { # Must not crash pack [text .tt] .tt insert 0.0 HELLO .tt tag configure HIDE -elide 1 .tt tag add HIDE 0.0 end update ; update ; update ; update destroy .tt } {} test textDisp-32.1 {everything elided} { # Must not crash pack [text .tt] update .tt insert 0.0 HELLO update .tt tag configure HIDE -elide 1 update .tt tag add HIDE 0.0 end update ; update ; update ; update destroy .tt } {} test textDisp-32.2 {elide and tags} { pack [text .tt -height 30 -width 100 -bd 0 \ -highlightthickness 0 -padx 0] .tt insert end \ {test text using tags 1 and 3 } \ {testtag1 testtag3} \ {[this bit here uses tags 2 and 3]} \ {testtag2 testtag3} update # indent left margin of tag 1 by 20 pixels # text should be indented .tt tag configure testtag1 -lmargin1 20 ; update #1 set res {} lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] # hide tag 1, remaining text should not be indented, since # the indented tag and character is hidden. .tt tag configure testtag1 -elide 1 ; update #2 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] # reset .tt tag configure testtag1 -lmargin1 0 .tt tag configure testtag1 -elide 0 # indent left margin of tag 2 by 20 pixels # text should not be indented, since tag1 has lmargin1 of 0. .tt tag configure testtag2 -lmargin1 20 ; update #3 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] # hide tag 1, remaining text should now be indented, but # the bbox of 1.0 should have zero width and zero indent, # since it is elided at that position. .tt tag configure testtag1 -elide 1 ; update #4 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] # reset .tt tag configure testtag2 -lmargin1 {} .tt tag configure testtag1 -elide 0 # indent left margin of tag 3 by 20 pixels # text should be indented, since this tag takes # precedence over testtag1, and is applied to the # start of the text. .tt tag configure testtag3 -lmargin1 20 ; update #5 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] # hide tag 1, remaining text should still be indented, # since it still has testtag3 on it. Again the # bbox of 1.0 should have 0. .tt tag configure testtag1 -elide 1 ; update #6 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] .tt tag configure testtag3 -lmargin1 {} -elide 0 .tt tag configure testtag1 -elide 1 -lmargin1 20 #7 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] destroy .tt set res } {{1.0 20 20} {1.29 0 0} {1.0 0 0} {1.29 0 20}\ {1.0 20 20} {1.29 0 20} {1.0 20 20}} test textDisp-32.3 "NULL undisplayProc problems: #1791052" -setup { set img [image create photo -data { R0lGODlhEgASANUAAAAAAP/////iHP/mIPrWDPraEP/eGPfOAPbKAPbOBPrS CP/aFPbGAPLCAPLGAN62ANauAMylAPbCAPW/APK+AN6uALKNAPK2APK5ANal AOyzArGHBZp3B+6uAHFVBFVACO6qAOqqAOalAMGMAbF+Am1QBG5QBeuiAOad AM6NAJ9vBW1MBFlACFQ9CVlBCuaZAOKVANyVAZlpBMyFAKZtBJVhBEAUEP// /wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADcALAAAAAASABIAAAa+ wJtw+Ckah0iiZwNhODKk0icp/HAShEKBoEBgVFOkK0Iw2GyCs+BAGbGIlrIt EJjXBYgL6X3zJMx1Z2d3EyEmNx9xaYGCdwgaNEUPBYt0do4XKUUOlAOCnmcD CwcXMZsEAgOqq6oLBY+mHxUKBqysCwQSIDNFJAidtgKjFyeRfRQHB2ipAmZs IDArVSTIyoI2bB0oxkIsIxcNyeIXICh7SR8yIhoXFxogJzE1YegrNCkoLzM0 K/RUiEY+tKASBAA7 }] destroy .tt } -body { text .tt .tt tag configure emoticon -elide 1 .tt insert end X .tt mark set MSGLEFT "end - 1 char" .tt mark gravity MSGLEFT left .tt insert end ":)" emoticon .tt image create end -image $img pack .tt update; update; update } -cleanup { image delete $img destroy .tt } test textDisp-33.0 {one line longer than fits in the widget} { pack [text .tt -wrap char] .tt insert 1.0 [string repeat "more wrap + " 300] update ; update ; update .tt see 1.0 lindex [.tt yview] 0 } {0.0} test textDisp-33.1 {one line longer than fits in the widget} { destroy .tt pack [text .tt -wrap char] .tt insert 1.0 [string repeat "more wrap + " 300] update ; update ; update .tt yview "1.0 +1 displaylines" if {[lindex [.tt yview] 0] > 0.1} { set result "window should be scrolled to the top" } else { set result "ok" } } {ok} test textDisp-33.2 {one line longer than fits in the widget} { destroy .tt pack [text .tt -wrap char] .tt debug 1 set tk_textHeightCalc "" .tt insert 1.0 [string repeat "more wrap + " 1] after 100 ; update idletasks # Nothing should have been recalculated. set tk_textHeightCalc } {} test textDisp-33.3 {one line longer than fits in the widget} { destroy .tt pack [text .tt -wrap char] .tt debug 1 set tk_textHeightCalc "" .tt insert 1.0 [string repeat "more wrap + " 300] update ; .tt count -update -ypixels 1.0 end ; update # Each line should have been recalculated just once .tt debug 0 expr {[llength $tk_textHeightCalc] == [.tt count -displaylines 1.0 end]} } {1} test textDisp-33.4 {one line longer than fits in the widget} { destroy .tt pack [text .tt -wrap char] .tt debug 1 set tk_textHeightCalc "" .tt insert 1.0 [string repeat "more wrap + " 300] update ; update ; update set idx [.tt index "1.0 + 1 displaylines"] .tt yview $idx if {[lindex [.tt yview] 0] > 0.1} { set result "window should be scrolled to the top" } else { set result "ok" } set idx [.tt index "1.0 + 1 displaylines"] .tt debug 0 set result } {ok} destroy .tt test textDisp-33.5 {bold or italic fonts} win { destroy .tt pack [text .tt -wrap char -font {{MS Sans Serif} 15}] font create no -family [lindex [.tt cget -font] 0] -size 24 font create bi -family [lindex [.tt cget -font] 0] -size 24 font configure bi -weight bold -slant italic .tt tag configure bi -font bi .tt tag configure no -font no .tt insert end abcd no efgh bi ijkl\n no update set bb {} for {set i 0} {$i < 12} {incr i 4} { lappend bb [lindex [.tt bbox 1.$i] 0] } foreach {a b c} $bb {} unset bb if {($b - $a) * 1.5 < ($c - $b)} { set result "italic font has much too much space" } else { set result "italic font measurement ok" } } {italic font measurement ok} destroy .tt test textDisp-34.1 {Text widgets multi-scrolling problem: Bug 2677890} -setup { pack [text .t1 -width 10 -yscrollcommand {.sy set}] \ [ttk::scrollbar .sy -orient vertical -command {.t1 yview}] \ -side left -fill both bindtags .sy {}; # No clicky! set txt "" for {set i 0} {$i < 99} {incr i} { lappend txt "$i" [list pc $i] "\n" "" } set result {} } -body { .t1 insert end {*}$txt update lappend result [.sy get] .t1 replace 6.0 6.0+1c "*" lappend result [.sy get] after 0 {lappend result [.sy get]} after 1000 {lappend result [.sy get]} vwait result;vwait result return $result } -cleanup { destroy .t1 .sy } -result {{0.0 0.24} {0.0 0.24} {0.0 0.24} {0.0 0.24}} test textDisp-35.1 {Init value of charHeight - Dancing scrollbar bug 1499165} -setup { pack [text .t1] -fill both -expand y -side left .t insert end "[string repeat a\nb\nc\n 500000]THE END\n" set res {} } -body { .t see 10000.0 after 300 {set fr1 [.t yview] ; set done 1} vwait done after 300 {set fr2 [.t yview] ; set done 1} vwait done lappend res [expr {[lindex $fr1 0] == [lindex $fr2 0]}] lappend res [expr {[lindex $fr1 1] == [lindex $fr2 1]}] } -cleanup { destroy .t1 } -result {1 1} deleteWindows option clear # cleanup cleanupTests return tk8.5.19/tests/panedwindow.test0000644003604700454610000026425112612445655015160 0ustar dgp771div# This file is a Tcl script to test entry widgets in Tk. It is # organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands set i 1 panedwindow .p foreach {testName testData} { panedwindow-1.1 {-background "#ff0000" "#ff0000" non-existent {unknown color name "non-existent"}} panedwindow-1.2 {-bd 4 4 badValue {bad screen distance "badValue"}} panedwindow-1.3 {-bg "#ff0000" "#ff0000" non-existent {unknown color name "non-existent"}} panedwindow-1.4 {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} panedwindow-1.5 {-cursor arrow arrow badValue {bad cursor spec "badValue"}} panedwindow-1.6 {-handlesize 20 20 badValue {bad screen distance "badValue"}} panedwindow-1.7 {-height 20 20 badValue {bad screen distance "badValue"}} panedwindow-1.8 {-opaqueresize true 1 foo {expected boolean value but got "foo"}} panedwindow-1.9 {-proxybackground "#f0a0a0" "#f0a0a0" non-existent {unknown color name "non-existent"}} panedwindow-1.10 {-proxyborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}} panedwindow-1.11 {-proxyrelief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} panedwindow-1.12 {-orient horizontal horizontal badValue {bad orient "badValue": must be horizontal or vertical}} panedwindow-1.13 {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} panedwindow-1.14 {-sashcursor arrow arrow badValue {bad cursor spec "badValue"}} panedwindow-1.15 {-sashpad 1.3 1 badValue {bad screen distance "badValue"}} panedwindow-1.16 {-sashrelief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} panedwindow-1.17 {-sashwidth 10 10 badValue {bad screen distance "badValue"}} panedwindow-1.18 {-showhandle true 1 foo {expected boolean value but got "foo"}} panedwindow-1.19 {-width 402 402 badValue {bad screen distance "badValue"}} } { lassign $testData optionName goodIn goodOut badIn badOut test ${testName}(good) "configuration options: $optionName" { .p configure $optionName $goodIn list [lindex [.p configure $optionName] 4] [.p cget $optionName] } [list $goodOut $goodOut] test ${testName}(bad) "configuration options: $optionName" -body { .p configure $optionName $badIn } -returnCodes error -result $badOut # Reset to default .p configure $optionName [lindex [.p configure $optionName] 3] } .p add [button .b] .p add [button .c] foreach {testName testData} { panedwindow-1a.1 {-after .c .c badValue {bad window path name "badValue"}} panedwindow-1a.2 {-before .c .c badValue {bad window path name "badValue"}} panedwindow-1a.3 {-height 10 10 badValue {bad screen distance "badValue"}} panedwindow-1a.4 {-hide false 0 foo {expected boolean value but got "foo"}} panedwindow-1a.5 {-minsize 10 10 badValue {bad screen distance "badValue"}} panedwindow-1a.6 {-padx 1.3 1 badValue {bad screen distance "badValue"}} panedwindow-1a.7 {-pady 1.3 1 badValue {bad screen distance "badValue"}} panedwindow-1a.8 {-sticky nsew nesw abcd {bad stickyness value "abcd": must be a string containing zero or more of n, e, s, and w}} panedwindow-1a.9 {-stretch alw always foo {bad stretch "foo": must be always, first, last, middle, or never}} panedwindow-1a.10 {-width 10 10 badValue {bad screen distance "badValue"}} } { lassign $testData optionName goodIn goodOut badIn badOut test ${testName}(good) "configuration options: $optionName" { .p paneconfigure .b $optionName $goodIn list [lindex [.p paneconfigure .b $optionName] 4] \ [.p panecget .b $optionName] } [list $goodOut $goodOut] test ${testName}(bad) "configuration options: $optionName" -body { .p paneconfigure .b $optionName $badIn } -returnCodes error -result $badOut # Reset to default .p paneconfig .b $optionName [lindex [.p paneconfig .b $optionName] 3] } destroy .p .b .c test panedwindow-2.1 {panedwindow widget command} { panedwindow .p set result [list [catch {.p foo} msg] $msg] destroy .p set result } {1 {bad command "foo": must be add, cget, configure, forget, identify, panecget, paneconfigure, panes, proxy, or sash}} test panedwindow-3.1 {panedwindow panes subcommand} { panedwindow .p .p add [button .b] .p add [button .c] set result [list [.p panes]] .p forget .b lappend result [.p panes] destroy .p .b .c set result } [list [list .b .c] [list .c]] test panedwindow-4.1 {forget subcommand} { panedwindow .p set result [list [catch {.p forget} msg] $msg] destroy .p set result } [list 1 "wrong # args: should be \".p forget widget ?widget ...?\""] test panedwindow-4.2 {forget subcommand, forget one from start} { panedwindow .p .p add [button .b] .p add [button .c] set result [list [.p panes]] .p forget .b lappend result [.p panes] destroy .p .b .c set result } [list {.b .c} .c] test panedwindow-4.3 {forget subcommand, forget one from end} { panedwindow .p .p add [button .b] .p add [button .c] .p add [button .d] set result [list [.p panes]] .p forget .d update lappend result [.p panes] destroy .p .b .c .d set result } [list {.b .c .d} {.b .c}] test panedwindow-4.4 {forget subcommand, forget multiple} { panedwindow .p .p add [button .b] .p add [button .c] .p add [button .d] set result [list [.p panes]] .p forget .b .c update lappend result [.p panes] destroy .p .b .c .d set result } [list {.b .c .d} .d] test panedwindow-4.5 {forget subcommand, panes are unmapped} { panedwindow .p .p add [button .b] .p add [button .c] pack .p update set result [list [winfo ismapped .b] [winfo ismapped .c]] .p forget .b update lappend result [winfo ismapped .b] [winfo ismapped .c] destroy .p .b .c set result } [list 1 1 0 1] test panedwindow-4.6 {forget subcommand, changes reqsize of panedwindow} { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [frame .g -width 20 -height 20] set result [list [winfo reqwidth .p]] .p forget .f lappend result [winfo reqwidth .p] destroy .p .f .g set result } [list 44 20] test panedwindow-5.1 {sash subcommand} { panedwindow .p set result [list [catch {.p sash} msg] $msg] destroy .p set result } [list 1 "wrong # args: should be \".p sash option ?arg ...?\""] test panedwindow-5.2 {sash subcommand} { panedwindow .p set result [list [catch {.p sash foo} msg] $msg] destroy .p set result } [list 1 "bad option \"foo\": must be coord, dragto, mark, or place"] test panedwindow-6.1 {sash coord subcommand, errors} { panedwindow .p set result [list [catch {.p sash coord} msg] $msg] destroy .p set result } [list 1 "wrong # args: should be \".p sash coord index\""] test panedwindow-6.2 {sash coord subcommand, errors} { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 set result [list [catch {.p sash coord 0} msg] $msg] destroy .p set result } [list 1 "invalid sash index"] test panedwindow-6.3 {sash coord subcommand, errors} { panedwindow .p set result [list [catch {.p sash coord foo} msg] $msg] destroy .p set result } [list 1 "expected integer but got \"foo\""] test panedwindow-6.4 {sash coord subcommand sashes correctly placed} { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] set result [.p sash coord 0] destroy .p .p.f .p.f2 .p.f3 set result } [list 22 0] test panedwindow-6.5 {sash coord subcommand sashes correctly placed} { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] set result [.p sash coord 1] destroy .p .p.f .p.f2 .p.f3 set result } [list 50 0] test panedwindow-6.6 {sash coord subcommand, sashes correctly placed} { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -orient vertical \ -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] set result [.p sash coord 0] destroy .p .p.f .p.f2 .p.f3 set result } [list 0 22] test panedwindow-6.7 {sash coord subcommand, sashes correctly placed} { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -orient vertical \ -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] set result [.p sash coord 1] destroy .p .p.f .p.f2 .p.f3 set result } [list 0 50] test panedwindow-6.8 {sash coord subcommand, errors} { panedwindow .p set result [list \ [catch {.p sash coord -1} msg] $msg \ [catch {.p sash coord 0} msg] $msg \ [catch {.p sash coord 1} msg] $msg \ ] destroy .p set result } [list 1 "invalid sash index" 1 "invalid sash index" 1 "invalid sash index"] test panedwindow-6.9 {sash coord subcommand, errors} { # There are no sashes until you have 2 panes panedwindow .p .p add [frame .p.f] set result [list \ [catch {.p sash coord -1} msg] $msg \ [catch {.p sash coord 0} msg] $msg \ [catch {.p sash coord 1} msg] $msg \ ] destroy .p set result } [list 1 "invalid sash index" 1 "invalid sash index" 1 "invalid sash index"] test panedwindow-6.10 {sash coord subcommand, errors} { # There are no sashes until you have 2 panes panedwindow .p .p add [frame .p.f] [frame .p.f2] set result [list \ [catch {.p sash coord -1} msg] $msg \ [catch {.p sash coord 0} msg] \ [catch {.p sash coord 1} msg] $msg \ [catch {.p sash coord 2} msg] $msg \ ] destroy .p set result } [list 1 "invalid sash index" 0 1 "invalid sash index" 1 "invalid sash index"] test panedwindow-8.1 {sash mark subcommand, errors} { panedwindow .p set result [list [catch {.p sash mark} msg] $msg] destroy .p set result } [list 1 "wrong # args: should be \".p sash mark index ?x y?\""] test panedwindow-8.2 {sash mark subcommand, errors} { panedwindow .p set result [list [catch {.p sash mark foo} msg] $msg] destroy .p set result } [list 1 "expected integer but got \"foo\""] test panedwindow-8.3 {sash mark subcommand, errors} { panedwindow .p set result [list [catch {.p sash mark 0 foo bar} msg] $msg] destroy .p set result } [list 1 "invalid sash index"] test panedwindow-8.4 {sash mark subcommand, errors} { panedwindow .p .p add [button .b] [button .c] set result [list [catch {.p sash mark 0 foo bar} msg] $msg] destroy .p .b .c set result } [list 1 "expected integer but got \"foo\""] test panedwindow-8.5 {sash mark subcommand, errors} { panedwindow .p .p add [button .b] [button .c] set result [list [catch {.p sash mark 0 0 bar} msg] $msg] destroy .p .b .c set result } [list 1 "expected integer but got \"bar\""] test panedwindow-8.6 {sash mark subcommand, mark defaults to 0 0} { panedwindow .p .p add [button .b] [button .c] set result [.p sash mark 0] destroy .p .b .c set result } [list 0 0] test panedwindow-8.7 {sash mark subcommand, set mark} { panedwindow .p .p add [button .b] [button .c] .p sash mark 0 10 10 set result [.p sash mark 0] destroy .p .b .c set result } [list 10 10] test panedwindow-9.1 {sash dragto subcommand, errors} { panedwindow .p set result [list [catch {.p sash dragto} msg] $msg] destroy .p set result } [list 1 "wrong # args: should be \".p sash dragto index x y\""] test panedwindow-9.2 {sash dragto subcommand, errors} { panedwindow .p set result [list [catch {.p sash dragto foo bar baz} msg] $msg] destroy .p set result } [list 1 "expected integer but got \"foo\""] test panedwindow-9.3 {sash dragto subcommand, errors} { panedwindow .p set result [list [catch {.p sash dragto 0 foo bar} msg] $msg] destroy .p set result } [list 1 "invalid sash index"] test panedwindow-9.4 {sash dragto subcommand, errors} { panedwindow .p .p add [button .b] [button .c] set result [list [catch {.p sash dragto 0 foo bar} msg] $msg] destroy .p .b .c set result } [list 1 "expected integer but got \"foo\""] test panedwindow-9.5 {sash dragto subcommand, errors} { panedwindow .p .p add [button .b] [button .c] set result [list [catch {.p sash dragto 0 0 bar} msg] $msg] destroy .p .b .c set result } [list 1 "expected integer but got \"bar\""] test panedwindow-10.1 {sash mark/sash dragto interaction} { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c -text foobar] .p sash mark 0 10 10 .p sash dragto 0 20 10 set result [.p sash coord 0] destroy .p .f .c set result } [list 30 0] test panedwindow-10.2 {sash mark/sash dragto interaction} { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -orient vertical \ -showhandle false .p add [frame .p.f -width 20 -height 20] [button .p.c -text foobar] .p sash mark 0 10 10 .p sash dragto 0 10 20 set result [.p sash coord 0] destroy .p .p.f .p.c set result } [list 0 30] test panedwindow-10.3 {sash mark/sash dragto, respects minsize} { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c] -minsize 15 .p sash mark 0 20 10 .p sash dragto 0 10 10 set result [.p sash coord 0] destroy .p .f .c set result } [list 15 0] test panedwindow-11.1 {sash place subcommand, errors} { panedwindow .p set result [list [catch {.p sash place} msg] $msg] destroy .p set result } [list 1 "wrong # args: should be \".p sash place index x y\""] test panedwindow-11.2 {sash place subcommand, errors} { destroy .p panedwindow .p list [catch {.p sash place foo bar baz} msg] $msg } [list 1 "expected integer but got \"foo\""] test panedwindow-11.3 {sash place subcommand, errors} { destroy .p panedwindow .p list [catch {.p sash place 0 foo bar} msg] $msg } [list 1 "invalid sash index"] test panedwindow-11.4 {sash place subcommand, errors} { destroy .p .b .c panedwindow .p .p add [button .b] [button .c] list [catch {.p sash place 0 foo bar} msg] $msg } [list 1 "expected integer but got \"foo\""] test panedwindow-11.5 {sash place subcommand, errors} { destroy .p .f .c .b panedwindow .p .p add [button .b] [button .c] list [catch {.p sash place 0 0 bar} msg] $msg } [list 1 "expected integer but got \"bar\""] test panedwindow-11.6 {sash place subcommand, moves sash} { destroy .p .f .c .b panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [button .c] .p sash place 0 10 0 .p sash coord 0 } [list 10 0] test panedwindow-11.7 {sash place subcommand, moves sash} { destroy .p .f .c panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -orient vertical .p add [frame .f -width 20 -height 20] [button .c] .p sash place 0 0 10 .p sash coord 0 } [list 0 10] test panedwindow-11.8 {sash place subcommand, respects minsize} { destroy .p .f .c panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c] -minsize 15 .p sash place 0 10 0 .p sash coord 0 } [list 15 0] test panedwindow-11.9 {sash place subcommand, respects minsize} { destroy .p .f .c panedwindow .p .p add [frame .f -width 20 -height 20 -bg pink] list [catch {.p sash place 0 2 0} msg] $msg } [list 1 {invalid sash index}] test panedwindow-12.1 {moving sash changes size of pane to left} { destroy .p .f .c panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c -text foobar] -sticky nsew .p sash place 0 30 0 pack .p update winfo width .f } 30 test panedwindow-12.2 {moving sash changes size of pane to right} { destroy .p .f .f2 panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [frame .f2 -width 20 -height 20] pack .p update set result [winfo width .f2] .p sash place 0 30 0 update lappend result [winfo width .f2] } {20 10} test panedwindow-12.3 {moving sash does not change reqsize of panedwindow} { destroy .p .f .f2 panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [frame .f2 -width 20 -height 20] .p sash place 0 30 0 winfo reqwidth .p } 44 test panedwindow-12.4 {moving sash changes size of pane above} { destroy .p .f .c panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [button .c -text foobar] -sticky nsew .p sash place 0 0 20 pack .p update set result [winfo height .f] destroy .p .f .c set result } 20 test panedwindow-12.5 {moving sash changes size of pane below} { destroy .p .f .f2 panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10] pack .p update set result [winfo height .f2] .p sash place 0 0 15 update lappend result [winfo height .f2] destroy .p .f .f2 set result } {10 5} test panedwindow-12.6 {moving sash does not change reqsize of panedwindow} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10] set result [winfo reqheight .p] .p sash place 0 0 20 lappend result [winfo reqheight .p] destroy .p .f .f2 set result } [list 24 24] test panedwindow-12.7 {moving sash does not alter reqsize of widget} { destroy .p .f .f2 panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10] set result [winfo reqheight .f] .p sash place 0 0 20 lappend result [winfo reqheight .f] destroy .p .f .f2 set result } [list 10 10] test panedwindow-12.8 {moving sash restricted to minsize} { destroy .p .f .c panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [button .c] -minsize 15 .p sash place 0 10 0 pack .p update set result [winfo width .f] destroy .p .f .c set result } 15 test panedwindow-12.10 {moving sash restricted to minsize} { destroy .p .f .c panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 30] [button .c] -minsize 10 .p sash place 0 0 5 pack .p update set result [winfo height .f] destroy .p .f .c set result } 10 test panedwindow-12.12 {moving sash in unmapped window restricted to reqsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] set result [list [.p sash coord 0]] .p sash place 0 100 0 lappend result [.p sash coord 0] destroy .p .f .f2 set result } [list {20 0} {40 0}] test panedwindow-12.13 {moving sash right pushes other sashes} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] .p sash place 0 80 0 set result [list [.p sash coord 0] [.p sash coord 1]] destroy .p .f .f2 .f3 set result } {{60 0} {64 0}} test panedwindow-12.14 {moving sash left pushes other sashes} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] .p sash place 1 0 0 set result [list [.p sash coord 0] [.p sash coord 1]] destroy .p .f .f2 .f3 set result } {{0 0} {4 0}} test panedwindow-12.15 {move sash in mapped window restricted to visible win} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] place .p -width 50 update .p sash place 1 100 0 update set result [.p sash coord 1] destroy .p .f .f2 .f3 set result } {46 0} test panedwindow-12.16 {move sash in mapped window restricted to visible win} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] place .p -width 100 update .p sash place 1 200 0 update set result [.p sash coord 1] destroy .p .f .f2 .f3 set result } {96 0} test panedwindow-12.17 {moving sash into "virtual" space on \ last pane increases reqsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] place .p -width 100 set result [winfo reqwidth .p] update .p sash place 1 200 0 update lappend result [winfo reqwidth .p] destroy .p .f .f2 .f3 set result } {68 100} test panedwindow-13.1 {horizontal panedwindow lays out widgets properly} { panedwindow .p -showhandle false -borderwidth 2 -sashpad 2 -sashwidth 2 foreach win {.p.f .p.f2 .p.f3} {.p add [frame $win -width 20 -height 10]} pack .p update set result {} foreach w [.p panes] {lappend result [winfo x $w] [winfo y $w]} destroy .p .p.f .p.f2 .p.f3 set result } [list 2 2 28 2 54 2] test panedwindow-13.2 {vertical panedwindow lays out widgets properly} { panedwindow .p -showhandle false -borderwidth 2 -sashpad 2 -sashwidth 2 \ -orient vertical foreach win {.p.f .p.f2 .p.f3} {.p add [frame $win -width 20 -height 10]} pack .p update set result {} foreach w [.p panes] {lappend result [winfo x $w] [winfo y $w]} destroy .p .p.f .p.f2 .p.f3 set result } [list 2 2 2 18 2 34] test panedwindow-13.3 {horizontal panedwindow lays out widgets properly} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach {win color} {.p.f blue .p.f2 green} { .p add [frame $win -width 20 -height 20 -bg $color] -padx 10 -pady 5 \ -sticky "" } pack .p update set result [list [winfo reqwidth .p] [winfo reqheight .p]] foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]} .p paneconfigure .p.f -padx 0 -pady 0 update lappend result [winfo reqwidth .p] [winfo reqheight .p] foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]} destroy .p .p.f .p.f2 set result } [list 80 30 10 5 50 5 60 30 0 5 30 5] test panedwindow-13.4 {vertical panedwindow lays out widgets properly} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach win {.p.f .p.f2} { .p add [frame $win -width 20 -height 20] -padx 10 -pady 5 -sticky "" } pack .p update set result [list [winfo reqwidth .p] [winfo reqheight .p]] foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]} .p paneconfigure .p.f -padx 0 -pady 0 update lappend result [winfo reqwidth .p] [winfo reqheight .p] foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]} destroy .p .p.f .p.f2 set result } [list 40 60 10 5 10 35 40 50 10 0 10 25] test panedwindow-13.5 {panedwindow respects reqsize of panes when possible} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -sticky "" place .p -width 40 update set result [list [winfo width .p.f]] .p.f configure -width 30 update lappend result [winfo width .p.f] destroy .p .p.f set result } [list 20 30] test panedwindow-13.6 {panedwindow takes explicit widget width over reqwidth} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -width 20 -sticky "" place .p -width 40 update set result [list [winfo width .p.f]] .p.f configure -width 30 update lappend result [winfo width .p.f] destroy .p .p.f set result } [list 20 20] test panedwindow-13.7 {horizontal panedwindow reqheight is max slave height} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .p.f -width 20 -height 20] [frame .p.f2 -width 20 -height 20] set result [winfo reqheight .p] .p.f config -height 40 lappend result [winfo reqheight .p] destroy .p .p.f .p.f2 set result } {20 40} test panedwindow-13.8 {horizontal panedwindow reqheight is max slave height} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} .p paneconfigure .p.f -height 15 set result [winfo reqheight .p] .p.f config -height 40 lappend result [winfo reqheight .p] destroy .p .p.f .p.f2 set result } {20 20} test panedwindow-13.9 {panedwindow pane width overrides widget width} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} .p sash place 0 10 0 pack .p update set result [winfo width .p.f] .p paneconfigure .p.f -width 30 lappend result [winfo width .p.f] destroy .p .p.f .p.f2 set result } [list 10 10] test panedwindow-13.10 {panedwindow respects reqsize of panes when possible} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -sticky "" place .p -height 40 update set result [list [winfo height .p.f]] .p.f configure -height 30 update lappend result [winfo height .p.f] destroy .p .p.f set result } [list 20 30] test panedwindow-13.11 {panedwindow takes explicit height over reqheight} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -height 20 -sticky "" place .p -height 40 update set result [list [winfo height .p.f]] .p.f configure -height 30 update lappend result [winfo height .p.f] destroy .p .p.f set result } [list 20 20] test panedwindow-13.12 {vertical panedwindow reqwidth is max slave width} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .p.f -width 20 -height 20] [frame .p.f2 -width 20 -height 20] set result [winfo reqwidth .p] .p.f config -width 40 lappend result [winfo reqwidth .p] destroy .p .p.f .p.f2 set result } {20 40} test panedwindow-13.13 {vertical panedwindow reqwidth is max slave width} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} .p paneconfigure .p.f -width 15 set result [winfo reqwidth .p] .p.f config -width 40 lappend result [winfo reqwidth .p] destroy .p .p.f .p.f2 set result } {20 20} test panedwindow-13.14 {panedwindow pane height overrides widget width} { destroy .p panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} .p sash place 0 0 10 pack .p update set result [winfo height .p.f] .p paneconfigure .p.f -height 30 lappend result [winfo height .p.f] destroy .p set result } [list 10 10] test panedwindow-14.1 {PanestructureProc, widget yields managements} { # Check that the panedwindow correctly yields geometry management of # a slave when the slave is destroyed. # This test should not cause a core dump, and it should not cause # a memory leak. destroy .p .b panedwindow .p .p add [button .b] destroy .p pack .b destroy .b set result "" } "" test panedwindow-14.2 {PanedWindowLostSlaveProc, widget yields management} { # Check that the paned window correctly yields geometry management of # a slave when some other geometry manager steals the slave from us. # This test should not cause a core dump, and it should not cause a # memory leak. destroy .p .b panedwindow .p .p add [button .b] pack .p update pack .b update set result [.p panes] destroy .p .b set result } {} set stickysets [list n s e w sn ns en ne wn nw esn nse nsw nsew ""] set stickygets [list n s e w ns ns ne ne nw nw nes nes nsw nesw ""] set i 0 foreach s $stickysets g $stickygets { test panedwindow-15.[incr i] {panedwindow sticky settings} { destroy .p .b panedwindow .p -showhandle false .p add [button .b] .p paneconfigure .b -sticky $s set result [.p panecget .b -sticky] destroy .p .b set result } $g } set i 0 foreach s [list {} n s e w ns ew nw ne se sw nse nsw sew new news] \ x [list 10 10 10 20 0 10 0 0 20 20 0 20 0 0 0 0] \ y [list 10 0 20 10 10 0 10 0 0 20 20 0 0 20 0 0] \ w [list 20 20 20 20 20 20 40 20 20 20 20 20 20 40 40 40] \ h [list 20 20 20 20 20 40 20 20 20 20 20 40 40 20 20 40] { test panedwindow-16.[incr i] {panedwindow sticky works} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -height 20 -width 20 -bg red] -sticky $s place .p -width 40 -height 40 update set result [list $s [winfo x .p.f] [winfo y .p.f] \ [winfo width .p.f] [winfo height .p.f]] destroy .p .p.f set result } [list $s $x $y $w $h] } test panedwindow-17.1 {setting minsize when pane is too small snaps width} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .p.f -height 20 -width 20 -bg red] set result [winfo reqwidth .p] .p paneconfigure .p.f -minsize 40 lappend result [winfo reqwidth .p] destroy .p .p.f .p.f2 set result } [list 20 40] test panedwindow-18.1 {MoveSash, move right} { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window lappend result [winfo reqwidth .p] .p sash place 0 30 0 # Get the reqwidth again, to make sure it hasn't changed lappend result [winfo reqwidth .p] # Check that the sash moved lappend result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 42 42 {30 0}] test panedwindow-18.2 {MoveSash, move right (unmapped) clipped by reqwidth} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 100 0 # Get the new sash coord; it should be clipped by the reqwidth of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 40 0] test panedwindow-18.3 {MoveSash, move right (mapped, width < reqwidth) clipped by width} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a width < reqwidth place .p -x 0 -y 0 -width 32 update .p sash place 0 100 0 # Get the new sash coord; it should be clipped by the visible width of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 30 0] test panedwindow-18.4 {MoveSash, move right (mapped, width > reqwidth) clipped by width} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a width > reqwidth place .p -x 0 -y 0 -width 102 update .p sash place 0 200 0 # Get the new sash coord; it should be clipped by the visible width of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 100 0] test panedwindow-18.5 {MoveSash, move right respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 30 0] test panedwindow-18.6 {MoveSash, move right respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 40 0] test panedwindow-18.7 {MoveSash, move right pushes other sashes} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 62 0] test panedwindow-18.8 {MoveSash, move right pushes other sashes, respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 52 0] test panedwindow-18.9 {MoveSash, move right respects minsize, exludes pad} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize 10 -padx 5 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 50 0] test panedwindow-18.10 {MoveSash, move right, negative minsize becomes 0} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize -50 } .p sash place 0 50 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [list [.p sash coord 0] [.p sash coord 1]] # Cleanup destroy .p .f1 .f2 .f3 set result } [list [list 50 0] [list 52 0]] test panedwindow-18.11 {MoveSash, move left} { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window lappend result [winfo reqwidth .p] .p sash place 0 10 0 # Get the reqwidth again, to make sure it hasn't changed lappend result [winfo reqwidth .p] # Check that the sash moved lappend result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 42 42 {10 0}] test panedwindow-18.12 {MoveSash, move left, can't move outside of window} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 -100 0 # Get the new sash coord; it should be clipped by the reqwidth of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 0 0] test panedwindow-18.13 {MoveSash, move left respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 10 0] test panedwindow-18.14 {MoveSash, move left respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 22 0] test panedwindow-18.15 {MoveSash, move left pushes other sashes} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 0] test panedwindow-18.16 {MoveSash, move left pushes other sashes, respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 10 0] test panedwindow-18.17 {MoveSash, move left respects minsize, exludes pad} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize 10 -padx 5 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 42 0] test panedwindow-18.18 {MoveSash, move left, negative minsize becomes 0} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue green} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize -50 } .p sash place 1 10 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [list [.p sash coord 0] [.p sash coord 1]] # Cleanup destroy .p .f1 .f2 .f3 set result } [list [list 8 0] [list 10 0]] test panedwindow-19.1 {MoveSash, move down} { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window lappend result [winfo reqheight .p] .p sash place 0 0 30 # Get the reqwidth again, to make sure it hasn't changed lappend result [winfo reqheight .p] # Check that the sash moved lappend result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 42 42 {0 30}] test panedwindow-19.2 {MoveSash, move down (unmapped) clipped by reqheight} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 0 100 # Get the new sash coord; it should be clipped by the reqheight of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 0 40] test panedwindow-19.3 {MoveSash, move down (mapped, height < reqheight) clipped by height} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a height < reqheight place .p -x 0 -y 0 -height 32 update .p sash place 0 0 100 # Get the new sash coord; it should be clipped by the visible height of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 0 30] test panedwindow-19.4 {MoveSash, move down (mapped, height > reqheight) clipped by height} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a width > reqwidth place .p -x 0 -y 0 -height 102 update .p sash place 0 0 200 # Get the new sash coord; it should be clipped by the visible width of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 0 100] test panedwindow-19.5 {MoveSash, move down respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 0 30] test panedwindow-19.6 {MoveSash, move down respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 40] test panedwindow-19.7 {MoveSash, move down pushes other sashes} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 62] test panedwindow-19.8 {MoveSash, move down pushes other sashes, respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 52] test panedwindow-19.9 {MoveSash, move down respects minsize, exludes pad} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize 10 -pady 5 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 50] test panedwindow-19.10 {MoveSash, move right, negative minsize becomes 0} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize -50 } .p sash place 0 0 50 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [list [.p sash coord 0] [.p sash coord 1]] # Cleanup destroy .p .f1 .f2 .f3 set result } [list [list 0 50] [list 0 52]] test panedwindow-19.11 {MoveSash, move up} { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window lappend result [winfo reqheight .p] .p sash place 0 0 10 # Get the reqwidth again, to make sure it hasn't changed lappend result [winfo reqheight .p] # Check that the sash moved lappend result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 42 42 {0 10}] test panedwindow-19.12 {MoveSash, move up, can't move outside of window} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 0 -100 # Get the new sash coord; it should be clipped by the reqwidth of # the panedwindow. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 0 0] test panedwindow-19.13 {MoveSash, move up respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 set result } [list 0 10] test panedwindow-19.14 {MoveSash, move up respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 22] test panedwindow-19.15 {MoveSash, move up pushes other sashes} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 0] test panedwindow-19.16 {MoveSash, move up pushes other sashes, respects minsize} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. set result [.p sash coord 0] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 10] test panedwindow-19.17 {MoveSash, move up respects minsize, exludes pad} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize 10 -pady 5 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [.p sash coord 1] # Cleanup destroy .p .f1 .f2 .f3 set result } [list 0 42] test panedwindow-19.18 {MoveSash, move up, negative minsize becomes 0} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue green} { .p add [frame $w -height 20 -width 20 -bg $c] \ -sticky nsew -minsize -50 } .p sash place 1 0 10 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. set result [list [.p sash coord 0] [.p sash coord 1]] # Cleanup destroy .p .f1 .f2 .f3 set result } [list [list 0 8] [list 0 10]] # The following tests check that the panedwindow is correctly computing its # geometry based on the various configuration options that can affect the # geometry. test panedwindow-20.1 {ComputeGeometry, reqheight taken from widgets} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .f3 configure -height 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f1 .f2 .f3 set result } [list [list 60 20] [list 60 40]] test panedwindow-20.2 {ComputeGeometry, reqheight taken from widgets} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -height 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f1 .f2 .f3 set result } [list [list 60 20] [list 60 40]] test panedwindow-20.3 {ComputeGeometry, reqheight taken from widgets} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] -pady 20 } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -height 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f1 .f2 .f3 set result } [list [list 60 60] [list 60 80]] test panedwindow-20.4 {ComputeGeometry, reqwidth taken from widgets} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .f3 configure -width 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f1 .f2 .f3 set result } [list [list 20 60] [list 40 60]] test panedwindow-20.5 {ComputeGeometry, reqwidth taken from widgets} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -width 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f1 .f2 .f3 set result } [list [list 20 60] [list 40 60]] test panedwindow-20.6 {ComputeGeometry, reqwidth taken from widgets} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] -padx 20 } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -width 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f1 .f2 .f3 set result } [list [list 60 60] [list 80 60]] set i 6 foreach bd {0 2} { foreach sp {0 5} { foreach sw {0 3} { foreach h {0 1} { test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry, one slave, reqsize set properly} { # With just one slave, sashpad and sashwidth should not # affect the panedwindow's geometry, since no sash should # ever be drawn. panedwindow .p -borderwidth $bd -sashpad $sp \ -sashwidth $sw -handlesize 6 -showhandle $h .p add [frame .p.f -width 20 -height 20 -bg red] -padx $h \ -sticky "" set result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .p.f set result } [list [expr {(2 * $bd) + 20 + (2 * $h)}] \ [expr {(2 * $bd) + 20}]] test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry, three panes, reqsize set properly} { panedwindow .p -borderwidth $bd -sashpad $sp \ -sashwidth $sw -handlesize 6 -showhandle $h foreach w {.p.f1 .p.f2 .p.f3} { .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky "" } set result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .p.f1 .p.f2 .p.f3 set result } [list [expr {(2 * $bd) + ($h?12:(2*$sw)) + (4*$sp) + 60}] \ [expr {(2 * $bd) + 20}]] test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry, sash coords} { panedwindow .p -borderwidth $bd -sashpad $sp \ -sashwidth $sw -handlesize 6 -showhandle $h foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky "" } set result [list [.p sash coord 0] [.p sash coord 1]] destroy .p .f1 .f2 .f3 set result } [list [list [expr {$bd+20+($h?(6-$sw)/2:0)+$sp}] $bd] \ [list [expr {$bd+40+($h?6+(6-$sw)/2:$sw)+(3*$sp)}] \ $bd]] test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry/ArrangePanes, slave coords} { panedwindow .p -borderwidth $bd -sashpad $sp \ -sashwidth $sw -handlesize 6 -showhandle $h foreach w {.p.f1 .p.f2 .p.f3} { .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky nsew -pady 3 -padx 11 } pack .p update set result {} foreach w {.p.f1 .p.f2 .p.f3} { lappend result [list [winfo x $w] [winfo y $w] \ [winfo width $w] [winfo height $w]] } destroy .p .p.f1 .p.f2 .p.f3 set result } [list [list [expr {$bd+11}] [expr {$bd+3}] 20 20] \ [list [expr {$bd+53+($h?6:$sw)+(2*$sp)}] \ [expr {$bd+3}] 20 20] \ [list [expr {$bd+95+($h?12:2*$sw)+(4*$sp)}] \ [expr {$bd+3}] 20 20]] test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry, one slave, vertical} { # With just one slave, sashpad and sashwidth should not # affect the panedwindow's geometry, since no sash should # ever be drawn. panedwindow .p -borderwidth $bd -sashpad $sp \ -orient vertical -sashwidth $sw -handlesize 6 \ -showhandle $h .p add [frame .f -width 20 -height 20 -bg red] -pady $h \ -sticky "" set result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f set result } [list [expr {(2 * $bd) + 20}] \ [expr {(2 * $bd) + 20 + (2 * $h)}]] test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry, three panes, vertical} { panedwindow .p -borderwidth $bd -sashpad $sp \ -sashwidth $sw -handlesize 6 -showhandle $h \ -orient vertical foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky "" } set result [list [winfo reqwidth .p] [winfo reqheight .p]] destroy .p .f1 .f2 .f3 set result } [list [expr {(2 * $bd) + 20}] \ [expr {(2 * $bd) + ($h?12:(2*$sw)) + (4*$sp) + 60}]] test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry, sash coords, vertical} { panedwindow .p -borderwidth $bd -sashpad $sp \ -sashwidth $sw -handlesize 6 -showhandle $h \ -orient vertical foreach w {.f1 .f2 .f3} { .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky "" } set result [list [.p sash coord 0] [.p sash coord 1]] destroy .p .f1 .f2 .f3 set result } [list [list $bd [expr {$bd+20+($h?(6-$sw)/2:0)+$sp}]] \ [list $bd \ [expr {$bd+40+($h?6+(6-$sw)/2:$sw)+(3*$sp)}]]] test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ {ComputeGeometry/ArrangePanes, slave coords, vert} { panedwindow .p -borderwidth $bd -sashpad $sp \ -sashwidth $sw -handlesize 6 -showhandle $h \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky nsew -pady 11 -padx 3 } pack .p update set result {} foreach w {.p.f1 .p.f2 .p.f3} { lappend result [list [winfo x $w] [winfo y $w] \ [winfo width $w] [winfo height $w]] } destroy .p .p.f1 .p.f2 .p.f3 set result } [list [list [expr {$bd+3}] [expr {$bd+11}] 20 20] \ [list [expr {$bd+3}] \ [expr {$bd+53+($h?6:$sw)+(2*$sp)}] 20 20] \ [list [expr {$bd+3}] \ [expr {$bd+95+($h?12:2*$sw)+(4*$sp)}] 20 20]] } } } } test panedwindow-21.1 {destroyed widgets are removed from panedwindow} { panedwindow .p .p add [frame .f -width 20 -height 20 -bg blue] destroy .f set result [.p panes] destroy .p set result } {} test panedwindow-21.2 {destroyed slave causes geometry recomputation} { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] destroy .f set result [winfo reqwidth .p] destroy .p .f2 set result } 20 test panedwindow-22.1 {ArrangePanes, extra space is given to the last pane} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -width 100 -x 0 -y 0 update set result [winfo width .f2] destroy .p .f1 .f2 set result } 78 test panedwindow-22.2 {ArrangePanes, extra space is given to the last pane} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -height 100 -x 0 -y 0 update set result [winfo height .f2] destroy .p .f1 .f2 set result } 78 test panedwindow-22.3 {ArrangePanes, explicit height/width are preferred} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky "" .p paneconfigure .f1 -width 10 -height 15 pack .p update set result [list [winfo width .f1] [winfo height .f1]] destroy .p .f1 .f2 set result } {10 15} test panedwindow-22.4 {ArrangePanes, panes clipped by size of pane} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] .p sash place 0 10 0 pack .p update set result [list [winfo width .f1] [winfo height .f1]] destroy .p .f1 .f2 set result } {10 20} test panedwindow-22.5 {ArrangePanes, panes clipped by size of pane} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] .p sash place 0 0 10 pack .p update set result [list [winfo width .f1] [winfo height .f1]] destroy .p .f1 .f2 set result } {20 10} test panedwindow-22.6 {ArrangePanes, height of pane taken from total height} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 20 -height 40 -bg red] -sticky "" pack .p update set result [list [winfo y .p.f1]] destroy .p .p.f1 .p.f2 set result } 10 test panedwindow-22.8 {ArrangePanes, width of pane taken from total width} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 40 -height 40 -bg red] -sticky "" pack .p update set result [list [winfo x .p.f1]] destroy .p .p.f1 .p.f2 set result } 10 test panedwindow-22.9 {ArrangePanes, panes with width <= 0 are unmapped} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 40 -bg red] pack .p update set result [winfo ismapped .f1] .p sash place 0 0 0 update lappend result [winfo ismapped .f1] destroy .p .f1 .f2 set result } {1 0} test panedwindow-22.10 {ArrangePanes, panes with width <= 0 are unmapped} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 20 -height 40 -bg red] pack .p update set result [winfo ismapped .p.f1] .p sash place 0 0 0 update lappend result [winfo ismapped .p.f1] destroy .p .p.f1 .p.f2 set result } {1 0} test panedwindow-22.11 {ArrangePanes, panes with width <= 0 are unmapped} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 -orient vertical .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 20 -height 40 -bg red] pack .p update set result [winfo ismapped .p.f1] .p sash place 0 0 0 update lappend result [winfo ismapped .p.f1] destroy .p .p.f1 .p.f2 set result } {1 0} test panedwindow-22.12 {ArrangePanes, last pane shrinks} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -width 40 -x 0 -y 0 update set result [winfo width .f2] destroy .p .f1 .f2 set result } 18 test panedwindow-22.13 {ArrangePanes, last pane shrinks} { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -height 40 -x 0 -y 0 update set result [winfo height .f2] destroy .p .f1 .f2 set result } 18 test panedwindow-22.14 {ArrangePanes, panedwindow resizes} { -body { panedwindow .p -width 200 -borderwidth 0 frame .f1 -height 50 -bg blue set result [list] lappend result [winfo reqwidth .p] [winfo reqheight .p] .p add .f1 pack .p lappend result [winfo reqwidth .p] [winfo reqheight .p] } -cleanup {destroy .p .f1} -result {200 1 200 50} } test panedwindow-22.15 {ArrangePanes, panedwindow resizes} { -body { panedwindow .p -height 200 -borderwidth 0 -orient vertical frame .f1 -width 50 -bg blue set result [list] lappend result [winfo reqwidth .p] [winfo reqheight .p] .p add .f1 pack .p lappend result [winfo reqwidth .p] [winfo reqheight .p] } -cleanup {destroy .p .f1} -result {1 200 50 200} } test panedwindow-22.16 {ArrangePanes, last pane grows} { -body { panedwindow .p -showhandle false -height 50 .p add [frame .f1 -width 50 -bg red] [frame .f2 -width 50 -bg white] \ [frame .f3 -width 50 -bg blue] [frame .f4 -width 50 -bg green] .p sash place 1 250 0 pack .p update set result [list] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] .p configure -width 300 update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] } -cleanup {destroy .p .f1 .f2 .f3 .f4} -result {50 150 1 1 211 50 150 1 89 300} } test panedwindow-23.1 {PanedWindowReqProc, react to slave geometry changes} { # Basically just want to make sure that the PanedWindowReqProc is called panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 40 -bg red] set result [winfo reqheight .p] .f1 configure -height 80 lappend result [winfo reqheight .p] destroy .p .f1 .f2 set result } {40 80} test panedwindow-23.2 {PanedWindowReqProc, react to slave geometry changes} { panedwindow .p -orient horizontal -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 10] [frame .f2 -width 10] set result [winfo reqwidth .p] .f1 configure -width 20 lappend result [winfo reqwidth .p] destroy .p .f1 .f2 expr {[lindex $result 1] - [lindex $result 0]} } {10} test panedwindow-24.1 {ConfigurePanes, can't add panedwindow to itself} { panedwindow .p set result [list [catch {.p add .p} msg] $msg] destroy .p set result } [list 1 "can't add .p to itself"] test panedwindow-24.2 {ConfigurePanes, bad window throws error} { panedwindow .p set result [list [catch {.p add .b} msg] $msg] destroy .p set result } [list 1 "bad window path name \".b\""] test panedwindow-24.3 {ConfigurePanes, bad window aborts processing} { panedwindow .p button .b catch {.p add .b .a} set result [.p panes] destroy .p .b set result } {} test panedwindow-24.4 {ConfigurePanes, bad option aborts processing} { panedwindow .p button .b catch {.p add .b -sticky foobar} set result [.p panes] destroy .p .b set result } {} test panedwindow-24.5 {ConfigurePanes, after win isn't managed by panedwin} { panedwindow .p button .b button .c set result [list [catch {.p add .b -after .c} msg] $msg] destroy .p .b .c set result } [list 1 "window \".c\" is not managed by .p"] test panedwindow-24.6 {ConfigurePanes, before win isn't managed by panedwin} { panedwindow .p button .b button .c set result [list [catch {.p add .b -before .c} msg] $msg] destroy .p .b .c set result } [list 1 "window \".c\" is not managed by .p"] test panedwindow-24.7 {ConfigurePanes, -after {} is a no-op} { panedwindow .p .p add [button .b] [button .c] .p paneconfigure .b -after {} set result [.p panes] destroy .p .b .c set result } {.b .c} test panedwindow-24.8 {ConfigurePanes, -before {} is a no-op} { panedwindow .p .p add [button .b] [button .c] .p paneconfigure .b -before {} set result [.p panes] destroy .p .b .c set result } {.b .c} test panedwindow-24.9 {ConfigurePanes, new panes are added} { panedwindow .p .p add [button .b] [button .c] set result [.p panes] destroy .p .b .c set result } {.b .c} test panedwindow-24.10 {ConfigurePanes, options applied to all panes} { panedwindow .p .p add [button .b] [button .c] -sticky ne -height 5 -width 5 -minsize 10 set result {} foreach w {.b .c} { set val {} foreach option {-sticky -height -width -minsize} { lappend val $option [.p panecget $w $option] } lappend result $w $val } destroy .p .b .c set result } [list .b {-sticky ne -height 5 -width 5 -minsize 10} \ .c {-sticky ne -height 5 -width 5 -minsize 10}] test panedwindow-24.11 {ConfigurePanes, existing panes are reconfigured} { panedwindow .p .p add [button .b] -sticky nw -height 10 .p add .b [button .c] -sticky se -height 2 set result [list [.p panes] \ [.p panecget .b -sticky] [.p panecget .b -height] \ [.p panecget .c -sticky] [.p panecget .c -height]] destroy .p .b .c set result } [list {.b .c} es 2 es 2] test panedwindow-24.12 {ConfigurePanes, widgets added to end by default} { panedwindow .p .p add [button .b] .p add [button .c] .p add [button .d] set result [.p panes] destroy .p .b .c .d set result } {.b .c .d} test panedwindow-24.13 {ConfigurePanes, -after, single addition} { panedwindow .p button .a button .b button .c .p add .a .b .p add .c -after .a set result [.p panes] destroy .p .a .b .c set result } {.a .c .b} test panedwindow-24.14 {ConfigurePanes, -after, multiple additions} { panedwindow .p button .a button .b button .c button .d .p add .a .b .p add .c .d -after .a set result [.p panes] destroy .p .a .b .c .d set result } {.a .c .d .b} test panedwindow-24.15 {ConfigurePanes, -after, relocates existing widget} { panedwindow .p button .a button .b button .c button .d .p add .a .b .c .d .p add .d -after .a set result [.p panes] destroy .p .a .b .c .d set result } {.a .d .b .c} test panedwindow-24.16 {ConfigurePanes, -after, relocates existing widgets} { panedwindow .p button .a button .b button .c button .d .p add .a .b .c .d .p add .b .d -after .a set result [.p panes] destroy .p .a .b .c .d set result } {.a .b .d .c} test panedwindow-24.17 {ConfigurePanes, -after, relocates existing widgets} { panedwindow .p button .a button .b button .c button .d .p add .a .b .c .d .p add .d .a -after .b set result [.p panes] destroy .p .a .b .c .d set result } {.b .d .a .c} test panedwindow-24.18 {ConfigurePanes, -after, relocates existing widgets} { panedwindow .p button .a button .b button .c button .d .p add .a .b .c .d .p add .d .a -after .a set result [.p panes] destroy .p .a .b .c .d set result } {.d .a .b .c} test panedwindow-24.19 {ConfigurePanes, -after, after last window} { panedwindow .p button .a button .b button .c button .d .p add .a .b .c .p add .d -after .c set result [.p panes] destroy .p .a .b .c .d set result } {.a .b .c .d} test panedwindow-24.20 {ConfigurePanes, -before, before first window} { panedwindow .p button .a button .b button .c button .d .p add .a .b .c .p add .d -before .a set result [.p panes] destroy .p .a .b .c .d set result } {.d .a .b .c} test panedwindow-24.21 {ConfigurePanes, -before, relocate existing windows} { panedwindow .p button .a button .b button .c button .d .p add .a .b .c .p add .d .b -before .a set result [.p panes] destroy .p .a .b .c .d set result } {.d .b .a .c} test panedwindow-24.22 {ConfigurePanes, slave specified multiple times} { # This test should not cause a core dump panedwindow .p button .a button .b button .c .p add .a .a .b .c set result [.p panes] destroy .p .a .b .c set result } {.a .b .c} test panedwindow-24.23 {ConfigurePanes, slave specified multiple times} { # This test should not cause a core dump panedwindow .p button .a button .b button .c .p add .a .a .b .c .p add .a .b .a -after .c set result [.p panes] destroy .p .a .b .c set result } {.c .a .b} test panedwindow-24.24 {ConfigurePanes, panedwindow cannot manage toplevels} { panedwindow .p toplevel .t set result [list [catch {.p add .t} msg] $msg] destroy .p .t set result } [list 1 "can't add toplevel .t to .p"] test panedwindow-24.25 {ConfigurePanes, restrict possible panes} { panedwindow .p frame .f button .f.b set result [list [catch {.p add .f.b} msg] $msg] destroy .p .f .f.b set result } [list 1 "can't add .f.b to .p"] test panedwindow-24.26 {ConfigurePanes, restrict possible panes} { frame .f panedwindow .f.p button .b set result [list [catch {.f.p add .b} msg] $msg] destroy .f.p .f .b set result } [list 0 ""] test panedwindow-24.27 {ConfigurePanes, restrict possible panes} { panedwindow .p button .p.b set result [list [catch {.p add .p.b} msg] $msg] destroy .p .p.b set result } [list 0 ""] test panedwindow-24.28 {ConfigurePanes, restrict possible panes} { frame .f frame .f.f frame .f.f.f panedwindow .f.f.f.p button .b set result [list [catch {.f.f.f.p add .b} msg] $msg] destroy .f .f.f .f.f.f .f.f.f.p .b set result } [list 0 ""] test panedwindow-24.29.1 {ConfigurePanes, -hide works} { -body { panedwindow .p -showhandle false frame .f1 -width 40 -height 100 -bg red frame .f2 -width 40 -height 100 -bg white frame .f3 -width 40 -height 100 -bg blue frame .f4 -width 40 -height 100 -bg green .p add .f1 .f2 .f3 .f4 pack .p update set result [list] lappend result [winfo ismapped .f1] [winfo ismapped .f2] \ [winfo ismapped .f3] [winfo ismapped .f4] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] .p paneconfigure .f2 -hide 1 update lappend result [winfo ismapped .f1] [winfo ismapped .f2] \ [winfo ismapped .f3] [winfo ismapped .f4] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] } -cleanup {destroy .p .f1 .f2 .f3 .f4} -result {1 1 1 1 40 40 40 40 171 1 0 1 1 40 40 40 40 128} } test panedwindow-24.29.2 {ConfigurePanes, -hide works} { -body { panedwindow .p -showhandle false -width 130 -height 100 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white frame .f3 -width 40 -bg blue frame .f4 -width 40 -bg green .p add .f1 .f2 .f3 .f4 pack .p update set result [list] lappend result [winfo ismapped .f1] [winfo ismapped .f2] \ [winfo ismapped .f3] [winfo ismapped .f4] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] .p paneconfigure .f2 -hide 1 update lappend result [winfo ismapped .f1] [winfo ismapped .f2] \ [winfo ismapped .f3] [winfo ismapped .f4] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] } -cleanup {destroy .p .f1 .f2 .f3 .f4} -result {1 1 1 0 39 40 40 1 130 1 0 1 1 40 40 40 42 130} } test panedwindow-24.29.3 {ConfigurePanes, -hide works, last pane stretches} { -body { panedwindow .p -showhandle false -width 200 -height 200 -borderwidth 0 frame .f1 -width 50 -bg red frame .f2 -width 50 -bg green frame .f3 -width 50 -bg blue .p add .f1 .f2 .f3 pack .p update set result [list] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] .p paneconfigure .f2 -hide 1 update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] } -cleanup {destroy .p .f1 .f2 .f3} -result {50 50 94 50 50 147} } test panedwindow-24.29.4 {ConfigurePanes, -hide works, last pane stretches} { -body { panedwindow .p -showhandle false -width 200 -height 200 \ -borderwidth 0 -orient vertical frame .f1 -height 50 -bg red frame .f2 -height 50 -bg green frame .f3 -height 50 -bg blue .p add .f1 .f2 .f3 pack .p update set result [list] lappend result [winfo height .f1] [winfo height .f2] [winfo height .f3] .p paneconfigure .f2 -hide 1 update lappend result [winfo height .f1] [winfo height .f2] [winfo height .f3] } -cleanup {destroy .p .f1 .f2 .f3} -result {50 50 94 50 50 147} } test panedwindow-24.30 {ConfigurePanes, -stretch first} { -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white frame .f3 -width 40 -bg blue frame .f4 -width 40 -bg green .p add .f1 .f2 .f3 .f4 -stretch first pack .p update set result [list] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] .p paneconfigure .f2 -hide 1 update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] } -cleanup {destroy .p .f1 .f2 .f3 .f4} -result {51 40 40 40 94 40 40 40} } test panedwindow-24.31 {ConfigurePanes, -stretch middle} { -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white frame .f3 -width 40 -bg blue frame .f4 -width 40 -bg green .p add .f1 .f2 .f3 .f4 -stretch middle pack .p update set result [list] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] .p paneconfigure .f2 -hide 1 update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] } -cleanup {destroy .p .f1 .f2 .f3 .f4} -result {40 45 46 40 40 45 94 40} } test panedwindow-24.32 {ConfigurePanes, -stretch always} { -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white frame .f3 -width 40 -bg blue frame .f4 -width 40 -bg green .p add .f1 .f2 .f3 .f4 -stretch always pack .p update set result [list] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] .p paneconfigure .f2 -hide 1 update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] } -cleanup {destroy .p .f1 .f2 .f3 .f4} -result {42 43 43 43 58 43 58 58} } test panedwindow-24.33 {ConfigurePanes, -stretch never} { -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white frame .f3 -width 40 -bg blue frame .f4 -width 40 -bg green .p add .f1 .f2 .f3 .f4 -stretch never pack .p update set result [list] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] .p paneconfigure .f2 -hide 1 update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] } -cleanup {destroy .p .f1 .f2 .f3 .f4} -result {40 40 40 40 40 40 40 40} } test panedwindow-25.1 {Unlink, remove a paned with -before/-after refs} { # Bug 928413 set result {} panedwindow .pw label .pw.l1 -text Label1 label .pw.l2 -text Label2 label .pw.l3 -text Label3 .pw add .pw.l1 .pw add .pw.l3 .pw add .pw.l2 -before .pw.l3 lappend result [.pw panecget .pw.l2 -before] destroy .pw.l3 lappend result [.pw panecget .pw.l2 -before] .pw paneconfigure .pw.l2 -before .pw.l1 lappend result [.pw panecget .pw.l2 -before] destroy .pw set result } {.pw.l3 {} .pw.l1} test panedwindow-26.1 {DestroyPanedWindow} { # This test should not result in any memory leaks. panedwindow .p foreach w {.a .b .c .d .e .f .g .h .i .j .k .l .m .n .o .q .r .s .t} { .p add [button $w] } foreach w {.a .b .c .d .e .f .g .h .i .j .k .l .m .n .o .p .q .r .s .t} { destroy $w } set result {} } {} test panedwindow-26.2 {UnmapNotify and MapNotify events are propagated to slaves} { panedwindow .pw .pw add [button .pw.b] pack .pw update set result [winfo ismapped .pw.b] pack forget .pw update lappend result [winfo ismapped .pw.b] lappend result [winfo ismapped .pw] pack .pw update lappend result [winfo ismapped .pw] lappend result [winfo ismapped .pw.b] destroy .pw .pw.b set result } {1 0 0 1 1} test panedwindow-27.1 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 0 0] destroy .p .f .f2 set result } {} test panedwindow-27.2 {PanedWindowIdentifyCoords, padding is included} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 20 0] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.3 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 22 0] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.4 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 24 0] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.5 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 26 0] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.6 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 26 -1] destroy .p .f .f2 set result } {} test panedwindow-27.7 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 26 100] destroy .p .f .f2 set result } {} test panedwindow-27.8 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 22 4] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.9 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 22 5] destroy .p .f .f2 set result } {0 handle} test panedwindow-27.10 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 20 5] destroy .p .f .f2 set result } {0 handle} test panedwindow-27.11 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 20 0] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.12 {PanedWindowIdentifyCoords} { panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] \ [frame .f3 -bg green -width 20 -height 20] set result [.p identify 48 0] destroy .p .f .f2 .f3 set result } {1 sash} test panedwindow-27.13 {identify subcommand errors} { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 set result [list [catch {.p identify} msg] $msg] destroy .p set result } [list 1 "wrong # args: should be \".p identify x y\""] test panedwindow-27.14 {identify subcommand errors} { panedwindow .p set result [list [catch {.p identify foo bar} msg] $msg] destroy .p set result } [list 1 "expected integer but got \"foo\""] test panedwindow-27.14a {identify subcommand errors} { panedwindow .p set result [list [catch {.p identify 0 bar} msg] $msg] destroy .p set result } [list 1 "expected integer but got \"bar\""] test panedwindow-27.15 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 0 0] destroy .p .f .f2 set result } {} test panedwindow-27.16 {PanedWindowIdentifyCoords, padding is included} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 0 20] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.17 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 0 22] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.18 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 0 24] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.19 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 0 26] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.20 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify -1 26] destroy .p .f .f2 set result } {} test panedwindow-27.21 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 100 26] destroy .p .f .f2 set result } {} test panedwindow-27.22 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 4 22] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.23 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 5 22] destroy .p .f .f2 set result } {0 handle} test panedwindow-27.24 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 5 20] destroy .p .f .f2 set result } {0 handle} test panedwindow-27.25 {PanedWindowIdentifyCoords} { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] set result [.p identify 0 20] destroy .p .f .f2 set result } {0 sash} test panedwindow-27.26 {PanedWindowIdentifyCoords} { panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] \ [frame .f3 -bg green -width 20 -height 20] set result [.p identify 0 48] destroy .p .f .f2 .f3 set result } {1 sash} test panedwindow-28.1 {destroy the window cleanly on error [Bug #616589]} { list [catch {panedwindow .p -bogusopt bogus} msg] $msg } {1 {unknown option "-bogusopt"}} test panedwindow-28.2 {destroy the window cleanly on rename [Bug #616589]} { destroy .p panedwindow .p rename .p {} winfo exists .p } {0} test panedwindow-29.1 {resizing width} { -body { panedwindow .p -bd 5 frame .f1 -width 100 -height 50 -bg blue frame .f2 -width 100 -height 50 -bg red .p add .f1 -sticky news .p add .f2 -sticky news pack .p -side top -fill both -expand 1 wm geometry . "" update # Note the width set a [winfo width .f2] # Increase the size by 10 regexp {^(\d+)x(\d+)} [wm geometry .] -> w h wm geometry . [expr {$w + 10}]x$h update set b "$a [winfo width .f2]" } -cleanup {destroy .p .f1 .f2} -result {100 110} } test panedwindow-29.2 {resizing height} { -body { panedwindow .p -orient vertical -bd 5 frame .f1 -width 50 -height 100 -bg blue frame .f2 -width 50 -height 100 -bg red .p add .f1 -sticky news .p add .f2 -sticky news pack .p -side top -fill both -expand 1 wm geometry . "" update # Note the height set a [winfo height .f2] # Increase the size by 10 regexp {^(\d+)x(\d+)} [wm geometry .] -> w h wm geometry . ${w}x[expr {$h + 10}] update set b "$a [winfo height .f2]" } -cleanup {destroy .p .f1 .f2} -result {100 110} } test panedwindow-30.1 {display on depths other than the default one} { -constraints {pseudocolor8 haveTruecolor24} -body { toplevel .t -visual {truecolor 24} pack [panedwindow .t.p] .t.p add [frame .t.p.f1] [frame .t.p.f2] update # If we got here, we didn't crash and that's good } -cleanup {destroy .t} -result {} } test panedwindow-30.2 {display on depths other than the default one} { -constraints {pseudocolor8 haveTruecolor24} -body { toplevel .t -visual {pseudocolor 8} pack [frame .t.f -visual {truecolor 24}] pack [panedwindow .t.f.p] .t.f.p add [frame .t.f.p.f1 -width 5] [frame .t.f.p.f2 -width 5] update .t.f.p proxy place 1 1 update .t.f.p proxy forget update # If we got here, we didn't crash and that's good } -cleanup {destroy .t} -result {} } # cleanup cleanupTests return tk8.5.19/tests/textMark.test0000644003604700454610000002364112612445655014434 0ustar dgp771div# This file is a Tcl script to test the code in the file tkTextMark.c. # This file is organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands catch {destroy .t} text .t -width 20 -height 10 testConstraint haveCourier12 [expr {[catch { .t configure -font {Courier 12} }] == 0}] pack append . .t {top expand fill} update .t debug on wm geometry . {} .t peer create .pt # The statements below reset the main window; it's needed if the window # manager is mwm to make mwm forget about a previous minimum size setting. wm withdraw . wm minsize . 1 1 wm positionfrom . user wm deiconify . entry .t.e .t insert 1.0 "Line 1 abcdefghijklm 12345 Line 4 bOy GIrl .#@? x_yz !@#$% Line 7" test textMark-1.1 {TkTextMarkCmd - missing option} haveCourier12 { list [catch {.t mark} msg] $msg } {1 {wrong # args: should be ".t mark option ?arg arg ...?"}} test textMark-1.2 {TkTextMarkCmd - bogus option} haveCourier12 { list [catch {.t mark gorp} msg] $msg } {1 {bad mark option "gorp": must be gravity, names, next, previous, set, or unset}} test textMark-1.3 {TkTextMarkCmd - "gravity" option} haveCourier12 { list [catch {.t mark gravity foo} msg] $msg } {1 {there is no mark named "foo"}} test textMark-1.4 {TkTextMarkCmd - "gravity" option} haveCourier12 { .t mark unset x .t mark set x 1.3 .t insert 1.3 x list [.t mark gravity x] [.t index x] } {right 1.4} test textMark-1.5 {TkTextMarkCmd - "gravity" option} haveCourier12 { .t mark unset x .t mark set x 1.3 .t mark g x left .t insert 1.3 x list [.t mark gravity x] [.t index x] } {left 1.3} test textMark-1.6 {TkTextMarkCmd - "gravity" option} haveCourier12 { .t mark unset x .t mark set x 1.3 .t mark gravity x right .t insert 1.3 x list [.t mark gravity x] [.t index x] } {right 1.4} test textMark-1.7 {TkTextMarkCmd - "gravity" option} haveCourier12 { list [catch {.t mark gravity x gorp} msg] $msg } {1 {bad mark gravity "gorp": must be left or right}} test textMark-1.8 {TkTextMarkCmd - "gravity" option} haveCourier12 { list [catch {.t mark gravity} msg] $msg } {1 {wrong # args: should be ".t mark gravity markName ?gravity?"}} test textMark-2.1 {TkTextMarkCmd - "names" option} haveCourier12 { list [catch {.t mark names 2} msg] $msg } {1 {wrong # args: should be ".t mark names"}} .t mark unset x test textMark-2.2 {TkTextMarkCmd - "names" option} haveCourier12 { lsort [.t mark na] } {current insert} test textMark-2.3 {TkTextMarkCmd - "names" option} haveCourier12 { .t mark set a 1.1 .t mark set "b c" 2.3 lsort [.t mark names] } {a {b c} current insert} test textMark-3.1 {TkTextMarkCmd - "set" option} haveCourier12 { list [catch {.t mark set a} msg] $msg } {1 {wrong # args: should be ".t mark set markName index"}} test textMark-3.2 {TkTextMarkCmd - "set" option} haveCourier12 { list [catch {.t mark s a b c} msg] $msg } {1 {wrong # args: should be ".t mark set markName index"}} test textMark-3.3 {TkTextMarkCmd - "set" option} haveCourier12 { list [catch {.t mark set a @x} msg] $msg } {1 {bad text index "@x"}} test textMark-3.4 {TkTextMarkCmd - "set" option} haveCourier12 { .t mark set a 1.2 .t index a } 1.2 test textMark-3.5 {TkTextMarkCmd - "set" option} haveCourier12 { .t mark set a end .t index a } {8.0} test textMark-4.1 {TkTextMarkCmd - "unset" option} haveCourier12 { list [catch {.t mark unset} msg] $msg } {0 {}} test textMark-4.2 {TkTextMarkCmd - "unset" option} haveCourier12 { .t mark set a 1.2 .t mark set b 2.3 .t mark unset a b list [catch {.t index a} msg] $msg [catch {.t index b} msg2] $msg2 } {1 {bad text index "a"} 1 {bad text index "b"}} test textMark-4.3 {TkTextMarkCmd - "unset" option} haveCourier12 { .t mark set a 1.2 .t mark set b 2.3 .t mark set 49ers 3.1 eval .t mark unset [.t mark names] lsort [.t mark names] } {current insert} test textMark-5.1 {TkTextMarkCmd - miscellaneous} haveCourier12 { list [catch {.t mark} msg] $msg } {1 {wrong # args: should be ".t mark option ?arg arg ...?"}} test textMark-5.2 {TkTextMarkCmd - miscellaneous} haveCourier12 { list [catch {.t mark foo} msg] $msg } {1 {bad mark option "foo": must be gravity, names, next, previous, set, or unset}} test textMark-6.1 {TkTextMarkSegToIndex} haveCourier12 { .t mark set a 1.2 .t mark set b 1.2 .t mark set c 1.2 .t mark set d 1.4 list [.t index a] [.t index b] [.t index c ] [.t index d] } {1.2 1.2 1.2 1.4} test textMark-6.2 {TkTextMarkNameToIndex, with mark outside -startline/-endline range - bug 1630271} -body { .t mark set insert 1.0 .t configure -startline 2 set res [list [.t index insert] [.t index insert-1c] [.t get insert]] .t mark set insert end .t configure -endline 4 lappend res [.t index insert] } -cleanup { .t configure -startline {} -endline {} } -result {1.0 1.0 a 2.5} test textMark-6.3 {TkTextMarkNameToIndex, with mark outside -startline/-endline range - bug 1630271} -body { .t mark set mymark 1.0 .t configure -startline 2 list [catch {.t index mymark} msg] $msg } -cleanup { .t configure -startline {} -endline {} .t mark unset mymark } -result {1 {bad text index "mymark"}} test textMark-6.4 {TkTextMarkNameToIndex, with mark outside -startline/-endline range - bug 1630271} -body { .t mark set mymark 1.0 .t configure -startline 2 set res [list [catch {.t index mymark} msg] $msg] lappend res [.pt index mymark] .t configure -startline {} .pt configure -startline 4 lappend res [.t index mymark] lappend res [catch {.pt index mymark} msg] $msg lappend res [.t get mymark] lappend res [catch {.pt get mymark} msg] $msg } -cleanup { .t configure -startline {} -endline {} .pt configure -startline {} -endline {} .t mark unset mymark } -result {1 {bad text index "mymark"} 1.0 1.0 1 {bad text index "mymark"} L 1 {bad text index "mymark"}} test textMark-6.5 {insert and current marks in an empty peer - bug 3487407} -body { .t mark set insert 1.0 .t configure -start 5 -end 5 set res [.t index insert] } -cleanup { .t configure -startline {} -endline {} } -result {1.0} catch {eval {.t mark unset} [.t mark names]} test textMark-7.1 {MarkFindNext - invalid mark name} haveCourier12 { catch {.t mark next bogus} x set x } {bad text index "bogus"} test textMark-7.2 {MarkFindNext - marks at same location} haveCourier12 { .t mark set insert 2.0 .t mark set current 2.0 .t mark next current } {insert} test textMark-7.3 {MarkFindNext - numerical starting mark} haveCourier12 { .t mark set current 1.0 .t mark set insert 1.0 .t mark next 1.0 } {insert} test textMark-7.4 {MarkFindNext - mark on the same line} haveCourier12 { .t mark set current 1.0 .t mark set insert 1.1 .t mark next current } {insert} test textMark-7.5 {MarkFindNext - mark on the next line} haveCourier12 { .t mark set current 1.end .t mark set insert 2.0 .t mark next current } {insert} test textMark-7.6 {MarkFindNext - mark far away} haveCourier12 { .t mark set current 1.2 .t mark set insert 7.0 .t mark next current } {insert} test textMark-7.7 {MarkFindNext - mark on top of end} haveCourier12 { .t mark set current end .t mark next end } {current} test textMark-7.8 {MarkFindNext - no next mark} haveCourier12 { .t mark set current 1.0 .t mark set insert 3.0 .t mark next insert } {} test textMark-7.9 {MarkFindNext - mark set in a text widget and retrieved from a peer} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set mymark 1.0 lsort [list [.pt mark next 1.0] [.pt mark next mymark] [.pt mark next insert]] } -result {current insert mymark} test textMark-8.1 {MarkFindPrev - invalid mark name} -constraints haveCourier12 -setup { .t mark unset {*}[.t mark names] } -body { catch {.t mark prev bogus} x set x } -result {bad text index "bogus"} test textMark-8.2 {MarkFindPrev - marks at same location} -constraints haveCourier12 -setup { .t mark unset {*}[.t mark names] } -body { .t mark set insert 2.0 .t mark set current 2.0 .t mark prev insert } -result {current} test textMark-8.3 {MarkFindPrev - numerical starting mark} -constraints haveCourier12 -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.0 .t mark set insert 1.0 .t mark prev 1.1 } -result {current} test textMark-8.4 {MarkFindPrev - mark on the same line} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.0 .t mark set insert 1.1 .t mark prev insert } -result {current} test textMark-8.5 {MarkFindPrev - mark on the previous line} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.end .t mark set insert 2.0 .t mark prev insert } -result {current} test textMark-8.6 {MarkFindPrev - mark far away} -constraints haveCourier12 -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.2 .t mark set insert 7.0 .t mark prev insert } -result {current} test textMark-8.7 {MarkFindPrev - mark on top of end} -constraints haveCourier12 -setup { .t mark unset {*}[.t mark names] } -body { .t mark set insert 3.0 .t mark set current end .t mark prev end } -result {insert} test textMark-8.8 {MarkFindPrev - no previous mark} -constraints haveCourier12 -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.0 .t mark set insert 3.0 .t mark prev current } -result {} test textMark-8.9 {MarkFindPrev - mark set in a text widget and retrieved from a peer} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set mymark 1.0 lsort [list [.pt mark prev end] [.pt mark prev current] [.pt mark prev insert]] } -result {current insert mymark} catch {destroy .t} catch {destroy .pt} # cleanup cleanupTests return tk8.5.19/tests/visual_bb.test0000644003604700454610000000754712612445655014612 0ustar dgp771div#!/usr/local/bin/wish -f # # This script displays provides visual tests for many of Tk's features. # Each test displays a window with various information in it, along # with instructions about how the window should appear. You can look # at the window to make sure it appears as expected. Individual tests # are kept in separate ".tcl" files in this directory. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands set auto_path ". $auto_path" wm title . "Visual Tests for Tk" set testNum 1 # Each menu entry invokes a visual test file proc runTest {file} { global testNum test "2.$testNum" "testing $file" {userInteraction} { uplevel \#0 source [file join [testsDirectory] $file] concat "" } {} incr testNum } # The following procedure is invoked to print the contents of a canvas: proc lpr {c args} { exec lpr <<[eval [list $c postscript] $args] } proc end {} { cleanupTests set ::EndOfVisualTests 1 } test 1.1 "running visual tests" {userInteraction} { #------------------------------------------------------- # The code below create the main window, consisting of a # menu bar and a message explaining the basic operation # of the program. #------------------------------------------------------- frame .menu -relief raised -borderwidth 1 message .msg -font {Times 18} -relief raised -width 4i \ -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit. Each menu entry invokes a test, which displays information on the screen. You can then verify visually that the information is being displayed in the correct way. The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets." pack .menu -side top -fill x pack .msg -side bottom -expand yes -fill both #------------------------------------------------------- # The code below creates all the menus, which invoke procedures # to create particular demonstrations of various widgets. #------------------------------------------------------- menubutton .menu.file -text "File" -menu .menu.file.m menu .menu.file.m .menu.file.m add command -label "Quit" -command end menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m menu .menu.group1.m .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl} .menu.group1.m add command -label "Beveled borders in text widgets" \ -command {runTest bevel.tcl} .menu.group1.m add command -label "Colormap management" \ -command {runTest cmap.tcl} .menu.group1.m add command -label "Label/button geometry" \ -command {runTest butGeom.tcl} .menu.group1.m add command -label "Label/button colors" \ -command {runTest butGeom2.tcl} menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m menu .menu.ps.m .menu.ps.m add command -label "Rectangles and other graphics" \ -command {runTest canvPsGrph.tcl} .menu.ps.m add command -label "Text" \ -command {runTest canvPsText.tcl} .menu.ps.m add command -label "Bitmaps" \ -command {runTest canvPsBmap.tcl} .menu.ps.m add command -label "Images" \ -command {runTest canvPsImg.tcl} .menu.ps.m add command -label "Arcs" \ -command {runTest canvPsArc.tcl} pack .menu.file .menu.group1 .menu.ps -side left -padx 1m # Set up for keyboard-based menu traversal bind . { if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} { focus .menu } } tk_menuBar .menu .menu.file .menu.group1 .menu.ps # Set up a class binding to allow objects to be deleted from a canvas # by clicking with mouse button 1: bind Canvas <1> {%W delete [%W find closest %x %y]} concat "" } {} if {![testConstraint userInteraction]} { cleanupTests } else { vwait EndOfVisualTests } tk8.5.19/tests/canvPsGrph.tcl0000644003604700454610000000627512612445655014517 0ustar dgp771div# This file creates a screen to exercise Postscript generation # for some of the graphical objects in canvases. It is part of the Tk # visual test suite, which is invoked via the "visual" script. catch {destroy .t} toplevel .t wm title .t "Postscript Tests for Canvases" wm iconname .t "Postscript" wm geom .t +0+0 wm minsize .t 1 1 set c .t.mid.c message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets. Select what you want to display with the buttons below, then click on "Print" to print it to your default printer. You can click on items in the canvas to delete them.} -width 4i pack .t.m -side top -fill both frame .t.top pack .t.top -side top -fill both set what rect radiobutton .t.top.rect -text Rectangles -variable what -value rect \ -command "mkObjs $c" -relief flat radiobutton .t.top.oval -text Ovals -variable what -value oval \ -command "mkObjs $c" -relief flat radiobutton .t.top.poly -text Polygons -variable what -value poly \ -command "mkObjs $c" -relief flat radiobutton .t.top.line -text Lines -variable what -value line \ -command "mkObjs $c" -relief flat pack .t.top.rect .t.top.oval .t.top.poly .t.top.line \ -side left -pady 2m -ipadx 2m -ipady 1m -expand 1 frame .t.bot pack .t.bot -side bottom -fill both button .t.bot.quit -text Quit -command {destroy .t} button .t.bot.print -text Print -command "lpr $c" pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1 frame .t.mid -relief sunken -bd 2 pack .t.mid -side top -expand yes -fill both -padx 2m -pady 2m canvas $c -width 400 -height 350 -bd 0 -relief sunken pack $c -expand yes -fill both -padx 1 -pady 1 proc mkObjs c { global what $c delete all if {$what == "rect"} { $c create rect 0 0 400 350 -outline black $c create rect 2 2 100 50 -fill black -stipple gray25 $c create rect -20 180 80 320 -fill black -stipple gray50 -width .5c $c create rect 200 -20 240 20 -fill black $c create rect 380 200 420 240 -fill black $c create rect 200 330 240 370 -fill black } if {$what == "oval"} { $c create oval 50 10 150 80 -fill black -stipple gray25 -outline {} $c create oval 100 100 200 150 -outline {} -fill black -stipple gray50 $c create oval 250 100 400 300 -width .5c } if {$what == "poly"} { $c create poly 100 200 200 50 300 200 -smooth yes -stipple gray25 \ -outline black -width 4 $c create poly 100 300 100 250 350 250 350 300 350 300 100 300 100 300 \ -fill red -smooth yes $c create poly 20 10 40 10 40 60 80 60 80 25 30 25 30 \ 35 50 35 50 45 20 45 $c create poly 300 20 300 120 380 80 320 100 -fill blue -outline black $c create poly 20 200 100 220 90 100 40 250 \ -fill {} -outline brown -width 3 } if {$what == "line"} { $c create line 20 20 120 20 -arrow both -width 5 $c create line 20 80 150 80 20 200 150 200 -smooth yes $c create line 150 20 150 150 250 150 -width .5c -smooth yes \ -arrow both -arrowshape {.75c 1.0c .5c} -stipple gray25 $c create line 50 340 100 250 150 340 -join round -cap round -width 10 $c create line 200 340 250 250 300 340 -join bevel -cap project \ -width 10 $c create line 300 20 380 20 300 150 380 150 -join miter -cap butt \ -width 10 -stipple gray25 } } mkObjs $c tk8.5.19/tests/raise.test0000644003604700454610000002007412612445655013735 0ustar dgp771div# This file is a Tcl script to test out Tk's "raise" and # "lower" commands, plus associated code to manage window # stacking order. It is organized in the standard fashion # for Tcl tests. # # Copyright (c) 1993-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # Procedure to create a bunch of overlapping windows, which should # make it easy to detect differences in order. proc raise_setup {} { foreach i [winfo child .raise] { destroy $i } foreach i {a b c d e} { label .raise.$i -text $i -relief raised -bd 2 } place .raise.a -x 20 -y 60 -width 60 -height 80 place .raise.b -x 60 -y 60 -width 60 -height 80 place .raise.c -x 100 -y 60 -width 60 -height 80 place .raise.d -x 40 -y 20 -width 100 -height 60 place .raise.e -x 40 -y 120 -width 100 -height 60 } # Procedure to return information about which windows are on top # of which other windows. proc raise_getOrder {} { set x [winfo rootx .raise] set y [winfo rooty .raise] list [winfo name [winfo containing [expr $x+50] [expr $y+70]]] \ [winfo name [winfo containing [expr $x+90] [expr $y+70]]] \ [winfo name [winfo containing [expr $x+130] [expr $y+70]]] \ [winfo name [winfo containing [expr $x+70] [expr $y+100]]] \ [winfo name [winfo containing [expr $x+110] [expr $y+100]]] \ [winfo name [winfo containing [expr $x+50] [expr $y+130]]] \ [winfo name [winfo containing [expr $x+90] [expr $y+130]]] \ [winfo name [winfo containing [expr $x+130] [expr $y+130]]] } # Procedure to set up a collection of top-level windows proc raise_makeToplevels {} { deleteWindows foreach i {.raise1 .raise2 .raise3} { toplevel $i wm geom $i 150x100+0+0 update } } toplevel .raise wm geom .raise 250x200+0+0 test raise-1.1 {preserve creation order} { raise_setup tkwait visibility .raise.e raise_getOrder } {d d d b c e e e} test raise-1.2 {preserve creation order} testmakeexist { raise_setup testmakeexist .raise.a update raise_getOrder } {d d d b c e e e} test raise-1.3 {preserve creation order} testmakeexist { raise_setup testmakeexist .raise.c update raise_getOrder } {d d d b c e e e} test raise-1.4 {preserve creation order} testmakeexist { raise_setup testmakeexist .raise.e update raise_getOrder } {d d d b c e e e} test raise-1.5 {preserve creation order} testmakeexist { raise_setup testmakeexist .raise.d .raise.c .raise.b update raise_getOrder } {d d d b c e e e} test raise-2.1 {raise internal windows before creation} { raise_setup raise .raise.a update raise_getOrder } {a d d a c a e e} test raise-2.2 {raise internal windows before creation} { raise_setup raise .raise.c update raise_getOrder } {d d c b c e e c} test raise-2.3 {raise internal windows before creation} { raise_setup raise .raise.e update raise_getOrder } {d d d b c e e e} test raise-2.4 {raise internal windows before creation} { raise_setup raise .raise.e .raise.a update raise_getOrder } {d d d b c e b c} test raise-2.5 {raise internal windows before creation} { raise_setup raise .raise.a .raise.d update raise_getOrder } {a d d a c e e e} test raise-3.1 {raise internal windows after creation} { raise_setup update raise .raise.a .raise.d raise_getOrder } {a d d a c e e e} test raise-3.2 {raise internal windows after creation} testmakeexist { raise_setup testmakeexist .raise.a .raise.b raise .raise.a .raise.b update raise_getOrder } {d d d a c e e e} test raise-3.3 {raise internal windows after creation} testmakeexist { raise_setup testmakeexist .raise.a .raise.d raise .raise.a .raise.b update raise_getOrder } {d d d a c e e e} test raise-3.4 {raise internal windows after creation} testmakeexist { raise_setup testmakeexist .raise.a .raise.c .raise.d raise .raise.a .raise.b update raise_getOrder } {d d d a c e e e} test raise-4.1 {raise relative to nephews} { raise_setup update frame .raise.d.child raise .raise.a .raise.d.child raise_getOrder } {a d d a c e e e} test raise-4.2 {raise relative to nephews} { raise_setup update frame .raise2 list [catch {raise .raise.a .raise2} msg] $msg } {1 {can't raise ".raise.a" above ".raise2"}} catch {destroy .raise2} test raise-5.1 {lower internal windows} { raise_setup update lower .raise.d raise_getOrder } {a b c b c e e e} test raise-5.2 {lower internal windows} { raise_setup update lower .raise.d .raise.b raise_getOrder } {d b c b c e e e} test raise-5.3 {lower internal windows} { raise_setup update lower .raise.a .raise.e raise_getOrder } {a d d a c e e e} test raise-5.4 {lower internal windows} { raise_setup update frame .raise2 list [catch {lower .raise.a .raise2} msg] $msg } {1 {can't lower ".raise.a" below ".raise2"}} catch {destroy .raise2} test raise-6.1 {raise/lower toplevel windows} {nonPortable} { raise_makeToplevels update raise .raise1 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] } .raise1 test raise-6.2 {raise/lower toplevel windows} {nonPortable} { raise_makeToplevels update raise .raise2 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] } .raise2 test raise-6.3 {raise/lower toplevel windows} {nonPortable} { raise_makeToplevels update raise .raise3 raise .raise2 raise .raise1 .raise3 set result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] destroy .raise2 update after 500 list $result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] } {.raise2 .raise1} test raise-6.4 {raise/lower toplevel windows} {nonPortable} { raise_makeToplevels update raise .raise2 raise .raise1 lower .raise3 .raise1 set result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] wm geometry .raise2 +30+30 wm geometry .raise1 +60+60 destroy .raise1 update after 500 list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] } {.raise1 .raise3} test raise-6.5 {raise/lower toplevel windows} {nonPortable} { raise_makeToplevels raise .raise1 set time [lindex [time {raise .raise1}] 0] expr {$time < 2000000} } 1 test raise-6.6 {raise/lower toplevel windows} {nonPortable} { raise_makeToplevels update raise .raise2 raise .raise1 raise .raise3 frame .raise1.f1 frame .raise1.f1.f2 lower .raise3 .raise1.f1.f2 set result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] destroy .raise1 update after 500 list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] } {.raise1 .raise3} test raise-7.1 {errors in raise/lower commands} { list [catch {raise} msg] $msg } {1 {wrong # args: should be "raise window ?aboveThis?"}} test raise-7.2 {errors in raise/lower commands} { list [catch {raise a b c} msg] $msg } {1 {wrong # args: should be "raise window ?aboveThis?"}} test raise-7.3 {errors in raise/lower commands} { list [catch {raise badName} msg] $msg } {1 {bad window path name "badName"}} test raise-7.4 {errors in raise/lower commands} { list [catch {raise . badName2} msg] $msg } {1 {bad window path name "badName2"}} test raise-7.5 {errors in raise/lower commands} { list [catch {lower} msg] $msg } {1 {wrong # args: should be "lower window ?belowThis?"}} test raise-7.6 {errors in raise/lower commands} { list [catch {lower a b c} msg] $msg } {1 {wrong # args: should be "lower window ?belowThis?"}} test raise-7.7 {errors in raise/lower commands} { list [catch {lower badName3} msg] $msg } {1 {bad window path name "badName3"}} test raise-7.8 {errors in raise/lower commands} { list [catch {lower . badName4} msg] $msg } {1 {bad window path name "badName4"}} deleteWindows # cleanup cleanupTests return tk8.5.19/tests/winWm.test0000644003604700454610000003254612612445655013742 0ustar dgp771div# This file tests is a Tcl script to test the procedures in the file # tkWinWm.c. It is organized in the standard fashion for Tcl tests. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # Measure the height of a single menu line toplevel .t frame .t.f -width 100 -height 50 pack .t.f menu .t.m .t.m add command -label "thisisreallylong" .t configure -menu .t.m wm geometry .t -0-0 update set menuheight [winfo y .t] .t.m add command -label "thisisreallylong" wm geometry .t -0-0 update set menuheight [expr {$menuheight - [winfo y .t]}] destroy .t test winWm-1.1 {TkWmMapWindow} win { toplevel .t wm override .t 1 wm geometry .t +0+0 update set result [list [winfo rootx .t] [winfo rooty .t]] destroy .t set result } {0 0} test winWm-1.2 {TkWmMapWindow} win { toplevel .t wm transient .t . update wm iconify . update wm deiconify . update catch {wm iconify .t} msg destroy .t set msg } {can't iconify ".t": it is a transient} test winWm-1.3 {TkWmMapWindow} win { toplevel .t update toplevel .t2 update set result [expr {[winfo x .t] != [winfo x .t2]}] destroy .t .t2 set result } 1 test winWm-1.4 {TkWmMapWindow} win { toplevel .t wm geometry .t +10+10 update toplevel .t2 wm geometry .t2 +40+10 update set result [list [winfo x .t] [winfo x .t2]] destroy .t .t2 set result } {10 40} test winWm-1.5 {TkWmMapWindow} win { toplevel .t wm iconify .t update set result [wm state .t] destroy .t set result } iconic test winWm-2.1 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update set result [wm state .t] wm iconify .t update lappend result [wm state .t] wm deiconify .t update lappend result [wm state .t] destroy .t set result } {normal iconic normal} test winWm-2.2 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update set result [wm state .t] wm withdraw .t update lappend result [wm state .t] wm iconify .t update lappend result [wm state .t] wm deiconify .t update lappend result [wm state .t] destroy .t set result } {normal withdrawn iconic normal} test winWm-2.3 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update set result [wm state .t] wm state .t withdrawn update lappend result [wm state .t] wm state .t iconic update lappend result [wm state .t] wm state .t normal update lappend result [wm state .t] destroy .t set result } {normal withdrawn iconic normal} test winWm-2.4 {TkpWmSetState} win { set result {} toplevel .t wm geometry .t 150x50+10+10 update lappend result [list [wm state .t] [wm geometry .t]] wm iconify .t update lappend result [list [wm state .t] [wm geometry .t]] wm geometry .t 200x50+10+10 update lappend result [list [wm state .t] [wm geometry .t]] wm deiconify .t update lappend result [list [wm state .t] [wm geometry .t]] destroy .t set result } {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win { toplevel .t wm geometry .t +0+0 button .t.b pack .t.b update set x [winfo x .t.b] destroy .t toplevel .t wm geometry .t +0+0 button .t.b update pack .t.b update set x [expr {$x == [winfo x .t.b]}] destroy .t set x } 1 test winWm-4.1 {ConfigureTopLevel: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f wm geometry .t -0-0 update set y [winfo y .t] menu .t.m .t.m add command -label foo .t configure -menu .t.m update set result [expr {$y - [winfo y .t]}] destroy .t set result } [expr {$menuheight + 1}] # This test works on 8.0p2 but has not worked on anything since 8.2. # It would be very strange to have a windows application increase the size # of the clientarea when a menu wraps so I believe this test to be wrong. # Original result was {50 50 50} new result may depend on the default menu # font test winWm-5.1 {UpdateGeometryInfo: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f update set result [winfo height .t] menu .t.m .t.m add command -label foo .t configure -menu .t.m update lappend result [winfo height .t] .t.m add command -label "thisisreallylong" .t.m add command -label "thisisreallylong" update lappend result [winfo height .t] destroy .t set result } {50 50 31} test winWm-5.2 {UpdateGeometryInfo: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f wm geometry .t -0-0 update set y [winfo rooty .t] lappend result [winfo height .t] menu .t.m .t configure -menu .t.m .t.m add command -label foo .t.m add command -label "thisisreallylong" .t.m add command -label "thisisreallylong" update lappend result [winfo height .t] lappend result [expr {$y - [winfo rooty .t]}] destroy .t set result } {50 50 0} test winWm-6.1 {wm attributes} win { destroy .t toplevel .t wm attributes .t } {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0} test winWm-6.2 {wm attributes} win { destroy .t toplevel .t wm attributes .t -disabled } {0} test winWm-6.3 {wm attributes} win { # This isn't quite the correct error message yet, but it works. destroy .t toplevel .t list [catch {wm attributes .t -foo} msg] $msg } {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} test winWm-6.4 {wm attributes -alpha} win { # Expect this to return all 1.0 {} on pre-2K/XP destroy .t toplevel .t set res [wm attributes .t -alpha] # we don't return on set yet lappend res [wm attributes .t -alpha 0.5] lappend res [wm attributes .t -alpha] lappend res [wm attributes .t -alpha -100] lappend res [wm attributes .t -alpha] lappend res [wm attributes .t -alpha 100] lappend res [wm attributes .t -alpha] set res } {1.0 {} 0.5 {} 0.0 {} 1.0} test winWm-6.5 {wm attributes -alpha} win { destroy .t toplevel .t list [catch {wm attributes .t -alpha foo} msg] $msg } {1 {expected floating-point number but got "foo"}} test winWm-6.6 {wm attributes -alpha} win { # This test is just to show off -alpha destroy .t toplevel .t wm attributes .t -alpha 0.2 pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"] tk::PlaceWindow .t center update if {$::tcl_platform(osVersion) >= 5.0} { for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} { wm attributes .t -alpha $i update idle after 20 } for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} { wm attributes .t -alpha $i update idle after 20 } } } {} test winWm-6.7 {wm attributes -transparentcolor} win { # Expect this to return all "" on pre-2K/XP destroy .t toplevel .t set res {} lappend res [wm attributes .t -transparentcolor] # we don't return on set yet lappend res [wm attributes .t -trans black] lappend res [wm attributes .t -trans] lappend res [wm attributes .t -trans "#FFFFFF"] lappend res [wm attributes .t -trans] destroy .t set res } [list {} {} black {} "#FFFFFF"] test winWm-6.8 {wm attributes -transparentcolor} win { destroy .t toplevel .t list [catch {wm attributes .t -tr foo} msg] $msg } {1 {unknown color name "foo"}} test winWm-7.1 {deiconify on an unmapped toplevel\ will raise the window and set the focus} win { destroy .t toplevel .t lower .t focus -force . wm deiconify .t update list [wm stackorder .t isabove .] [focus] } {1 .t} test winWm-7.2 {deiconify on an already mapped toplevel\ will raise the window and set the focus} win { destroy .t toplevel .t lower .t update focus -force . wm deiconify .t update list [wm stackorder .t isabove .] [focus] } {1 .t} test winWm-7.3 {UpdateWrapper must maintain Z order} win { destroy .t toplevel .t lower .t update set res [wm stackorder .t isbelow .] wm resizable .t 0 0 update list $res [wm stackorder .t isbelow .] } {1 1} test winWm-7.4 {UpdateWrapper must maintain focus} win { destroy .t toplevel .t focus -force .t update set res [focus] wm resizable .t 0 0 update list $res [focus] } {.t .t} test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win { list [catch {wm iconph .} msg] $msg } {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win { destroy .t toplevel .t image create photo blank16 -width 16 -height 16 image create photo blank32 -width 32 -height 32 # This should just make blank icons for the window wm iconphoto .t blank16 blank32 image delete blank16 blank32 } {} test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constraints win -setup { proc winwm90click {w} { if {![winfo ismapped $w]} { update } event generate $w focus -force $w event generate $w -x 5 -y 5 event generate $w -x 5 -y 5 } proc winwm90proc3 {} { global winwm90done winwm90check set w .sd toplevel $w pack [button $w.b -text "OK" -command {set winwm90check 1}] bind $w.b {after idle {winwm90click %W}} update idletasks tkwait visibility $w grab $w tkwait variable winwm90check grab release $w destroy $w after idle {set winwm90done ok} } proc winwm90proc2 {w} { winwm90proc3; destroy $w } proc winwm90proc1 {w} { toplevel $w pack [button $w.b -text "Do dialog" -command [list winwm90proc2 $w]] bind $w.b {bind %W {}; after idle {winwm90click %W}} } destroy .t global winwm90done set winwm90done wait toplevel .t } -body { pack [button .t.b -text "Show" -command {winwm90proc1 .tx}] bind .t.b {bind %W {}; after idle {winwm90click %W}} after 5000 {set winwm90done timeout} vwait winwm90done set winwm90done } -cleanup { foreach cmd {proc1 proc2 proc3 click} { rename winwm90$cmd {} } destroy .tx .t .sd } -result {ok} test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win -setup { proc winwm91click {w} { if {![winfo ismapped $w]} { update } event generate $w focus -force $w event generate $w -x 5 -y 5 event generate $w -x 5 -y 5 } proc winwm91proc3 {} { global winwm91done winwm91check set w .sd toplevel $w pack [button $w.b -text "OK" -command {set winwm91check 1}] bind $w.b {after idle {winwm91click %W}} update idletasks tkwait visibility $w grab $w tkwait variable winwm91check #skip the release: #grab release $w destroy $w after idle {set winwm91done ok} } proc winwm91proc2 {w} { winwm91proc3; destroy $w } proc winwm91proc1 {w} { toplevel $w pack [button $w.b -text "Do dialog" -command [list winwm91proc2 $w]] bind $w.b {bind %W {}; after idle {winwm91click %W}} } destroy .t global winwm91done set winwm91done wait toplevel .t } -body { pack [button .t.b -text "Show" -command {winwm91proc1 .tx}] bind .t.b {bind %W {}; after idle {winwm91click %W}} after 5000 {set winwm91done timeout} vwait winwm91done set winwm91done } -cleanup { foreach cmd {proc1 proc2 proc3 click} { rename winwm91$cmd {} } destroy .tx .t .sd } -result {ok} test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup { destroy .t toplevel .t set winwm92 {} frame .t.f -background blue -height 200 -width 200 frame .t.f.x -background red -height 100 -width 100 } -body { pack .t.f.x pack .t.f lappend aid [after 2000 {set ::winwm92 timeout}] [after 100 { wm manage .t.f wm iconify .t lappend aid [after 100 { wm forget .t.f wm deiconify .t lappend aid [after 100 { pack .t.f lappend aid [after 100 { set ::winwm92 [expr { [winfo rooty .t.f.x] == 0 ? "failed" : "ok"}]}] }] }] }] vwait ::winwm92 foreach id $aid { after cancel $id } set winwm92 } -cleanup { destroy .t.f.x .t.f .t unset -nocomplain winwm92 aid } -result ok destroy .t # cleanup cleanupTests return # Local variables: # mode: tcl # End: tk8.5.19/tests/color.test0000644003604700454610000002054312612445655013751 0ustar dgp771div# This file is a Tcl script to test out the procedures in the file # tkColor.c. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1995-1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # cname -- # Returns a proper name for a color, given its intensities. # # Arguments: # r, g, b - Intensities on a 0-255 scale. proc cname {r g b} { format #%02x%02x%02x $r $g $b } proc cname4 {r g b} { format #%04x%04x%04x $r $g $b } # mkColors -- # Creates a canvas and fills it with a 2-D array of squares, each of a # different color. # # Arguments: # c - Name of canvas window to create. # width - Number of squares in each row. # height - Number of squares in each column. # r, g, b - Initial value for red, green, and blue intensities. # rx, gx, bx - Change in intensities between adjacent elements in row. # ry, gy, by - Change in intensities between adjacent elements in column. proc mkColors {c width height r g b rx gx bx ry gy by} { catch {destroy $c} canvas $c -width 400 -height 200 -bd 0 for {set y 0} {$y < $height} {incr y} { for {set x 0} {$x < $width} {incr x} { set color [format #%02x%02x%02x [expr $r + $y*$ry + $x*$rx] \ [expr $g + $y*$gy + $x*$gx] [expr $b + $y*$by + $x*$bx]] $c create rectangle [expr 10*$x] [expr 20*$y] \ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ -fill $color } } } # closest - # Given intensities between 0 and 255, return the closest intensities # that the server can provide. # # Arguments: # w - Window in which to lookup color # r, g, b - Desired intensities, between 0 and 255. proc closest {w r g b} { set vals [winfo rgb $w [cname $r $g $b]] list [expr [lindex $vals 0]/256] [expr [lindex $vals 1]/256] \ [expr [lindex $vals 2]/256] } # c255 - # Given a list of red, green, and blue intensities, scale them # down to a 0-255 range. # # Arguments: # vals - List of intensities. proc c255 {vals} { list [expr {[lindex $vals 0]/256}] [expr {[lindex $vals 1]/256}] \ [expr {[lindex $vals 2]/256}] } # colorsFree -- # # Returns 1 if there appear to be free colormap entries in a window, # 0 otherwise. # # Arguments: # w - Name of window in which to check. # red, green, blue - Intensities to use in a trial color allocation # to see if there are colormap entries free. proc colorsFree {w {red 31} {green 245} {blue 192}} { set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]] expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \ && ([lindex $vals 2]/256 == $blue) } if {[testConstraint psuedocolor8]} { toplevel .t -visual {pseudocolor 8} -colormap new wm geom .t +0+0 mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40 pack .t.c update testConstraint colorsFree [colorsFree .t.c 101 233 17] if {[testConstraint colorsFree]} { mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0 pack .t.c2 testConstraint colorsFree [expr {![colorsFree .t.c]}] } destroy .t.c .t.c2 } test color-1.1 {Tk_AllocColorFromObj - converting internal reps} colorsFree { set x green lindex $x 0 destroy .b1 button .b1 -foreground $x -text .b1 lindex $x 0 testcolor green } {{1 0}} test color-1.2 {Tk_AllocColorFromObj - discard stale color} colorsFree { set x green destroy .b1 .b2 button .b1 -foreground $x -text First destroy .b1 set result {} lappend result [testcolor green] button .b2 -foreground $x -text Second lappend result [testcolor green] } {{} {{1 1}}} test color-1.3 {Tk_AllocColorFromObj - reuse existing color} colorsFree { set x green destroy .b1 .b2 button .b1 -foreground $x -text First set result {} lappend result [testcolor green] button .b2 -foreground $x -text Second pack .b1 .b2 -side top lappend result [testcolor green] } {{{1 1}} {{2 1}}} test color-1.4 {Tk_AllocColorFromObj - try other colors in list} colorsFree { set x purple destroy .b1 .b2 .t.b button .b1 -foreground $x -text First pack .b1 -side top set result {} lappend result [testcolor purple] button .t.b -foreground $x -text Second pack .t.b -side top lappend result [testcolor purple] button .b2 -foreground $x -text Third pack .b2 -side top lappend result [testcolor purple] } {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} test color-1.5 {Color table} nonPortable { set fd [open ../xlib/rgb.txt] set result {} while {[gets $fd line] != -1} { if {[string index $line 0] == "!"} continue set rgb [c255 [winfo rgb . [lrange $line 3 end]]] if {$rgb != [lrange $line 0 2] } { append result $line\n } } return $result } {} test color-2.1 {Tk_GetColor procedure} colorsFree { c255 [winfo rgb .t #FF0000] } {255 0 0} test color-2.2 {Tk_GetColor procedure} colorsFree { list [catch {winfo rgb .t noname} msg] $msg } {1 {unknown color name "noname"}} test color-2.3 {Tk_GetColor procedure} colorsFree { c255 [winfo rgb .t #123456] } {18 52 86} test color-2.4 {Tk_GetColor procedure} colorsFree { list [catch {winfo rgb .t #xyz} msg] $msg } {1 {invalid color name "#xyz"}} test color-2.5 {Tk_GetColor procedure} colorsFree { winfo rgb .t #00FF00 } {0 65535 0} test color-2.6 {Tk_GetColor procedure} {colorsFree nonPortable} { # Red doesn't always map to *pure* red winfo rgb .t red } {65535 0 0} test color-2.7 {Tk_GetColor procedure} colorsFree { winfo rgb .t #ff0000 } {65535 0 0} test color-3.1 {Tk_FreeColor procedure, reference counting} colorsFree { eval destroy [winfo child .t] mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40 pack .t.c mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0 pack .t.c2 update set last [.t.c2 create rectangle 50 50 70 60 -outline {} \ -fill [cname 0 240 240]] .t.c delete 1 set result [colorsFree .t] .t.c2 delete $last lappend result [colorsFree .t] } {0 1} test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} colorsFree { eval destroy [winfo child .t] mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40 pack .t.c mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0 mkColors .t.c2 20 1 250 250 0 -10 -10 0 0 0 0 pack .t.c2 update closest .t 241 241 1 } {240 240 0} test color-3.3 {Tk_FreeColorFromObj - reference counts} colorsFree { set x purple destroy .b1 .b2 .t.b button .b1 -foreground $x -text First pack .b1 -side top button .t.b -foreground $x -text Second pack .t.b -side top button .b2 -foreground $x -text Third pack .b2 -side top set result {} lappend result [testcolor purple] destroy .b1 lappend result [testcolor purple] destroy .b2 lappend result [testcolor purple] destroy .t.b lappend result [testcolor purple] } {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} test color-3.4 {Tk_FreeColorFromObj - unlinking from list} colorsFree { destroy .b .t.b .t2 .t3 toplevel .t2 -visual {pseudocolor 8} -colormap new toplevel .t3 -visual {pseudocolor 8} -colormap new set x purple button .b -foreground $x -text .b1 button .t.b1 -foreground $x -text .t.b1 button .t.b2 -foreground $x -text .t.b2 button .t2.b1 -foreground $x -text .t2.b1 button .t2.b2 -foreground $x -text .t2.b2 button .t2.b3 -foreground $x -text .t2.b3 button .t3.b1 -foreground $x -text .t3.b1 button .t3.b2 -foreground $x -text .t3.b2 button .t3.b3 -foreground $x -text .t3.b3 button .t3.b4 -foreground $x -text .t3.b4 set result {} lappend result [testcolor purple] destroy .t2 lappend result [testcolor purple] destroy .b lappend result [testcolor purple] destroy .t3 lappend result [testcolor purple] destroy .t lappend result [testcolor purple] } {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} test color-4.1 {FreeColorObjProc} colorsFree { destroy .b set x [format purple] button .b -foreground $x -text .b1 set y [format purple] .b configure -foreground $y set z [format purple] .b configure -foreground $z set result {} lappend result [testcolor purple] set x red lappend result [testcolor purple] set z 32 lappend result [testcolor purple] destroy .b lappend result [testcolor purple] set y bogus set result } {{{1 3}} {{1 2}} {{1 1}} {}} destroy .t # cleanup cleanupTests return tk8.5.19/tests/safe.test0000644003604700454610000001423012612445655013545 0ustar dgp771div# This file is a Tcl script to test the Safe Tk facility. It is organized # in the standard fashion for Tk tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands ## 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 # The set of hidden commands is platform dependent: if {[string equal $tcl_platform(platform) "windows"]} { set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel unload wm} } else { set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel unload wm} } set saveAutoPath $::auto_path set auto_path [list [info library] $::tk_library] test safe-1.1 {Safe Tk loading into an interpreter} { catch {safe::interpDelete a} safe::loadTk [safe::interpCreate a] safe::interpDelete a set x {} set x } "" test safe-1.2 {Safe Tk loading into an interpreter} { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set l [lsort [interp hidden a]] safe::interpDelete a set l } $hidden_cmds test safe-1.3 {Safe Tk loading into an interpreter} -body { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set l [lsort [interp aliases a]] safe::interpDelete a set l } -match glob -result {*encoding*exit*file*load*source*} test safe-2.1 {Unsafe commands not available} { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {toplevel .t}} msg]} { set status ok } safe::interpDelete a set status } ok test safe-2.2 {Unsafe commands not available} { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {menu .m}} msg]} { set status ok } safe::interpDelete a set status } ok test safe-2.3 {Unsafe subcommands not available} { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {tk appname}} msg]} { set status ok } safe::interpDelete a list $status $msg } {ok {appname not accessible in a safe interpreter}} test safe-2.4 {Unsafe subcommands not available} { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {tk scaling}} msg]} { set status ok } safe::interpDelete a list $status $msg } {ok {scaling not accessible in a safe interpreter}} test safe-3.1 {Unsafe commands are available hidden} { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set status ok if {[catch {interp invokehidden a toplevel .t} msg]} { set status broken } safe::interpDelete a set status } ok test safe-3.2 {Unsafe commands are available hidden} { catch {safe::interpDelete a} safe::interpCreate a safe::loadTk a set status ok if {[catch {interp invokehidden a menu .m} msg]} { set status broken } safe::interpDelete a set status } ok test safe-4.1 {testing loadTk} { # no error shall occur, the user will # eventually see a new toplevel set i [safe::loadTk [safe::interpCreate]] interp eval $i {button .b -text "hello world!"; pack .b} # lets don't update because it might imply that the user has # to position the window (if the wm does not do it automatically) # and thus make the test suite not runable non interactively safe::interpDelete $i } {} test safe-4.2 {testing loadTk -use} { set w .safeTkFrame catch {destroy $w} frame $w -container 1; pack .safeTkFrame set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]] interp eval $i {button .b -text "hello world!"; pack .b} safe::interpDelete $i destroy $w } {} test safe-5.1 {loading Tk in safe interps without master's clearance} { set i [safe::interpCreate] catch {interp eval $i {load {} Tk}} msg safe::interpDelete $i set msg } {not allowed to start Tk by master's safe::TkInit} test safe-5.2 {multi-level Tk loading with clearance} { # No error shall occur in that test and no window # shall remain at the end. set i [safe::interpCreate] set j [list $i x] set j [safe::interpCreate $j] safe::loadTk $j interp eval $j { button .b -text Ok -command {destroy .} pack .b # tkwait window . ; # for interactive testing/debugging } safe::interpDelete $j safe::interpDelete $i } {} test safe-6.1 {loadTk -use windowPath} { set w .safeTkFrame catch {destroy $w} frame $w -container 1; pack .safeTkFrame set i [safe::loadTk [safe::interpCreate] -use $w] interp eval $i {button .b -text "hello world!"; pack .b} safe::interpDelete $i destroy $w } {} test safe-6.2 {loadTk -use windowPath, conflicting -display} { set w .safeTkFrame catch {destroy $w} frame $w -container 1; pack .safeTkFrame set i [safe::interpCreate] catch {safe::loadTk $i -use $w -display :23.56} msg safe::interpDelete $i destroy $w string range $msg 0 36 } {conflicting -display :23.56 and -use } test safe-7.1 {canvas printing} { set i [safe::loadTk [safe::interpCreate]] set r [catch {interp eval $i {canvas .c; .c postscript}}] safe::interpDelete $i set r } 0 # cleanup set ::auto_path $saveAutoPath unset hidden_cmds cleanupTests return tk8.5.19/tests/winButton.test0000644003604700454610000001417212650173000014605 0ustar dgp771div# This file is a Tcl script to test the Windows specific behavior of # labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the # widgets defined in tkWinButton.c). It is organized in the standard # fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands proc bogusTrace args { error "trace aborted" } catch {unset value} catch {unset value2} option clear eval image delete [image names] if {[testConstraint testImageType]} { image create test image1 } label .l -text Label button .b -text Button checkbutton .c -text Checkbutton radiobutton .r -text Radiobutton pack .l .b .c .r update test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win nonPortable} { # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen # the smallest size (i.e. 8) is not available for "MS Sans Serif" font deleteWindows image create test image1 image1 changed 0 0 0 0 60 40 label .b1 -image image1 -bd 4 -padx 0 -pady 2 button .b2 -image image1 -bd 4 -padx 0 -pady 2 checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1 -font {{MS Sans Serif} 8} radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0 -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update # with patch 463234 with native L&F enabled, this returns: # {68 48 70 50 88 50 88 50} list [winfo reqwidth .b1] [winfo reqheight .b1] \ [winfo reqwidth .b2] [winfo reqheight .b2] \ [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {68 48 70 50 90 52 90 52} test winbutton-1.2 {TkpComputeButtonGeometry procedure} {win nonPortable} { # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen # the smallest size (i.e. 8) is not available for "MS Sans Serif" font deleteWindows label .b1 -bitmap question -bd 3 -padx 0 -pady 2 button .b2 -bitmap question -bd 3 -padx 0 -pady 2 checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1 -font {{MS Sans Serif} 8} radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0 -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update # with patch 463234 with native L&F enabled, this returns: # {23 33 25 35 43 35 43 35} list [winfo reqwidth .b1] [winfo reqheight .b1] \ [winfo reqwidth .b2] [winfo reqheight .b2] \ [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {23 33 25 35 45 37 45 37} test winbutton-1.3 {TkpComputeButtonGeometry procedure} win { deleteWindows label .b1 -bitmap question -bd 3 -highlightthickness 4 button .b2 -bitmap question -bd 3 -highlightthickness 0 checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \ -indicatoron 0 radiobutton .b4 -bitmap question -bd 3 -indicatoron false pack .b1 .b2 .b3 .b4 update # with patch 463234 with native L&F enabled, this returns: # {31 41 23 33 25 35 25 35} list [winfo reqwidth .b1] [winfo reqheight .b1] \ [winfo reqwidth .b2] [winfo reqheight .b2] \ [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {31 41 23 33 27 37 27 37} test winbutton-1.4 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8} radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ [winfo reqwidth .b2] [winfo reqheight .b2] \ [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {58 24 67 33 88 30 90 28} test winbutton-1.5 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0 pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] } {178 84} test winbutton-1.6 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0 pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] } {222 52} test winbutton-1.7 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2 radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ [winfo reqwidth .b2] [winfo reqheight .b2] \ [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {74 24 67 97 174 46 64 28} test winbutton-1.8 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ -highlightthickness 4 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \ -highlightthickness 0 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \ -highlightthickness 1 -indicatoron no radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ [winfo reqwidth .b2] [winfo reqheight .b2] \ [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {66 32 65 31 69 31 71 29} test winbutton-1.9 {TkpComputeButtonGeometry procedure} win { deleteWindows button .b2 -bitmap question -default normal list [winfo reqwidth .b2] [winfo reqheight .b2] } {23 33} # cleanup deleteWindows cleanupTests return tk8.5.19/tests/textBTree.test0000644003604700454610000006613612612445655014551 0ustar dgp771div# This file is a Tcl script to test out the B-tree facilities of # Tk's text widget (the contents of the file "tkTextBTree.c". There are # several file with additional tests for other features of text widgets. # This file is organized in the standard fashion for Tcl tests. # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands catch {destroy .t} text .t .t debug on test btree-1.1 {basic insertions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" test btree-1.2 {basic insertions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 1.3 XXX .t get 1.0 1000000.0 } "LinXXXe 1\nLine 2\nLine 3\n" test btree-1.3 {basic insertions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 3.0 YYY .t get 1.0 1000000.0 } "Line 1\nLine 2\nYYYLine 3\n" test btree-1.4 {basic insertions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.1 X\nYY .t get 1.0 1000000.0 } "Line 1\nLX\nYYine 2\nLine 3\n" test btree-1.5 {basic insertions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.0 X\n\n\n .t get 1.0 1000000.0 } "Line 1\nX\n\n\nLine 2\nLine 3\n" test btree-1.6 {basic insertions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.6 X\n .t get 1.0 1000000.0 } "Line 1\nLine 2X\n\nLine 3\n" test btree-1.7 {insertion before start of text} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 0.4 XXX .t get 1.0 1000000.0 } "XXXLine 1\nLine 2\nLine 3\n" test btree-1.8 {insertion past end of text} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 100.0 ZZ .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3ZZ\n" test btree-1.9 {insertion before start of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.-3 Q .t get 1.0 1000000.0 } "Line 1\nQLine 2\nLine 3\n" test btree-1.10 {insertion past end of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.40 XYZZY .t get 1.0 1000000.0 } "Line 1\nLine 2XYZZY\nLine 3\n" test btree-1.11 {insertion past end of last line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 3.40 ABC .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3ABC\n" test btree-2.1 {basic deletions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.0 1.3 .t get 1.0 1000000.0 } "e 1\nLine 2\nLine 3\n" test btree-2.2 {basic deletions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 2.2 .t get 1.0 1000000.0 } "Line 1\nLie 2\nLine 3\n" test btree-2.3 {basic deletions} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 2.0 2.3 .t get 1.0 1000000.0 } "Line 1\ne 2\nLine 3\n" test btree-2.4 {deleting whole lines} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.2 3.0 .t get 1.0 1000000.0 } "LiLine 3\n" test btree-2.5 {deleting whole lines} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\n\n\nLine 5" .t delete 1.0 5.2 .t get 1.0 1000000.0 } "ne 5\n" test btree-2.6 {deleting before start of file} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 0.3 1.2 .t get 1.0 1000000.0 } "ne 1\nLine 2\nLine 3\n" test btree-2.7 {deleting after end of file} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 10.3 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" test btree-2.8 {deleting before start of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.-1 3.3 .t get 1.0 1000000.0 } "Line 1\nLine 2\ne 3\n" test btree-2.9 {deleting before start of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.-1 1.0 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" test btree-2.10 {deleting after end of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.8 2.1 .t get 1.0 1000000.0 } "Line 1ine 2\nLine 3\n" test btree-2.11 {deleting after end of last line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.8 4.1 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" test btree-2.12 {deleting before start of file} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.8 0.0 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" test btree-2.13 {deleting past end of file} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.8 4.0 .t get 1.0 1000000.0 } "Line 1\n" test btree-2.14 {deleting with end before start of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.3 2.-3 .t get 1.0 1000000.0 } "LinLine 2\nLine 3\n" test btree-2.15 {deleting past end of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.3 1.9 .t get 1.0 1000000.0 } "Lin\nLine 2\nLine 3\n" test btree-2.16 {deleting past end of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 3.15 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLi\n" test btree-2.17 {deleting past end of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.0 3.15 .t get 1.0 1000000.0 } "Line 1\nLine 2\n\n" test btree-2.18 {deleting past end of line} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.0 3.15 .t get 1.0 1000000.0 } "\n" test btree-2.19 {deleting with negative range} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 2.4 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" test btree-2.20 {deleting with negative range} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 3.1 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" test btree-2.21 {deleting with negative range} { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 3.2 .t get 1.0 1000000.0 } "Line 1\nLine 2\nLine 3\n" proc setup {} { .t delete 1.0 100000.0 .t tag delete x y .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.1 .t tag add x 1.5 1.13 .t tag add x 2.2 2.6 .t tag add y 1.5 } test btree-3.1 {inserting with tags} { setup .t insert 1.0 XXX list [.t tag ranges x] [.t tag ranges y] } {{1.4 1.5 1.8 1.16 2.2 2.6} {1.8 1.9}} test btree-3.2 {inserting with tags} { setup .t insert 1.15 YYY list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 1.13 2.2 2.6} {1.5 1.6}} test btree-3.3 {inserting with tags} { setup .t insert 1.7 ZZZZ list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 1.17 2.2 2.6} {1.5 1.6}} test btree-3.4 {inserting with tags} { setup .t insert 1.7 \n\n list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 3.6 4.2 4.6} {1.5 1.6}} test btree-3.5 {inserting with tags} { setup .t insert 1.5 A\n list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 2.0 2.8 3.2 3.6} {2.0 2.1}} test btree-3.6 {inserting with tags} { setup .t insert 1.13 A\n list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 1.13 3.2 3.6} {1.5 1.6}} test btree-4.1 {deleting with tags} { setup .t delete 1.6 1.9 list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}} test btree-4.2 {deleting with tags} { setup .t delete 1.1 2.3 list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.4} {}} test btree-4.3 {deleting with tags} { setup .t delete 1.4 2.1 list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 1.9} {}} test btree-4.4 {deleting with tags} { setup .t delete 1.14 2.1 list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 1.13 1.15 1.19} {1.5 1.6}} test btree-4.5 {deleting with tags} { setup .t delete 1.0 2.10 list [.t tag ranges x] [.t tag ranges y] } {{} {}} test btree-4.6 {deleting with tags} { setup .t delete 1.0 1.5 list [.t tag ranges x] [.t tag ranges y] } {{1.0 1.8 2.2 2.6} {1.0 1.1}} test btree-4.7 {deleting with tags} { setup .t delete 1.6 1.9 list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}} test btree-4.8 {deleting with tags} { setup .t delete 1.5 1.13 list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 2.2 2.6} {}} set bigText1 {} for {set i 0} {$i < 10} {incr i} { append bigText1 "Line $i\n" } set bigText2 {} for {set i 0} {$i < 200} {incr i} { append bigText2 "Line $i\n" } test btree-5.1 {very large inserts, with tags} { setup .t insert 1.0 $bigText1 list [.t tag ranges x] [.t tag ranges y] } {{11.1 11.2 11.5 11.13 12.2 12.6} {11.5 11.6}} test btree-5.2 {very large inserts, with tags} { setup .t insert 1.2 $bigText2 list [.t tag ranges x] [.t tag ranges y] } {{1.1 1.2 201.3 201.11 202.2 202.6} {201.3 201.4}} test btree-5.3 {very large inserts, with tags} { setup for {set i 0} {$i < 200} {incr i} { .t insert 1.8 "longer line $i\n" } list [.t tag ranges x] [.t tag ranges y] [.t get 1.0 1.100] [.t get 198.0 198.100] } {{1.1 1.2 1.5 201.5 202.2 202.6} {1.5 1.6} {Text forlonger line 199} {longer line 2}} test btree-6.1 {very large deletes, with tags} { setup .t insert 1.1 $bigText2 .t delete 1.2 201.2 list [.t tag ranges x] [.t tag ranges y] } {{1.4 1.12 2.2 2.6} {1.4 1.5}} test btree-6.2 {very large deletes, with tags} { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 200} {incr i} { .t delete 1.2 2.2 } list [.t tag ranges x] [.t tag ranges y] } {{1.4 1.12 2.2 2.6} {1.4 1.5}} test btree-6.3 {very large deletes, with tags} { setup .t insert 1.1 $bigText2 .t delete 2.3 10000.0 .t get 1.0 1000.0 } {TLine 0 Lin } test btree-6.4 {very large deletes, with tags} { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 100} {incr i} { .t delete 30.0 31.0 } list [.t tag ranges x] [.t tag ranges y] } {{101.0 101.1 101.4 101.12 102.2 102.6} {101.4 101.5}} test btree-6.5 {very large deletes, with tags} { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 100} {incr i} { set j [expr $i+2] set k [expr 1+2*$i] .t tag add x $j.1 $j.3 .t tag add y $k.1 $k.6 } .t delete 2.0 200.0 list [.t tag ranges x] [.t tag ranges y] } {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}} test btree-6.6 {very large deletes, with tags} { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 100} {incr i} { set j [expr $i+2] set k [expr 1+2*$i] .t tag add x $j.1 $j.3 .t tag add y $k.1 $k.6 } for {set i 199} {$i >= 2} {incr i -1} { .t delete $i.0 [expr $i+1].0 } list [.t tag ranges x] [.t tag ranges y] } {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}} .t delete 1.0 end .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" set i 1 foreach check { {1.3 1.6 1.7 2.0 {1.3 1.6 1.7 2.0}} {1.3 1.6 1.6 2.0 {1.3 2.0}} {1.3 1.6 1.4 2.0 {1.3 2.0}} {2.0 4.3 1.4 1.10 {1.4 1.10 2.0 4.3}} {2.0 4.3 1.4 1.end {1.4 1.19 2.0 4.3}} {2.0 4.3 1.4 2.0 {1.4 4.3}} {2.0 4.3 1.4 3.0 {1.4 4.3}} {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 4.2 {1.1 4.2}} {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.3 4.2 {1.2 4.2}} {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 3.0 {1.1 4.0}} {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.2 3.0 {1.2 4.0}} } { test btree-7.$i {tag addition and removal} { .t tag remove x 1.0 end while {[llength $check] > 2} { .t tag add x [lindex $check 0] [lindex $check 1] set check [lrange $check 2 end] } .t tag ranges x } [lindex $check [expr [llength $check]-1]] incr i } test btree-8.1 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 0.0 1.3 .t tag ranges x } {1.0 1.3} test btree-8.2 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.40 2.4 .t tag ranges x } {1.19 2.4} test btree-8.3 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 4.40 4.41 .t tag ranges x } {} test btree-8.4 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 5.1 5.2 .t tag ranges x } {} test btree-8.5 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.1 9.0 .t tag ranges x } {1.1 5.0} test btree-8.6 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.1 1.90 .t tag ranges x } {1.1 1.19} test btree-8.7 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.1 4.90 .t tag ranges x } {1.1 4.17} test btree-8.8 {tag addition and removal, weird ranges} { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 3.0 3.0 .t tag ranges x } {} test btree-9.1 {tag names} { setup .t tag names } {sel x y} test btree-9.2 {tag names} { setup .t tag add tag1 1.8 .t tag add tag2 1.8 .t tag add tag3 1.7 1.9 .t tag names 1.8 } {x tag1 tag2 tag3} test btree-9.3 {lots of tag names} { setup .t insert 1.2 $bigText2 foreach i {tag1 foo ThisOne {x space} q r s t} { .t tag add $i 150.2 } foreach i {u tagA tagB tagC and more {$} \{} { .t tag add $i 150.1 150.3 } .t tag names 150.2 } {tag1 foo ThisOne {x space} q r s t u tagA tagB tagC and more {$} \{} test btree-9.4 {lots of tag names} { setup .t insert 1.2 $bigText2 .t tag delete tag1 foo ThisOne more {x space} q r s t u .t tag delete tagA tagB tagC and {$} \{ more foreach i {tag1 foo ThisOne more {x space} q r s t} { .t tag add $i 150.2 } foreach i {foo ThisOne u tagA tagB tagC and more {$} \{} { .t tag add $i 150.4 } .t tag delete tag1 more q r tagA .t tag names 150.2 } {foo ThisOne {x space} s t} proc msetup {} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t mark set m1 1.2 .t mark set l1 1.2 .t mark gravity l1 left .t mark set next 1.6 .t mark set x 1.6 .t mark set m2 2.0 .t mark set m3 2.100 .t tag add x 1.3 1.8 } test btree-10.1 {basic mark facilities} { msetup list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3] } {{current insert l1 m1 m2 m3 next x} 1.2 2.0 2.11} test btree-10.2 {basic mark facilities} { msetup .t mark unset m2 lsort [.t mark names] } {current insert l1 m1 m3 next x} test btree-10.3 {basic mark facilities} { msetup .t mark set m2 1.8 list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3] } {{current insert l1 m1 m2 m3 next x} 1.2 1.8 2.11} test btree-11.1 {marks and inserts} { msetup .t insert 1.1 abcde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.7 1.7 1.11 1.11 2.0 2.11} test btree-11.2 {marks and inserts} { msetup .t insert 1.2 abcde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.7 1.11 1.11 2.0 2.11} test btree-11.3 {marks and inserts} { msetup .t insert 1.3 abcde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 1.11 1.11 2.0 2.11} test btree-11.4 {marks and inserts} { msetup .t insert 1.1 ab\n\ncde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {3.4 3.4 3.8 3.8 4.0 4.11} test btree-11.5 {marks and inserts} { msetup .t insert 1.4 ab\n\ncde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 3.5 3.5 4.0 4.11} test btree-11.6 {marks and inserts} { msetup .t insert 1.7 ab\n\ncde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 1.6 1.6 4.0 4.11} test btree-12.1 {marks and deletes} { msetup .t delete 1.3 1.5 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 1.4 1.4 2.0 2.11} test btree-12.2 {marks and deletes} { msetup .t delete 1.3 1.8 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 1.3 1.3 2.0 2.11} test btree-12.3 {marks and deletes} { msetup .t delete 1.2 1.8 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 1.2 1.2 2.0 2.11} test btree-12.4 {marks and deletes} { msetup .t delete 1.1 1.8 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.1 1.1 1.1 1.1 2.0 2.11} test btree-12.5 {marks and deletes} { msetup .t delete 1.5 3.1 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 1.5 1.5 1.5 1.5} test btree-12.6 {marks and deletes} { msetup .t mark set m2 4.5 .t delete 1.5 4.1 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.2 1.5 1.5 1.9 1.5} test btree-12.7 {marks and deletes} { msetup .t mark set m2 4.5 .t mark set m3 4.5 .t mark set m1 4.7 .t delete 1.5 4.1 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } {1.2 1.11 1.5 1.5 1.9 1.9} destroy .t text .t test btree-13.1 {tag searching} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag next x 2.2 2.1 } {} test btree-13.2 {tag searching} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.2 2.4 .t tag next x 2.2 2.3 } {2.2 2.4} test btree-13.3 {tag searching} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.2 2.4 .t tag next x 2.3 2.6 } {} test btree-13.4 {tag searching} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.5 2.8 .t tag next x 2.1 2.6 } {2.5 2.8} test btree-13.5 {tag searching} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.5 2.8 .t tag next x 2.1 2.5 } {} test btree-13.6 {tag searching} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.1 2.4 .t tag next x 2.5 2.8 } {} test btree-13.7 {tag searching} { .t delete 1.0 100000.0 .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.5 2.8 .t tag next x 2.1 2.4 } {} test btree-13.8 {tag searching} { setup .t insert 1.2 $bigText2 .t tag add x 190.3 191.2 .t tag next x 3.5 } {190.3 191.2} test btree-14.1 {check tag presence} { setup .t insert 1.2 $bigText2 .t tag add x 3.5 3.7 .t tag add y 133.9 141.5 .t tag add z 1.5 180.2 .t tag add q 141.4 142.3 .t tag add x 130.2 145.1 .t tag add a 141.0 .t tag add b 4.3 .t tag add b 7.5 .t tag add b 140.3 for {set i 120} {$i < 160} {incr i} { .t tag add c $i.4 } foreach i {a1 a2 a3 a4 a5 a6 a7 a8 a9 10 a11 a12 a13} { .t tag add $i 122.2 } .t tag add x 141.3 .t tag names 141.1 } {x y z} test btree-14.2 {TkTextIsElided} { .t delete 1.0 end .t tag config hidden -elide 1 .t insert end "Line1\nLine2\nLine3\n" .t tag add hidden 2.0 3.0 .t tag add sel 1.2 3.2 # next line used to panic because of "Bad tag priority being toggled on" # (see bug [382da038c9]) .t index "2.0 - 1 display line linestart" } {1.0} test btree-15.1 {rebalance with empty node} { catch {destroy .t} text .t .t debug 1 .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23" .t delete 6.0 12.0 .t get 1.0 end } "1\n2\n3\n4\n5\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23\n" proc setupBig {} { .t delete 1.0 end .t tag delete x y .t tag configure x -foreground blue .t tag configure y -underline true # Create a Btree with 2002 lines (2000 + already existing + phantom at end) # This generates a level 3 node with 9 children # Most level 2 nodes cover 216 lines and have 6 children, except the last # level 2 node covers 274 lines and has 7 children. # Most level 1 nodes cover 36 lines and have 6 children, except the # rightmost node has 58 lines and 9 children. # Level 2: 2002 = 8*216 + 274 # Level 1: 2002 = 54*36 + 58 # Level 0: 2002 = 332*6 + 10 for {set i 0} {$i < 2000} {incr i} { append x "Line $i abcd efgh ijkl\n" } .t insert insert $x .t debug 1 } test btree-16.1 {add tag does not push root above level 0} { catch {destroy .t} text .t setupBig .t tag add x 1.1 1.10 .t tag add x 5.1 5.10 .t tag ranges x } {1.1 1.10 5.1 5.10} test btree-16.2 {add tag pushes root up to level 1 node} { catch {destroy .t} text .t .t debug 1 setupBig .t tag add x 1.1 1.10 .t tag add x 8.1 8.10 .t tag ranges x } {1.1 1.10 8.1 8.10} test btree-16.3 {add tag pushes root up to level 2 node} { .t tag remove x 1.0 end .t tag add x 8.1 9.10 .t tag add x 180.1 180.end .t tag ranges x } {8.1 9.10 180.1 180.23} test btree-16.4 {add tag pushes root up to level 3 node} { .t tag remove x 1.0 end .t tag add y 1.1 2000.0 .t tag add x 1.1 8.10 .t tag add x 180.end 217.0 list [.t tag ranges x] [.t tag ranges y] } {{1.1 8.10 180.23 217.0} {1.1 2000.0}} test btree-16.5 {add tag doesn't push root up} { .t tag remove x 1.0 end .t tag add x 1.1 8.10 .t tag add x 2000.0 2000.3 .t tag add x 180.end 217.0 .t tag ranges x } {1.1 8.10 180.23 217.0 2000.0 2000.3} test btree-16.6 {two node splits at once pushes root up} { .t delete 1.0 end for {set i 1} {$i < 10} {incr i} { .t insert end "Line $i\n" } .t tag add x 8.0 8.end .t tag add y 9.0 end set x {} for {} {$i < 50} {incr i} { append x "Line $i\n" } .t insert end $x y list [.t tag ranges x] [.t tag ranges y] } {{8.0 8.6} {9.0 51.0}} # The following find bugs in the SearchStart procedures test btree-16.7 {Partial tag remove from before first range} { .t tag remove x 1.0 end .t tag add x 2.0 2.6 .t tag remove x 1.0 2.0 .t tag ranges x } {2.0 2.6} test btree-16.8 {Partial tag remove from before first range} { .t tag remove x 1.0 end .t tag add x 2.0 2.6 .t tag remove x 1.0 2.1 .t tag ranges x } {2.1 2.6} test btree-16.9 {Partial tag remove from before first range} { .t tag remove x 1.0 end .t tag add x 2.0 2.6 .t tag remove x 1.0 2.3 .t tag ranges x } {2.3 2.6} test btree-16.10 {Partial tag remove from before first range} { .t tag remove x 1.0 end .t tag add x 1.0 2.6 .t tag remove x 1.0 2.5 .t tag ranges x } {2.5 2.6} test btree-16.11 {StartSearchBack boundary case} { .t tag remove x 1.0 end .t tag add x 1.3 1.4 .t tag prevr x 2.0 1.4 } {} test btree-16.12 {StartSearchBack boundary case} { .t tag remove x 1.0 end .t tag add x 1.3 1.4 .t tag prevr x 2.0 1.3 } {1.3 1.4} test btree-16.13 {StartSearchBack boundary case} { .t tag remove x 1.0 end .t tag add x 1.0 1.4 .t tag prevr x 1.3 } {1.0 1.4} test btree-17.1 {remove tag does not push root down} { catch {destroy .t} text .t .t debug 0 setupBig .t tag add x 1.1 5.10 .t tag remove x 3.1 5.end .t tag ranges x } {1.1 3.1} test btree-17.2 {remove tag pushes root from level 1 to level 0} { .t tag remove x 1.0 end .t tag add x 1.1 8.10 .t tag remove x 3.1 end .t tag ranges x } {1.1 3.1} test btree-17.3 {remove tag pushes root from level 2 to level 1} { .t tag remove x 1.0 end .t tag add x 1.1 180.10 .t tag remove x 35.1 end .t tag ranges x } {1.1 35.1} test btree-17.4 {remove tag doesn't change level 2} { .t tag remove x 1.0 end .t tag add x 1.1 180.10 .t tag remove x 35.1 180.0 .t tag ranges x } {1.1 35.1 180.0 180.10} test btree-17.5 {remove tag pushes root from level 3 to level 0} { .t tag remove x 1.0 end .t tag add x 1.1 1.10 .t tag add x 2000.1 2000.10 .t tag remove x 1.0 2000.0 .t tag ranges x } {2000.1 2000.10} test btree-17.6 {text deletion pushes root from level 3 to level 0} { .t tag remove x 1.0 end .t tag add x 1.1 1.10 .t tag add x 2000.1 2000.10 .t delete 1.0 "1000.0 lineend +1 char" .t tag ranges x } {1000.1 1000.10} catch {destroy .t} text .t test btree-18.1 {tag search back, no tag} { .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag prev x 1.1 1.1 } {} test btree-18.2 {tag search back, start at existing range} { .t tag remove x 1.0 end .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 1.1 } {} test btree-18.3 {tag search back, end at existing range} { .t tag remove x 1.0 end .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 1.3 1.1 } {1.1 1.4} test btree-18.4 {tag search back, start within range} { .t tag remove x 1.0 end .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 1.10 1.0 } {1.8 1.11} test btree-18.5 {tag search back, start at end of range} { .t tag remove x 1.0 end .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 list [.t tag prev x 1.4 1.0] [.t tag prev x 1.11 1.0] } {{1.1 1.4} {1.8 1.11}} test btree-18.6 {tag search back, start beyond range, same level 0 node} { .t tag remove x 1.0 end .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 3.0 } {1.16 1.17} test btree-18.7 {tag search back, outside any range} { .t tag remove x 1.0 end .t tag add x 1.1 1.4 .t tag add x 1.16 .t tag prev x 1.8 1.5 } {} test btree-18.8 {tag search back, start at start of node boundary} { setupBig .t tag remove x 1.0 end .t tag add x 2.5 2.8 .t tag prev x 19.0 } {2.5 2.8} test btree-18.9 {tag search back, large complex btree spans} { .t tag remove x 1.0 end .t tag add x 1.3 1.end .t tag add x 200.0 220.0 .t tag add x 500.0 520.0 list [.t tag prev x end] [.t tag prev x 433.0] } {{500.0 520.0} {200.0 220.0}} destroy .t # cleanup cleanupTests return tk8.5.19/tests/menuDraw.test0000644003604700454610000004065212612445655014420 0ustar dgp771div# This file is a Tcl script to test drawing of menus in Tk. It is # organized in the standard fashion for Tcl tests. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands test menuDraw-1.1 {TkMenuInitializeDrawingFields} { catch {destroy .m1} list [menu .m1] [destroy .m1] } {.m1 {}} test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} { catch {destroy .m1} menu .m1 list [.m1 add command] [destroy .m1] } {{} {}} test menuDraw-3.1 {TkMenuFreeDrawOptions} { catch {destroy .m1} menu .m1 list [destroy .m1] } {{}} test menuDraw-4.1 {TkMenuEntryFreeDrawOptions} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a test" list [destroy .m1] } {{}} test menuDraw-4.2 {TkMenuEntryFreeDrawOptions} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label "This is a test." -font "Courier 12" -activeforeground red -background green -selectcolor purple list [destroy .m1] } {{}} test menuDraw-5.1 {TkMenuConfigureDrawOptions - new menu} { catch {destroy .m1} list [menu .m1] [destroy .m1] } {.m1 {}} test menuDraw-5.2 {TkMenuConfigureDrawOptions - old menu} { catch {destroy .m1} menu .m1 list [.m1 configure -fg red] [destroy .m1] } {{} {}} test menuDraw-5.3 {TkMenuConfigureDrawOptions - no disabledFg} { catch {destroy .m1} list [menu .m1 -disabledforeground ""] [destroy .m1] } {.m1 {}} test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} { catch {destroy .m1} menu .m1 list [.m1 add command -label "foo"] [destroy .m1] } {{} {}} test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} { catch {destroy .m1} menu .m1 list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1] } {{} {}} test menuDraw-6.3 {TkMenuConfigureEntryDrawOptions - active state - wrong entry} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" list [.m1 entryconfigure 1 -state active] [destroy .m1] } {{} {}} test menuDraw-6.4 {TkMenuConfigureEntryDrawOptions - active state - correct entry} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" .m1 activate 1 list [.m1 entryconfigure 1 -state active] [destroy .m1] } {{} {}} test menuDraw-6.5 {TkMenuConfigureEntryDrawOptions - deactivate entry} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" .m1 activate 1 list [.m1 entryconfigure 1 -state normal] [destroy .m1] } {{} {}} test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1] } {1 {bad state "foo": must be active, normal, or disabled} {}} test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} { catch {destroy .m1} menu .m1 list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1] } {{} {}} test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} { catch {destroy .m1} menu .m1 list [.m1 add command -label "foo" -background "red"] [destroy .m1] } {{} {}} test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} { catch {destroy .m1} menu .m1 list [.m1 add command -label "foo" -foreground "red"] [destroy .m1] } {{} {}} test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} { catch {destroy .m1} menu .m1 list [.m1 add command -label "foo" -activebackground "red"] [destroy .m1] } {{} {}} test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified} { catch {destroy .m1} menu .m1 list [.m1 add command -label "foo" -activeforeground "red"] [destroy .m1] } {{} {}} test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} { catch {destroy .m1} menu .m1 list [.m1 add radiobutton -label "foo" -selectcolor "red"] [destroy .m1] } {{} {}} test menuDraw-6.13 {TkMenuConfigureEntryDrawOptions - textGC disposal} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" -font "Helvetica 12" list [.m1 entryconfigure 1 -font "Courier 12"] [destroy .m1] } {{} {}} test menuDraw-6.14 {TkMenuConfigureEntryDrawOptions - activeGC disposal} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" -activeforeground "red" list [.m1 entryconfigure 1 -activeforeground "green"] [destroy .m1] } {{} {}} test menuDraw-6.15 {TkMenuConfigureEntryDrawOptions - disabledGC disposal} { catch {destroy .m1} menu .m1 -disabledforeground "red" .m1 add command -label "foo" list [.m1 configure -disabledforeground "green"] [destroy .m1] } {{} {}} test menuDraw-6.16 {TkMenuConfigureEntryDrawOptions - indicatorGC disposal} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label "foo" -selectcolor "red" list [.m1 entryconfigure 1 -selectcolor "green"] [destroy .m1] } {{} {}} test menuDraw-7.1 {TkEventuallyRecomputeMenu} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a long label" set tearoff [tk::TearOffMenu .m1] update idletasks list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] } {{} {}} test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a long label" set tearoff [tk::TearOffMenu .m1] list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] } {{} {}} test menuDraw-8.1 {TkRecomputeMenu} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 configure -postcommand [.m1 add command -label foo] .m1 add command -label "Hit ESCAPE to make this menu go away." list [.m1 post 0 0] [destroy .m1] } {{} {}} test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} { catch {destroy .m1} catch {unset foo} menu .m1 set foo 0 .m1 add radiobutton -variable foo -label test tk::TearOffMenu .m1 update idletasks list [set foo test] [destroy .m1] [unset foo] } {test {} {}} test menuDraw-9.2 {TkEventuallyRedrawMenu - whole menu} { catch {destroy .m1} menu .m1 list [catch {tk::TearOffMenu .m1}] [destroy .m1] } {0 {}} # Don't know how to test when window has been deleted and ComputeMenuGeometry # gets called. test menuDraw-10.1 {ComputeMenuGeometry - menubar} { catch {destroy .m1} menu .m1 .m1 add command -label test . configure -menu .m1 list [update idletasks] [. configure -menu ""] [destroy .m1] } {{} {} {}} test menuDraw-10.2 {ComputeMenuGeometry - non-menubar} { catch {destroy .m1} menu .m1 .m1 add command -label test list [update idletasks] [destroy .m1] } {{} {}} test menuDraw-10.3 {ComputeMenuGeometry - Resize necessary} { catch {destroy .m1} menu .m1 .m1 add command -label test list [update idletasks] [destroy .m1] } {{} {}} test menuDraw-10.4 {ComputeMenuGeometry - resize not necessary} { catch {destroy .m1} menu .m1 .m1 add command -label test update idletasks .m1 entryconfigure 1 -label test list [update idletasks] [destroy .m1] } {{} {}} test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} testImageType { catch {destroy .m1} catch {eval image delete [image names]} image create test image1 image create test image2 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] update idletasks list [image delete image2] [destroy .m1] [eval image delete [image names]] } {{} {} {}} test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} testImageType { catch {destroy .m1} catch {eval image delete [image names]} image create test image1 image create test image2 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [image delete image2] [destroy .m1] [eval image delete [image names]] } {{} {} {}} test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} testImageType { catch {destroy .m1} catch {eval image delete [image names]} image create test image1 image create test image2 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 set tearoff [tk::TearOffMenu .m1 40 40] update idletasks list [image delete image2] [destroy .m1] [eval image delete [image names]] } {{} {} {}} #Don't know how to test missing tkwin in DisplayMenu test menuDraw-12.1 {DisplayMenu - menubar background} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo -menu .m2 . configure -menu .m1 list [update] [. configure -menu ""] [destroy .m1] } {{} {} {}} test menuDraw-12.2 {Display menu - no entries} { catch {destroy .m1} menu .m1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.3 {DisplayMenu - one entry} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.4 {DisplayMenu - two entries} { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw.12.5 {DisplayMenu - two columns - first bigger} { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" .m1 add command -label "three" -columnbreak 1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.5 {DisplayMenu - two column - second bigger} { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" -columnbreak 1 .m1 add command -label "three" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw.12.7 {DisplayMenu - three columns} { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" -columnbreak 1 .m1 add command -label "three" .m1 add command -label "four" .m1 add command -label "five" .m1 add command -label "six" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} test menuDraw-12.6 {Display menu - testing for extra space and menubars} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo . configure -menu .m1 list [update] [. configure -menu ""] [destroy .m1] } {{} {} {}} test menuDraw-12.7 {Display menu - extra space at end of menu} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo set tearoff [tk::TearOffMenu .m1 40 40] wm geometry $tearoff 200x100 list [update] [destroy .m1] } {{} {}} test menuDraw-13.1 {TkMenuEventProc - Expose} { catch {destroy .m1} catch {destroy .m2} menu .m1 .m1 add command -label "one" menu .m2 .m2 add command -label "two" set tearoff1 [tk::TearOffMenu .m1 40 40] set tearoff2 [tk::TearOffMenu .m2 40 40] list [raise $tearoff2] [update] [destroy .m1] [destroy .m2] } {{} {} {} {}} test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" set tearoff [tk::TearOffMenu .m1 40 40] list [wm geometry $tearoff 200x100] [update] [destroy .m1] } {{} {} {}} # Testing deletes is hard, and I am going to do my best. Don't know how # to test the case where we have already cleared the tkwin field in the # menuPtr. test menuDraw-13.4 {TkMenuEventProc - simple delete} { catch {destroy .m1} menu .m1 list [destroy .m1] } {{}} test menuDraw-13.5 {TkMenuEventProc - nothing pending} { catch {destroy .m1} menu .m1 .m1 add command -label foo update idletasks list [destroy .m1] } {{}} test menuDraw-14.1 {TkMenuImageProc} testImageType { catch {destroy .m1} catch {image delete image1} menu .m1 image create test image1 .m1 add command -image image1 update idletasks list [image delete image1] [destroy .m1] } {{} {}} test menuDraw-14.2 {TkMenuImageProc} testImageType { catch {destroy .m1} catch {image delete image1} menu .m1 image create test image1 .m1 add command -image image1 list [image delete image1] [destroy .m1] } {{} {}} test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" -state active set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff index active] [destroy .m1] } {none {}} test menuDraw-15.3 {TkPostTearoffMenu - post command} { catch {destroy .m1} catch {unset foo} menu .m1 -postcommand "set foo .m1" .m1 add command -label "foo" list [catch {tk::TearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1] } {0 .m1 {} {}} test menuDraw-15.4 {TkPostTearoffMenu - post command deleting the menu} { catch {destroy .m1} menu .m1 -postcommand "destroy .m1" .m1 add command -label "foo" list [catch {tk::TearOffMenu .m1 40 40} msg] $msg [winfo exists .m1] } {0 {} 0} test menuDraw-15.5 {TkPostTearoffMenu - tearoff at edge of screen} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" set height [winfo screenheight .m1] list [catch {tk::TearOffMenu .m1 40 $height}] [destroy .m1] } {0 {}} test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" set width [winfo screenwidth .m1] list [catch {tk::TearOffMenu .m1 $width 40}] [destroy .m1] } {0 {}} test menuDraw-16.1 {TkPostSubmenu} nonUnixUserInteraction { catch {destroy .m1} catch {destroy .m2} menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to make this menu go away." set tearoff [tk::TearOffMenu .m1 40 40] $tearoff postcascade 0 list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} test menuDraw-16.2 {TkPostSubMenu} nonUnixUserInteraction { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} menu .m1 .m1 add cascade -label "two" -menu .m2 .m1 add cascade -label "three" -menu .m3 menu .m2 .m2 add command -label "two" menu .m3 .m3 add command -label "three" set tearoff [tk::TearOffMenu .m1 40 40] $tearoff postcascade 0 list [$tearoff postcascade 1] [destroy .m1] [destroy .m2] [destroy .m3] } {{} {} {} {}} test menuDraw-16.3 {TkPostSubMenu} { catch {destroy .m1} menu .m1 .m1 add cascade -label test -menu .m2 list [.m1 postcascade 1] [destroy .m1] } {{} {}} test menuDraw-16.4 {TkPostSubMenu} { catch {destroy .m1} menu .m1 .m1 add cascade -label test set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff postcascade 0] [destroy .m1] } {{} {}} test menuDraw-16.5 {TkPostSubMenu} unix { catch {destroy .m1} catch {destroy .m2} menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 -postcommand "glorp" set tearoff [tk::TearOffMenu .m1 40 40] list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2] } {1 {invalid command name "glorp"} {} {}} test menuDraw-16.6 {TkPostSubMenu} {win userInteraction} { catch {destroy .m1} catch {destroy .m2} menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to get rid of this menu" set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} test menuDraw-17.1 {AdjustMenuCoords - menubar} unix { catch {destroy .m1} catch {destroy .m2} menu .m1 -tearoff 0 .m1 add cascade -label test -menu .m2 menu .m2 -tearoff 0 .m2 add command -label foo . configure -menu .m1 foreach w [winfo children .] { if {[$w cget -type] == "menubar"} { break } } list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2] } {{} {} {} {}} test menuDraw-17.2 {AdjustMenuCoords - menu} {win userInteraction} { catch {destroy .m1} catch {destroy .m2} menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to make this menu go away" set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} # cleanup deleteWindows cleanupTests return tk8.5.19/tests/option.test0000644003604700454610000002570012656164704014144 0ustar dgp771div# This file is a Tcl script to test out the option-handling facilities # of Tk. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint appNameIsTktest [expr {[winfo name .] eq "tktest"}] catch {destroy .op1} catch {destroy .op2} set appName [winfo name .] # First, test basic retrievals, being sure to trigger all the various # types of NodeElements (EXACT_LEAF_NAME, WILDCARD_NODE_CLASS, and # everything in-between). frame .op1 -class Class1 frame .op2 -class Class2 frame .op1.op3 -class Class1 frame .op1.op4 -class Class3 frame .op2.op5 -class Class2 frame .op1.op3.op6 -class Class4 option clear option add *Color1 red option add *x blue option add *Class1.x yellow option add $appName.op1.x green option add *Class2.Color1 orange option add $appName.op2.op5.Color2 purple option add $appName.Class1.Class3.y brown option add $appName*op6*Color2 black option add $appName*Class1.op1.Color2 grey test option-1.1 {basic option retrieval} {option get . x Color1} blue test option-1.2 {basic option retrieval} {option get . y Color1} red test option-1.3 {basic option retrieval} {option get . z Color1} red test option-1.4 {basic option retrieval} {option get . x Color2} blue test option-1.5 {basic option retrieval} {option get . y Color2} {} test option-1.6 {basic option retrieval} {option get . z Color2} {} test option-2.1 {basic option retrieval} {option get .op1 x Color1} green test option-2.2 {basic option retrieval} {option get .op1 y Color1} red test option-2.3 {basic option retrieval} {option get .op1 z Color1} red test option-2.4 {basic option retrieval} {option get .op1 x Color2} green test option-2.5 {basic option retrieval} {option get .op1 y Color2} {} test option-2.6 {basic option retrieval} {option get .op1 z Color2} {} test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {} test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {} test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {} test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue test option-6.5 {basic option retrieval} {option get .op2 y Color2} {} test option-6.6 {basic option retrieval} {option get .op2 z Color2} {} test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple # Now try similar tests to above, except jump around non-hierarchically # between windows to make sure that the option stacks are pushed and # popped correctly. option get . foo Foo test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple test option-9.1 {stack pushing/popping} {option get . x Color1} blue test option-9.2 {stack pushing/popping} {option get . y Color1} red test option-9.3 {stack pushing/popping} {option get . z Color1} red test option-9.4 {stack pushing/popping} {option get . x Color2} blue test option-9.5 {stack pushing/popping} {option get . y Color2} {} test option-9.6 {stack pushing/popping} {option get . z Color2} {} test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {} test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {} test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {} test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {} # Test the major priority levels (widgetDefault, etc.) option add $appName.op1.a 100 100 option add $appName.op1.A interactive interactive option add $appName.op1.b userDefault userDefault option add $appName.op1.B startupFile startupFile option add $appName.op1.c widgetDefault widgetDefault option add $appName.op1.C 0 0 test option-13.1 {priority levels} {option get .op1 a A} 100 test option-13.2 {priority levels} {option get .op1 b A} interactive test option-13.3 {priority levels} {option get .op1 b B} userDefault test option-13.4 {priority levels} {option get .op1 c B} startupFile test option-13.5 {priority levels} {option get .op1 c C} widgetDefault option add $appName.op1.B file2 widget test option-13.6 {priority levels} {option get .op1 c B} startupFile option add $appName.op1.B file2 startupFile test option-13.7 {priority levels} {option get .op1 c B} file2 # Test various error conditions test option-14.1 {error conditions} { list [catch {option} msg] $msg } {1 {wrong # args: should be "option cmd arg ?arg ...?"}} test option-14.2 {error conditions} { list [catch {option x} msg] $msg } {1 {bad option "x": must be add, clear, get, or readfile}} test option-14.3 {error conditions} { list [catch {option foo 3} msg] $msg } {1 {bad option "foo": must be add, clear, get, or readfile}} test option-14.4 {error conditions} { list [catch {option add 3} msg] $msg } {1 {wrong # args: should be "option add pattern value ?priority?"}} test option-14.5 {error conditions} { list [catch {option add . a b c} msg] $msg } {1 {wrong # args: should be "option add pattern value ?priority?"}} test option-14.6 {error conditions} { list [catch {option add . a -1} msg] $msg } {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} test option-14.7 {error conditions} { list [catch {option add . a 101} msg] $msg } {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} test option-14.8 {error conditions} { list [catch {option add . a gorp} msg] $msg } {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} test option-14.9 {error conditions} { list [catch {option get 3} msg] $msg } {1 {wrong # args: should be "option get window name class"}} test option-14.10 {error conditions} { list [catch {option get 3 4} msg] $msg } {1 {wrong # args: should be "option get window name class"}} test option-14.11 {error conditions} { list [catch {option get 3 4 5 6} msg] $msg } {1 {wrong # args: should be "option get window name class"}} test option-14.12 {error conditions} { list [catch {option get .gorp.gorp a A} msg] $msg } {1 {bad window path name ".gorp.gorp"}} set option1 [file join [testsDirectory] option.file1] set option2 [file join [testsDirectory] option.file2] test option-15.1 {database files} { list [catch {option read non-existent} msg] $msg } {1 {couldn't open "non-existent": no such file or directory}} option read $option1 test option-15.2 {database files} {option get . x1 color} blue test option-15.3 {database files} appNameIsTktest {option get . x2 color} green test option-15.4 {database files} {option get . x3 color} purple test option-15.5 {database files} {option get . {x 4} color} brown test option-15.6 {database files} {option get . x6 color} {} test option-15.7 {database files} {option get . x9 color} " \t\\A\n" test option-15.8 {database files} { list [catch {option read $option1 widget foo} msg] $msg } {1 {wrong # args: should be "option readfile fileName ?priority?"}} option add *x3 burgundy catch {option read $option1 userDefault} test option-15.9 {database files} {option get . x3 color} burgundy test option-15.10 {database files} { list [catch {option read $option2} msg] $msg } {1 {missing colon on line 2}} test option-16.1 {ReadOptionFile} { set option3 [makeFile {} option.file3] set file [open $option3 w] fconfigure $file -translation crlf puts $file "*x7: true\n*x8: false" close $file option read $option3 userDefault set result [list [option get . x7 color] [option get . x8 color]] removeFile $option3 set result } {true false} catch {destroy .op1} catch {destroy .op2} # cleanup cleanupTests return tk8.5.19/tests/id.test0000644003604700454610000000457512612445655013236 0ustar dgp771div# This file is a Tcl script to test out the procedures in the file # tkId.c, which recycle X resource identifiers. It is organized in # the standard fashion for Tcl tests. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands test id-1.1 {WindowIdCleanup, delaying window release} {unix testwrapper} { bind all {lappend x %W} catch {unset map} frame .f set j 0 foreach i {a b c d e f g h i j k l m n o p q} { toplevel .f.$i -height 50 -width 100 wm geometry .f.$i +$j+$j incr j 10 update set map([winfo id .f.$i]) .f.$i set map([testwrapper .f.$i]) wrapper.f.$i } set x {} destroy .f # Destroy events should have occurred for all windows. set result [list [lsort $x]] set x {} update idletasks set reused {} foreach i {a b c d e} { set w .${i}2 frame $w -height 20 -width 100 -bd 2 -relief raised pack $w if [info exists map([winfo id $w])] { lappend reused $map([winfo id $w]) } set map([winfo id $w]) $w } # No window ids should have been reused: stale Destroy events still # pending in queue. lappend result [lsort $reused] # Wait a few seconds, then try again; ids should still not have # been re-used. set y 0 after 2000 {set y 1} tkwait variable y foreach i {a b c} { set w .${i}3 frame $w -height 20 -width 100 -bd 2 -relief raised pack $w if [info exists map([winfo id $w])] { lappend reused $map([winfo id $w]) } set map([winfo id $w])] $w } # Ids should not yet have been reused. lappend result [lsort $reused] # Wait a few more seconds, to give ids enough time to be recycled. set y 0 after 6000 {set y 1} tkwait variable y foreach i {a b c d e f} { set w .${i}4 frame $w -height 20 -width 100 -bd 2 -relief raised pack $w if [info exists map([winfo id $w])] { lappend reused $map([winfo id $w]) } set map([winfo id $w])] $w } # Ids should be reused now, due to time delay. Destroy events should # have been discarded. lappend result [lsort $reused] [lsort $x] } {{.f .f.a .f.b .f.c .f.d .f.e .f.f .f.g .f.h .f.i .f.j .f.k .f.l .f.m .f.n .f.o .f.p .f.q} {} {} {.f.o .f.p .f.q wrapper.f.p wrapper.f.q} {}} bind all {} # cleanup cleanupTests return tk8.5.19/tests/butGeom.tcl0000644003604700454610000001076112612445655014041 0ustar dgp771div# This file creates a visual test for button layout. It is part of # the Tk visual test suite, which is invoked via the "visual" script. catch {destroy .t} toplevel .t wm title .t "Visual Tests for Button Geometry" wm iconname .t "Button Geometry" wm geom .t +0+0 wm minsize .t 1 1 label .t.l -text {This screen exercises the layout mechanisms for various flavors of buttons. Select display options below, and they will be applied to all of the button widgets. In order to see the effects of different anchor positions, expand the window so that there is extra space in the buttons. The letter "o" in "automatically" should be underlined in the right column of widgets.} -wraplength 5i pack .t.l -side top -fill both button .t.quit -text Quit -command {destroy .t} pack .t.quit -side bottom -pady 2m set sepId 1 proc sep {} { global sepId frame .t.sep$sepId -height 2 -bd 1 -relief sunken pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x incr sepId } # Create buttons that control configuration options. frame .t.control pack .t.control -side top -fill x -pady 3m frame .t.control.left frame .t.control.right pack .t.control.left .t.control.right -side left -expand 1 -fill x label .t.anchorLabel -text "Anchor:" frame .t.control.left.f -width 6c -height 3c pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top foreach anchor {nw n ne w center e sw s se} { button .t.anchor-$anchor -text $anchor -command "config -anchor $anchor" } place .t.anchor-nw -in .t.control.left.f -relx 0 -relwidth 0.333 \ -rely 0 -relheight 0.333 place .t.anchor-n -in .t.control.left.f -relx 0.333 -relwidth 0.333 \ -rely 0 -relheight 0.333 place .t.anchor-ne -in .t.control.left.f -relx 0.666 -relwidth 0.333 \ -rely 0 -relheight 0.333 place .t.anchor-w -in .t.control.left.f -relx 0 -relwidth 0.333 \ -rely 0.333 -relheight 0.333 place .t.anchor-center -in .t.control.left.f -relx 0.333 -relwidth 0.333 \ -rely 0.333 -relheight 0.333 place .t.anchor-e -in .t.control.left.f -relx 0.666 -relwidth 0.333 \ -rely 0.333 -relheight 0.333 place .t.anchor-sw -in .t.control.left.f -relx 0 -relwidth 0.333 \ -rely 0.666 -relheight 0.333 place .t.anchor-s -in .t.control.left.f -relx 0.333 -relwidth 0.333 \ -rely 0.666 -relheight 0.333 place .t.anchor-se -in .t.control.left.f -relx 0.666 -relwidth 0.333 \ -rely 0.666 -relheight 0.333 set justify center radiobutton .t.justify-left -text "Justify Left" -relief flat \ -command "config -justify left" -variable justify \ -value left radiobutton .t.justify-center -text "Justify Center" -relief flat \ -command "config -justify center" -variable justify \ -value center radiobutton .t.justify-right -text "Justify Right" -relief flat \ -command "config -justify right" -variable justify \ -value right pack .t.justify-left .t.justify-center .t.justify-right \ -in .t.control.right -anchor w sep frame .t.f1 pack .t.f1 -side top -expand 1 -fill both sep frame .t.f2 pack .t.f2 -side top -expand 1 -fill both sep frame .t.f3 pack .t.f3 -side top -expand 1 -fill both sep frame .t.f4 pack .t.f4 -side top -expand 1 -fill both sep label .t.l1 -text Label -bd 2 -relief sunken label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50 pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \ -expand y -fill both button .t.b1 -text Button button .t.b2 -text "Explicit\nnewlines\n\nin the text" button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50 pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \ -expand y -fill both checkbutton .t.c1 -text Checkbutton -variable a checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50 pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \ -expand y -fill both radiobutton .t.r1 -text Radiobutton -value a radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50 pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \ -expand y -fill both proc config {option value} { foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3 .t.r1 .t.r2 .t.r3} { $w configure $option $value } } tk8.5.19/tests/winClipboard.test0000644003604700454610000000517412612445655015253 0ustar dgp771div# This file is a Tcl script to test out Tk's Windows specific # clipboard code. It is organized in the standard fashion for Tcl # tests. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # Note that these tests may fail if another application is grabbing the # clipboard (e.g. an X server) test winClipboard-1.1 {TkSelGetSelection} win { clipboard clear catch {selection get -selection CLIPBOARD} msg set msg } {CLIPBOARD selection doesn't exist or form "STRING" not defined} test winClipboard-1.2 {TkSelGetSelection} {win testclipboard} { clipboard clear clipboard append {} catch {selection get -selection CLIPBOARD} r1 catch {testclipboard} r2 list $r1 $r2 } {{} {}} test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { clipboard clear clipboard append abcd update catch {selection get -selection CLIPBOARD} r1 catch {testclipboard} r2 list $r1 $r2 } {abcd abcd} test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { clipboard clear clipboard append "line 1\nline 2" catch {selection get -selection CLIPBOARD} r1 catch {testclipboard} r2 list $r1 $r2 } [list "line 1\nline 2" "line 1\r\nline 2"] test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { clipboard clear clipboard append "line 1\u00c7\nline 2" catch {selection get -selection CLIPBOARD} r1 catch {testclipboard} r2 list $r1 $r2 } [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]] test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {win testclipboard} { clipboard clear clipboard append -type OUR_ACTION "action data" clipboard append "string data" update catch {selection get -selection CLIPBOARD -type OUR_ACTION} r1 catch {testclipboard} r2 list $r1 $r2 } [list "action data" "string data"] test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {win testclipboard} { clipboard clear clipboard append -type OUR_ACTION "new data" clipboard append "more data in string" update catch {testclipboard} r1 catch {selection get -selection CLIPBOARD -type OUR_ACTION} r2 list $r1 $r2 } [list "more data in string" "new data"] # cleanup cleanupTests return tk8.5.19/tests/cmds.test0000644003604700454610000000256612612445655013566 0ustar dgp771div# This file is a Tcl script to test the procedures in the file # tkCmds.c. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands update test cmds-1.1 {tkwait visibility, argument errors} { list [catch {tkwait visibility} msg] $msg } {1 {wrong # args: should be "tkwait variable|visibility|window name"}} test cmds-1.2 {tkwait visibility, argument errors} { list [catch {tkwait visibility foo bar} msg] $msg } {1 {wrong # args: should be "tkwait variable|visibility|window name"}} test cmds-1.3 {tkwait visibility, argument errors} { list [catch {tkwait visibility bad_window} msg] $msg } {1 {bad window path name "bad_window"}} test cmds-1.4 {tkwait visibility, waiting for window to be mapped} { button .b -text "Test" set x init after 100 {set x delay; place .b -x 0 -y 0} tkwait visibility .b destroy .b set x } {delay} test cmds-1.5 {tkwait visibility, window gets deleted} { frame .f button .f.b -text "Test" pack .f.b set x init after 100 {set x deleted; destroy .f} list [catch {tkwait visibility .f.b} msg] $msg $x } {1 {window ".f.b" was deleted before its visibility changed} deleted} # cleanup cleanupTests return tk8.5.19/tests/focus.test0000644003604700454610000004327612612445655013762 0ustar dgp771div# This file is a Tcl script to test out the "focus" command and the # other procedures in the file tkFocus.c. It is organized in the # standard fashion for Tcl tests. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands button .b -text .b -relief raised -bd 2 pack .b proc focusSetup {} { catch {destroy .t} toplevel .t wm geom .t +0+0 foreach i {b1 b2 b3 b4} { button .t.$i -text .t.$i -relief raised -bd 2 pack .t.$i } tkwait visibility .t.b4 } proc focusSetupAlt {} { global env catch {destroy .alt} toplevel .alt -screen $env(TK_ALT_DISPLAY) foreach i {a b c d} { button .alt.$i -text .alt.$i -relief raised -bd 2 pack .alt.$i } tkwait visibility .alt.d } # Make sure the window manager knows who has focus catch {fixfocus} # The following procedure ensures that there is no input focus # in this application. It does it by arranging for another # application to grab the focus. The "after" and "update" stuff # is needed to wait long enough for pending actions to get through # the X server and possibly also the window manager. setupbg proc focusClear {} { global x; after 200 {set x 1} tkwait variable x dobg {focus -force .; update} update } focusSetup if {[testConstraint altDisplay]} { focusSetupAlt } update bind all { append focusInfo "in %W %d\n" } bind all { append focusInfo "out %W %d\n" } bind all { append focusInfo "press %W %K" } test focus-1.1 {Tk_FocusCmd procedure} unix { focusClear focus } {} test focus-1.2 {Tk_FocusCmd procedure} {unix altDisplay} { focus .alt.b focus } {} test focus-1.3 {Tk_FocusCmd procedure} unix { focusClear focus .t.b3 focus } {} test focus-1.4 {Tk_FocusCmd procedure} unix { list [catch {focus ""} msg] $msg } {0 {}} test focus-1.5 {Tk_FocusCmd procedure} unix { focusClear focus -force .t focus .t.b3 focus } {.t.b3} test focus-1.6 {Tk_FocusCmd procedure} unix { list [catch {focus .gorp} msg] $msg } {1 {bad window path name ".gorp"}} test focus-1.7 {Tk_FocusCmd procedure} unix { list [catch {focus .gorp a} msg] $msg } {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}} test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} unix { toplevel .t2 wm geom .t2 +10+10 frame .t2.f -width 200 -height 100 -bd 2 -relief raised frame .t2.f2 -width 200 -height 100 -bd 2 -relief raised pack .t2.f .t2.f2 bind .t2.f {focus .t2.f} bind .t2.f2 {focus .t2} focus -force .t2.f2 tkwait visibility .t2.f2 update set x [focus] destroy .t2.f2 lappend x [focus] destroy .t2.f lappend x [focus] destroy .t2 set x } {.t2.f2 .t2 .t2} test focus-1.9 {Tk_FocusCmd procedure, -displayof option} unix { list [catch {focus -displayof} msg] $msg } {1 {wrong # args: should be "focus -displayof window"}} test focus-1.10 {Tk_FocusCmd procedure, -displayof option} unix { list [catch {focus -displayof a b} msg] $msg } {1 {wrong # args: should be "focus -displayof window"}} test focus-1.11 {Tk_FocusCmd procedure, -displayof option} unix { list [catch {focus -displayof .lousy} msg] $msg } {1 {bad window path name ".lousy"}} test focus-1.12 {Tk_FocusCmd procedure, -displayof option} unix { focusClear focus .t focus -displayof .t.b3 } {} test focus-1.13 {Tk_FocusCmd procedure, -displayof option} unix { focusClear focus -force .t focus -displayof .t.b3 } {.t} test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unix altDisplay} { focus -force .alt.c focus -displayof .alt } {.alt.c} test focus-1.15 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force} msg] $msg } {1 {wrong # args: should be "focus -force window"}} test focus-1.16 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force a b} msg] $msg } {1 {wrong # args: should be "focus -force window"}} test focus-1.17 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force foo} msg] $msg } {1 {bad window path name "foo"}} test focus-1.18 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force ""} msg] $msg } {0 {}} test focus-1.19 {Tk_FocusCmd procedure, -force option} unix { focusClear focus .t.b1 set x [list [focus]] focus -force .t.b1 lappend x [focus] } {{} .t.b1} test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} unix { list [catch {focus -lastfor} msg] $msg } {1 {wrong # args: should be "focus -lastfor window"}} test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} unix { list [catch {focus -lastfor 1 2} msg] $msg } {1 {wrong # args: should be "focus -lastfor window"}} test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} unix { list [catch {focus -lastfor who_knows?} msg] $msg } {1 {bad window path name "who_knows?"}} test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} unix { focus .b focus .t.b1 list [focus -lastfor .] [focus -lastfor .t.b3] } {.b .t.b1} test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} unix { destroy .t focusSetup update focus -lastfor .t.b2 } {.t} test focus-1.25 {Tk_FocusCmd procedure} unix { list [catch {focus -unknown} msg] $msg } {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}} test focus-2.1 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { focus -force .b destroy .t focusSetup update set focusInfo {} event gen [testwrapper .t] -detail NotifyAncestor \ -sendevent 0x54217567 list $focusInfo } {{}} test focus-2.2 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { focus -force .b destroy .t focusSetup update set focusInfo {} event gen .t -detail NotifyAncestor -sendevent 0x547321ac list $focusInfo [focus] } {{in .t NotifyAncestor } .b} test focus-2.3 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { focus -force .b destroy .t focusSetup update set focusInfo {} event gen [testwrapper .t] -detail NotifyAncestor update list $focusInfo [focus -lastfor .t] } {{out .b NotifyNonlinear out . NotifyNonlinearVirtual in .t NotifyNonlinear } .t} test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ {unix nonPortable testwrapper} { set result {} focus .t.b1 # Important to end with NotifyAncestor, which is an # event that is processed normally. This has a side # effect on text 2.5 foreach detail {NotifyAncestor NotifyNonlinear NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot NotifyVirtual NotifyAncestor} { focus -force . update event gen [testwrapper .t] -detail $detail set focusInfo {} update lappend result $focusInfo } set result } {{out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } {out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } {} {out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } {} {} {out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear }} test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \ {unix nonPortable testwrapper} { focusSetup focus .t.b1 update event gen [testwrapper .t] -detail NotifyAncestor list $focusInfo [focus] } {{out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } .t.b1} test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ {unix testwrapper} { focus .t.b1 focus . update event gen [testwrapper .t] -detail NotifyAncestor set focusInfo {} set x [focus] event gen . list $x $focusInfo } {.t.b1 {press .t.b1 x}} test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \ {unix testwrapper} { set result {} foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot NotifyVirtual} { focus -force .t.b1 event gen [testwrapper .t] -detail $detail update lappend result [focus] } set result } {{} .t.b1 {} {} .t.b1 .t.b1 {}} test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \ {unix testwrapper} { focus -force .t.b1 event gen .t.b1 -detail NotifyAncestor focus } {.t.b1} test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \ {unix testwrapper} { focus .t.b1 event gen [testwrapper .] -detail NotifyAncestor focus } {} test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \ {unix testwrapper} { set result {} focus .t.b1 focusClear foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyVirtual} { event gen [testwrapper .t] -detail $detail -focus 1 update lappend result [focus] event gen [testwrapper .t] -detail NotifyAncestor update } set result } {.t.b1 {} .t.b1 .t.b1 .t.b1} test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \ {unix testwrapper} { focusClear set focusInfo {} event gen [testwrapper .t] -detail NotifyAncestor update set focusInfo } {} test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \ {unix testwrapper} { focus -force .b update set focusInfo {} event gen [testwrapper .t] -detail NotifyAncestor -focus 1 update set focusInfo } {} test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \ {unix testwrapper} { focus .t.b1 focusClear event gen [testwrapper .t] -detail NotifyAncestor -focus 1 set focusInfo {} update set focusInfo } {in .t NotifyVirtual in .t.b1 NotifyAncestor } test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unix testwrapper} { focusClear catch {destroy .t2} toplevel .t2 wm withdraw .t2 update set focusInfo {} event gen [testwrapper .t2] -detail NotifyAncestor -focus 1 update destroy .t2 } {} test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \ {unix testwrapper} { set result {} focus .t.b1 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyVirtual} { focusClear event gen [testwrapper .t] -detail NotifyAncestor -focus 1 update event gen [testwrapper .t] -detail $detail update lappend result [focus] } set result } {{} .t.b1 {} {} {}} test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \ {unix testwrapper} { set result {} focus .t.b1 event gen [testwrapper .t] -detail NotifyAncestor -focus 1 update set focusInfo {} event gen [testwrapper .t] -detail NotifyAncestor update set focusInfo } {out .t.b1 NotifyAncestor out .t NotifyVirtual } test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ {unix testwrapper} { set result {} focus .t.b1 event gen [testwrapper .t] -detail NotifyAncestor -focus 1 update set focusInfo {} event gen .t.b1 -detail NotifyAncestor event gen [testwrapper .] -detail NotifyAncestor update list $focusInfo [focus] } {{out .t.b1 NotifyAncestor out .t NotifyVirtual } {}} test focus-3.1 {SetFocus procedure, create record on focus} \ {unix testwrapper} { toplevel .t2 -width 250 -height 100 wm geometry .t2 +0+0 update focus -force .t2 update focus } {.t2} catch {destroy .t2} # This test produces no result, but it will generate a protocol # error if Tk forgets to make the window exist before focussing # on it. test focus-3.2 {SetFocus procedure, making window exist} {unix testwrapper} { update button .b2 -text "Another button" focus .b2 update } {} catch {destroy .b2} update # The following test doesn't produce a check-able result, but if # there are bugs it may generate an X protocol error. test focus-3.3 {SetFocus procedure, delaying claim of X focus} \ {unix testwrapper} { focusSetup focus -force .t.b2 update } {} test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ {unix testwrapper} { focusSetup wm withdraw .t focus -force .t.b2 toplevel .t2 -width 250 -height 100 wm geometry .t2 +10+10 focus -force .t2 wm withdraw .t2 update wm deiconify .t2 wm deiconify .t } {} catch {destroy .t2} test focus-3.5 {SetFocus procedure, generating events} {unix testwrapper} { focusSetup focusClear set focusInfo {} focus -force .t.b2 update set focusInfo } {in .t NotifyVirtual in .t.b2 NotifyAncestor } test focus-3.6 {SetFocus procedure, generating events} {unix testwrapper} { focusSetup focus -force .b update set focusInfo {} focus .t.b2 update set focusInfo } {out .b NotifyNonlinear out . NotifyNonlinearVirtual in .t NotifyNonlinearVirtual in .t.b2 NotifyNonlinear } test focus-3.7 {SetFocus procedure, generating events} \ {unix nonPortable testwrapper} { # Non-portable because some platforms generate extra events. focusSetup focusClear set focusInfo {} focus .t.b2 update set focusInfo } {} test focus-4.1 {TkFocusDeadWindow procedure} {unix testwrapper} { focusSetup update focus -force .b update destroy .t focus } {.b} test focus-4.2 {TkFocusDeadWindow procedure} {unix testwrapper} { focusSetup update focus -force .t.b2 focus .b update destroy .t.b2 update focus } {.b} # Non-portable due to wm-specific redirection of input focus when # windows are deleted: test focus-4.3 {TkFocusDeadWindow procedure} {unix nonPortable testwrapper} { focusSetup update focus .t update destroy .t update focus } {} test focus-4.4 {TkFocusDeadWindow procedure} {unix testwrapper} { focusSetup focus -force .t.b2 update destroy .t.b2 focus } {.t} # I don't know how to test most of the remaining procedures of this file # explicitly; they've already been exercised by the preceding tests. setupbg test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ {unix testwrapper secureserver} { focusSetup focus -force .t update set result [focus] send [dobg {tk appname}] {focus -force .; update} lappend result [focus] focus .t.b2 update lappend result [focus] } {.t {} {}} catch {destroy .t} bind all {} bind all {} bind all {} cleanupbg fixfocus test focus-6.1 {miscellaneous - embedded application in same process} \ {unix testwrapper} { eval interp delete [interp slaves] catch {destroy .t} toplevel .t wm geometry .t +0+0 frame .t.f1 -container 1 frame .t.f2 pack .t.f1 .t.f2 entry .t.f2.e1 -bg red pack .t.f2.e1 bind all {lappend x "focus in %W %d"} bind all {lappend x "focus out %W %d"} interp create child child eval "set argv {-use [winfo id .t.f1]}" load {} Tk child child eval { entry .e1 -bg lightBlue pack .e1 bind all {lappend x "focus in %W %d"} bind all {lappend x "focus out %W %d"} set x {} } # Claim the focus and wait long enough for it to really arrive. focus -force .t.f2.e1 after 300 {set timer 1} vwait timer set x {} lappend x [focus] [child eval focus] # See if a "focus" command will move the focus to the embedded # application. child eval {focus .e1} after 300 {set timer 1} vwait timer lappend x | child eval {lappend x |} # Bring the focus back to the main application. focus .t.f2.e1 after 300 {set timer 1} vwait timer set result [list $x [child eval {set x}]] interp delete child set result } {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} test focus-6.2 {miscellaneous - embedded application in different process} \ {unix testwrapper} { eval interp delete [interp slaves] catch {destroy .t} setupbg toplevel .t wm geometry .t +0+0 frame .t.f1 -container 1 frame .t.f2 pack .t.f1 .t.f2 entry .t.f2.e1 -bg red pack .t.f2.e1 bind all {lappend x "focus in %W %d"} bind all {lappend x "focus out %W %d"} setupbg -use [winfo id .t.f1] dobg { entry .e1 -bg lightBlue pack .e1 bind all {lappend x "focus in %W %d"} bind all {lappend x "focus out %W %d"} set x {} } # Claim the focus and wait long enough for it to really arrive. focus -force .t.f2.e1 after 300 {set timer 1} vwait timer set x {} lappend x [focus] [dobg focus] # See if a "focus" command will move the focus to the embedded # application. dobg {focus .e1} after 300 {set timer 1} vwait timer lappend x | dobg {lappend x |} # Bring the focus back to the main application. focus .t.f2.e1 after 300 {set timer 1} vwait timer set result [list $x [dobg {set x}]] cleanupbg set result } {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} deleteWindows bind all {} bind all {} # cleanup cleanupTests return tk8.5.19/tests/oldpack.test0000644003604700454610000004642012612445655014252 0ustar dgp771div# This file is a Tcl script to test out the old syntax of Tk's # "pack" command (before release 3.3). It is organized in the # standard fashion for Tcl tests. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # First, test a single window packed in various ways in a parent catch {destroy .pack} frame .pack place .pack -width 100 -height 100 frame .pack.red -width 10 -height 20 label .pack.red.l -text R -bd 2 -relief raised place .pack.red.l -relwidth 1.0 -relheight 1.0 frame .pack.green -width 30 -height 40 label .pack.green.l -text G -bd 2 -relief raised place .pack.green.l -relwidth 1.0 -relheight 1.0 frame .pack.blue -width 40 -height 40 label .pack.blue.l -text B -bd 2 -relief raised place .pack.blue.l -relwidth 1.0 -relheight 1.0 frame .pack.violet -width 80 -height 20 label .pack.violet.l -text P -bd 2 -relief raised place .pack.violet.l -relwidth 1.0 -relheight 1.0 test oldpack-1.1 {basic positioning} { pack ap .pack .pack.red top update winfo geometry .pack.red } 10x20+45+0 test oldpack-1.2 {basic positioning} { pack append .pack .pack.red bottom update winfo geometry .pack.red } 10x20+45+80 test oldpack-1.3 {basic positioning} { pack append .pack .pack.red left update winfo geometry .pack.red } 10x20+0+40 test oldpack-1.4 {basic positioning} { pack append .pack .pack.red right update winfo geometry .pack.red } 10x20+90+40 # Try adding padding around the window and make sure that the # window gets a larger frame. test oldpack-2.1 {padding} { pack append .pack .pack.red {t padx 20} update winfo geometry .pack.red } 10x20+45+0 test oldpack-2.2 {padding} { pack append .pack .pack.red {top pady 20} update winfo geometry .pack.red } 10x20+45+10 test oldpack-2.3 {padding} { pack append .pack .pack.red {l padx 20} update winfo geometry .pack.red } 10x20+10+40 test oldpack-2.4 {padding} { pack append .pack .pack.red {left pady 20} update winfo geometry .pack.red } 10x20+0+40 # Position the window at different positions in its frame to # make sure they all work. Try two differenet frame locations, # to make sure that frame offsets are being added in correctly. test oldpack-3.1 {framing} { pack append .pack .pack.red {b padx 20 pady 30} update winfo geometry .pack.red } 10x20+45+65 test oldpack-3.2 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 fr n} update winfo geometry .pack.red } 10x20+45+50 test oldpack-3.3 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame ne} update winfo geometry .pack.red } 10x20+90+50 test oldpack-3.4 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame e} update winfo geometry .pack.red } 10x20+90+65 test oldpack-3.5 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame se} update winfo geometry .pack.red } 10x20+90+80 test oldpack-3.6 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame s} update winfo geometry .pack.red } 10x20+45+80 test oldpack-3.7 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame sw} update winfo geometry .pack.red } 10x20+0+80 test oldpack-3.8 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame w} update winfo geometry .pack.red } 10x20+0+65 test oldpack-3.9 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame nw} update winfo geometry .pack.red } 10x20+0+50 test oldpack-3.10 {framing} { pack append .pack .pack.red {bottom padx 20 pady 30 frame c} update winfo geometry .pack.red } 10x20+45+65 test oldpack-3.11 {framing} { pack append .pack .pack.red {r padx 20 pady 30} update winfo geometry .pack.red } 10x20+80+40 test oldpack-3.12 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame n} update winfo geometry .pack.red } 10x20+80+0 test oldpack-3.13 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame ne} update winfo geometry .pack.red } 10x20+90+0 test oldpack-3.14 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame e} update winfo geometry .pack.red } 10x20+90+40 test oldpack-3.15 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame se} update winfo geometry .pack.red } 10x20+90+80 test oldpack-3.16 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame s} update winfo geometry .pack.red } 10x20+80+80 test oldpack-3.17 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame sw} update winfo geometry .pack.red } 10x20+70+80 test oldpack-3.18 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame w} update winfo geometry .pack.red } 10x20+70+40 test oldpack-3.19 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame nw} update winfo geometry .pack.red } 10x20+70+0 test oldpack-3.20 {framing} { pack append .pack .pack.red {right padx 20 pady 30 frame center} update winfo geometry .pack.red } 10x20+80+40 # Try out various filling combinations in a couple of different # frame locations. test oldpack-4.1 {filling} { pack append .pack .pack.red {bottom padx 20 pady 30 fillx} update winfo geometry .pack.red } 100x20+0+65 test oldpack-4.2 {filling} { pack append .pack .pack.red {bottom padx 20 pady 30 filly} update winfo geometry .pack.red } 10x50+45+50 test oldpack-4.3 {filling} { pack append .pack .pack.red {bottom padx 20 pady 30 fill} update winfo geometry .pack.red } 100x50+0+50 test oldpack-4.4 {filling} { pack append .pack .pack.red {right padx 20 pady 30 fillx} update winfo geometry .pack.red } 30x20+70+40 test oldpack-4.5 {filling} { pack append .pack .pack.red {right padx 20 pady 30 filly} update winfo geometry .pack.red } 10x100+80+0 test oldpack-4.6 {filling} { pack append .pack .pack.red {right padx 20 pady 30 fill} update winfo geometry .pack.red } 30x100+70+0 # Multiple windows: make sure that space is properly subtracted # from the cavity as windows are positioned inwards from all # different sides. Also make sure that windows get unmapped if # there isn't enough space for them. pack append .pack .pack.red top .pack.green top .pack.blue top \ .pack.violet top update test oldpack-5.1 {multiple windows} {winfo geometry .pack.red} 10x20+45+0 test oldpack-5.2 {multiple windows} {winfo geometry .pack.green} 30x40+35+20 test oldpack-5.3 {multiple windows} {winfo geometry .pack.blue} 40x40+30+60 test oldpack-5.4 {multiple windows} {winfo ismapped .pack.violet} 0 pack b .pack.blue .pack.violet top update test oldpack-5.5 {multiple windows} {winfo ismapped .pack.violet} 1 test oldpack-5.6 {multiple windows} {winfo geometry .pack.violet} 80x20+10+60 test oldpack-5.7 {multiple windows} {winfo geometry .pack.blue} 40x20+30+80 pack after .pack.blue .pack.red top update test oldpack-5.8 {multiple windows} {winfo geometry .pack.green} 30x40+35+0 test oldpack-5.9 {multiple windows} {winfo geometry .pack.violet} 80x20+10+40 test oldpack-5.10 {multiple windows} {winfo geometry .pack.blue} 40x40+30+60 test oldpack-5.11 {multiple windows} {winfo ismapped .pack.red} 0 pack before .pack.green .pack.red right .pack.blue left update test oldpack-5.12 {multiple windows} {winfo ismapped .pack.red} 1 test oldpack-5.13 {multiple windows} {winfo geometry .pack.red} 10x20+90+40 test oldpack-5.14 {multiple windows} {winfo geometry .pack.blue} 40x40+0+30 test oldpack-5.15 {multiple windows} {winfo geometry .pack.green} 30x40+50+0 test oldpack-5.16 {multiple windows} {winfo geometry .pack.violet} 50x20+40+40 pack append .pack .pack.violet left .pack.green bottom .pack.red bottom \ .pack.blue bottom update test oldpack-5.17 {multiple windows} {winfo geometry .pack.violet} 80x20+0+40 test oldpack-5.18 {multiple windows} {winfo geometry .pack.green} 20x40+80+60 test oldpack-5.19 {multiple windows} {winfo geometry .pack.red} 10x20+85+40 test oldpack-5.20 {multiple windows} {winfo geometry .pack.blue} 20x40+80+0 pack after .pack.blue .pack.blue top .pack.red right .pack.green right \ .pack.violet right update test oldpack-5.21 {multiple windows} {winfo geometry .pack.blue} 40x40+30+0 test oldpack-5.22 {multiple windows} {winfo geometry .pack.red} 10x20+90+60 test oldpack-5.23 {multiple windows} {winfo geometry .pack.green} 30x40+60+50 test oldpack-5.24 {multiple windows} {winfo geometry .pack.violet} 60x20+0+60 pack after .pack.blue .pack.red left .pack.green left .pack.violet left update test oldpack-5.25 {multiple windows} {winfo geometry .pack.blue} 40x40+30+0 test oldpack-5.26 {multiple windows} {winfo geometry .pack.red} 10x20+0+60 test oldpack-5.27 {multiple windows} {winfo geometry .pack.green} 30x40+10+50 test oldpack-5.28 {multiple windows} {winfo geometry .pack.violet} 60x20+40+60 pack append .pack .pack.violet left .pack.green left .pack.blue left \ .pack.red left update test oldpack-5.29 {multiple windows} {winfo geometry .pack.violet} 80x20+0+40 test oldpack-5.30 {multiple windows} {winfo geometry .pack.green} 20x40+80+30 test oldpack-5.31 {multiple windows} {winfo ismapped .pack.blue} 0 test oldpack-5.32 {multiple windows} {winfo ismapped .pack.red} 0 # Test the ability of the packer to propagate geometry information # to its parent. Make sure it computes the parent's needs both in # the direction of packing (width for "left" and "right" windows, # for example), and perpendicular to the pack direction (height for # "left" and "right" windows). pack append .pack .pack.red top .pack.green top .pack.blue top \ .pack.violet top update test oldpack-6.1 {geometry propagation} {winfo reqwidth .pack} 80 test oldpack-6.2 {geometry propagation} {winfo reqheight .pack} 120 destroy .pack.violet update test oldpack-6.3 {geometry propagation} {winfo reqwidth .pack} 40 test oldpack-6.4 {geometry propagation} {winfo reqheight .pack} 100 frame .pack.violet -width 80 -height 20 -bg violet label .pack.violet.l -text P -bd 2 -relief raised place .pack.violet.l -relwidth 1.0 -relheight 1.0 pack append .pack .pack.red left .pack.green right .pack.blue bottom \ .pack.violet top update test oldpack-6.5 {geometry propagation} {winfo reqwidth .pack} 120 test oldpack-6.6 {geometry propagation} {winfo reqheight .pack} 60 pack append .pack .pack.violet top .pack.green top .pack.blue left \ .pack.red left update test oldpack-6.7 {geometry propagation} {winfo reqwidth .pack} 80 test oldpack-6.8 {geometry propagation} {winfo reqheight .pack} 100 # Test the "expand" option, and make sure space is evenly divided # when several windows request expansion. pack append .pack .pack.violet top .pack.green {left e} \ .pack.blue {left expand} .pack.red {left expand} update test oldpack-7.1 {multiple expanded windows} { pack append .pack .pack.violet top .pack.green {left e} \ .pack.blue {left expand} .pack.red {left expand} update list [winfo geometry .pack.green] [winfo geometry .pack.blue] \ [winfo geometry .pack.red] } {30x40+3+40 40x40+39+40 10x20+86+50} test oldpack-7.2 {multiple expanded windows} { pack append .pack .pack.green left .pack.violet {bottom expand} \ .pack.blue {bottom expand} .pack.red {bottom expand} update list [winfo geometry .pack.violet] [winfo geometry .pack.blue] \ [winfo geometry .pack.red] } {70x20+30+77 40x40+45+30 10x20+60+3} test oldpack-7.3 {multiple expanded windows} { foreach i [winfo child .pack] { pack unpack $i } pack append .pack .pack.green {left e fill} .pack.red {left expand fill} \ .pack.blue {top fill} update list [winfo geometry .pack.green] [winfo geometry .pack.red] \ [winfo geometry .pack.blue] } {40x100+0+0 20x100+40+0 40x40+60+0} test oldpack-7.4 {multiple expanded windows} { foreach i [winfo child .pack] { pack unpack $i } pack append .pack .pack.red {top expand} .pack.violet {top expand} \ .pack.blue {right fill} update list [winfo geometry .pack.red] [winfo geometry .pack.violet] \ [winfo geometry .pack.blue] } {10x20+45+5 80x20+10+35 40x40+60+60} test oldpack-7.5 {multiple expanded windows} { foreach i [winfo child .pack] { pack unpack $i } pack append .pack .pack.green {right frame s} .pack.red {top expand} update list [winfo geometry .pack.green] [winfo geometry .pack.red] } {30x40+70+60 10x20+30+40} test oldpack-7.6 {multiple expanded windows} { foreach i [winfo child .pack] { pack unpack $i } pack append .pack .pack.violet {bottom frame e} .pack.red {right expand} update list [winfo geometry .pack.violet] [winfo geometry .pack.red] } {80x20+20+80 10x20+45+30} # Need more bizarre tests with combinations of expanded windows and # windows in opposing directions! Also, include padding in expanded # (and unexpanded) windows. # Syntax errors on pack commands test oldpack-8.1 {syntax errors} { set msg "" set result [catch {pack} msg] concat $result $msg } {1 wrong # args: should be "pack option arg ?arg ...?"} test oldpack-8.2 {syntax errors} { set msg "" set result [catch {pack append} msg] concat $result $msg } {1 wrong # args: should be "pack option arg ?arg ...?"} test oldpack-8.3 {syntax errors} { set msg "" set result [catch {pack gorp foo} msg] concat $result $msg } {1 bad option "gorp": must be configure, forget, info, propagate, or slaves} test oldpack-8.4 {syntax errors} { set msg "" set result [catch {pack a .pack} msg] concat $result $msg } {1 bad option "a": must be configure, forget, info, propagate, or slaves} test oldpack-8.5 {syntax errors} { set msg "" set result [catch {pack after foobar} msg] concat $result $msg } {1 bad window path name "foobar"} test oldpack-8.6 {syntax errors} { frame .pack.yellow -bg yellow set msg "" set result [catch {pack after .pack.yellow} msg] destroy .pack.yellow concat $result $msg } {1 window ".pack.yellow" isn't packed} test oldpack-8.7 {syntax errors} { set msg "" set result [catch {pack append foobar} msg] concat $result $msg } {1 bad window path name "foobar"} test oldpack-8.8 {syntax errors} { set msg "" set result [catch {pack before foobar} msg] concat $result $msg } {1 bad window path name "foobar"} test oldpack-8.9 {syntax errors} { frame .pack.yellow -bg yellow set msg "" set result [catch {pack before .pack.yellow} msg] destroy .pack.yellow concat $result $msg } {1 window ".pack.yellow" isn't packed} test oldpack-8.10 {syntax errors} { set msg "" set result [catch {pack info .pack help} msg] concat $result $msg } {1 wrong # args: should be "pack info window"} test oldpack-8.11 {syntax errors} { set msg "" set result [catch {pack info foobar} msg] concat $result $msg } {1 bad window path name "foobar"} test oldpack-8.12 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue} msg] concat $result $msg } {1 wrong # args: window ".pack.blue" should be followed by options} test oldpack-8.13 {syntax errors} { set msg "" set result [catch {pack append . .pack.blue top} msg] concat $result $msg } {1 can't pack .pack.blue inside .} test oldpack-8.14 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue f} msg] concat $result $msg } {1 bad option "f": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame} test oldpack-8.15 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue pad} msg] concat $result $msg } {1 bad option "pad": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame} test oldpack-8.16 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue {frame south}} msg] concat $result $msg } {1 bad anchor "south": must be n, ne, e, se, s, sw, w, nw, or center} test oldpack-8.17 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue {padx -2}} msg] concat $result $msg } {1 bad pad value "-2": must be positive screen distance} test oldpack-8.18 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue {padx}} msg] concat $result $msg } {1 wrong # args: "padx" option must be followed by screen distance} test oldpack-8.19 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue {pady -2}} msg] concat $result $msg } {1 bad pad value "-2": must be positive screen distance} test oldpack-8.20 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue {pady}} msg] concat $result $msg } {1 wrong # args: "pady" option must be followed by screen distance} test oldpack-8.21 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue "\{abc"} msg] concat $result $msg } {1 unmatched open brace in list} test oldpack-8.22 {syntax errors} { set msg "" set result [catch {pack append .pack .pack.blue frame} msg] concat $result $msg } {1 wrong # args: "frame" option must be followed by anchor point} # Test "pack info" command output. test oldpack-9.1 {information output} { pack append .pack .pack.blue {top fillx frame n} \ .pack.red {bottom filly frame s} .pack.green {left fill frame w} \ .pack.violet {right expand frame e} list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \ [pack info .pack.green] [pack info .pack.violet] } {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor n -expand 0 -fill x -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor s -expand 0 -fill y -ipadx 0 -ipady 0 -padx 0 -pady 0 -side bottom} {-in .pack -anchor w -expand 0 -fill both -ipadx 0 -ipady 0 -padx 0 -pady 0 -side left} {-in .pack -anchor e -expand 1 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side right}} test oldpack-9.2 {information output} { pack append .pack .pack.blue {padx 10 frame nw} \ .pack.red {pady 20 frame ne} .pack.green {frame se} \ .pack.violet {frame sw} list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \ [pack info .pack.green] [pack info .pack.violet] } {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor nw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 5 -pady 0 -side top} {-in .pack -anchor ne -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 10 -side top} {-in .pack -anchor se -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor sw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}} test oldpack-9.3 {information output} { pack append .pack .pack.blue {frame center} .pack.red {frame center} \ .pack.green {frame c} .pack.violet {frame c} list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \ [pack info .pack.green] [pack info .pack.violet] } {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}} catch {destroy .pack} # cleanup cleanupTests return tk8.5.19/tests/cursor.test0000644003604700454610000002161412612445655014150 0ustar dgp771div# This file is a Tcl script to test out the procedures in the file # tkCursor.c. It is organized in the standard white-box fashion for # Tcl tests. # # Copyright (c) 1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {testcursor} { set x watch lindex $x 0 destroy .b1 button .b1 -cursor $x lindex $x 0 testcursor watch } {{1 0}} test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {testcursor} { set x watch destroy .b1 .b2 button .b1 -cursor $x destroy .b1 set result {} lappend result [testcursor watch] button .b2 -cursor $x lappend result [testcursor watch] } {{} {{1 1}}} test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {testcursor} { set x watch destroy .b1 .b2 button .b1 -cursor $x set result {} lappend result [testcursor watch] button .b2 -cursor $x pack .b1 .b2 -side top lappend result [testcursor watch] } {{{1 1}} {{2 1}}} test cursor-2.1 {Tk_GetCursor procedure} { destroy .b1 list [catch {button .b1 -cursor bad_name} msg] $msg } {1 {bad cursor spec "bad_name"}} test cursor-2.2 {Tk_GetCursor procedure} { destroy .b1 list [catch {button .b1 -cursor @xyzzy} msg] $msg } {1 {bad cursor spec "@xyzzy"}} # Next two tests need a helper file with a very specific name and # controlled format. set wincur(data_octal) { 000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001 000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000 000 000 001 000 001 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 377 377 377 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 160 016 000 000 170 036 000 000 174 076 000 000 076 174 000 000 037 370 000 000 017 360 000 000 007 340 000 000 007 340 000 000 017 360 000 000 037 370 000 000 076 174 000 000 174 076 000 000 170 036 000 000 160 016 000 000 000 000 000 000 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 017 360 377 377 007 340 377 377 003 300 377 377 001 200 377 377 200 001 377 377 300 003 377 377 340 007 377 377 360 017 377 377 360 017 377 377 340 007 377 377 300 003 377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340 377 377 017 360 377 377 } set wincur(data_binary) {} foreach wincur(num) $wincur(data_octal) { append wincur(data_binary) [binary format c [scan $wincur(num) %o]] } set wincur(dir) [makeDirectory {dir with spaces}] set wincur(file) [makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} win { destroy .b1 button .b1 -cursor [list @$wincur(file)] } {.b1} test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} win { destroy .b1 button .b1 -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}] } {.b1} removeDirectory $wincur(dir) unset wincur test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} { set x heart destroy .b1 .b2 .b3 button .b1 -cursor $x button .b3 -cursor $x button .b2 -cursor $x set result {} lappend result [testcursor heart] destroy .b1 lappend result [testcursor heart] destroy .b2 lappend result [testcursor heart] destroy .b3 lappend result [testcursor heart] } {{{3 1}} {{2 1}} {{1 1}} {}} test cursor-4.1 {FreeCursorObjProc} {testcursor} { destroy .b set x [format heart] button .b -cursor $x set y [format heart] .b configure -cursor $y set z [format heart] .b configure -cursor $z set result {} lappend result [testcursor heart] set x red lappend result [testcursor heart] set z 32 lappend result [testcursor heart] destroy .b lappend result [testcursor heart] set y bogus set result } {{{1 3}} {{1 2}} {{1 1}} {}} # ------------------------------------------------------------------------- test cursor-5.1 {assert consistent cursor configuration command} -setup { button .b } -body { .b configure -cursor {watch red black} } -cleanup { destroy .b } -result {} # ------------------------------------------------------------------------- # Check for the standard set of cursors. foreach {testName cursor} { cursor-6.1 X_cursor cursor-6.2 arrow cursor-6.3 based_arrow_down cursor-6.4 based_arrow_up cursor-6.5 boat cursor-6.6 bogosity cursor-6.7 bottom_left_corner cursor-6.8 bottom_right_corner cursor-6.9 bottom_side cursor-6.10 bottom_tee cursor-6.11 box_spiral cursor-6.12 center_ptr cursor-6.13 circle cursor-6.14 clock cursor-6.15 coffee_mug cursor-6.16 cross cursor-6.17 cross_reverse cursor-6.18 crosshair cursor-6.19 diamond_cross cursor-6.20 dot cursor-6.21 dotbox cursor-6.22 double_arrow cursor-6.23 draft_large cursor-6.24 draft_small cursor-6.25 draped_box cursor-6.26 exchange cursor-6.27 fleur cursor-6.28 gobbler cursor-6.29 gumby cursor-6.30 hand1 cursor-6.31 hand2 cursor-6.32 heart cursor-6.33 icon cursor-6.34 iron_cross cursor-6.35 left_ptr cursor-6.36 left_side cursor-6.37 left_tee cursor-6.38 leftbutton cursor-6.39 ll_angle cursor-6.40 lr_angle cursor-6.41 man cursor-6.42 middlebutton cursor-6.43 mouse cursor-6.44 pencil cursor-6.45 pirate cursor-6.46 plus cursor-6.47 question_arrow cursor-6.48 right_ptr cursor-6.49 right_side cursor-6.50 right_tee cursor-6.51 rightbutton cursor-6.52 rtl_logo cursor-6.53 sailboat cursor-6.54 sb_down_arrow cursor-6.55 sb_h_double_arrow cursor-6.56 sb_left_arrow cursor-6.57 sb_right_arrow cursor-6.58 sb_up_arrow cursor-6.59 sb_v_double_arrow cursor-6.60 shuttle cursor-6.61 sizing cursor-6.62 spider cursor-6.63 spraycan cursor-6.64 star cursor-6.65 target cursor-6.66 tcross cursor-6.67 top_left_arrow cursor-6.68 top_left_corner cursor-6.69 top_right_corner cursor-6.70 top_side cursor-6.71 top_tee cursor-6.72 trek cursor-6.73 ul_angle cursor-6.74 umbrella cursor-6.75 ur_angle cursor-6.76 watch cursor-6.77 xterm } { test $testName "check cursor-font cursor $cursor" -setup { button .b -text $cursor } -body { .b configure -cursor $cursor } -cleanup { destroy .b } -result {} } # Test cursor named "none", it is not defined in # the X cursor table. It is defined in a Tk specific # table of named cursors and should be available on # all platforms. test cursor-6.80 {} -setup { button .b -text CButton } -body { .b configure -cursor none .b cget -cursor } -cleanup { destroy .b } -result none test cursor-6.81 {} -setup { button .b -text CButton } -body { .b configure -cursor none .b configure -cursor {} .b cget -cursor } -cleanup { destroy .b } -result {} test cursor-6.82 {} -setup { button .b -text CButton } -body { .b configure -cursor none .b configure -cursor {} .b configure -cursor none .b cget -cursor } -cleanup { destroy .b } -result none test cursor-6.83 {} -setup { button .b -text CButton } -body { # Setting fg and bg does nothing for the none cursor # because it displays no fg or bg pixels. set results [list] .b configure -cursor none lappend results [.b cget -cursor] .b configure -cursor {none blue} lappend results [.b cget -cursor] .b configure -cursor {none blue green} lappend results [.b cget -cursor] .b configure -cursor {} lappend results [.b cget -cursor] set results } -cleanup { destroy .b unset results } -result {none {none blue} {none blue green} {}} # ------------------------------------------------------------------------- # Check the Windows specific cursors foreach {testName cursor} { cursor-7.1 no cursor-7.2 starting cursor-7.3 size cursor-7.4 size_ne_sw cursor-7.5 size_ns cursor-7.6 size_nw_se cursor-7.7 size_we cursor-7.8 uparrow cursor-7.9 wait } { test $testName "check Windows cursor $cursor" -constraints win -setup { button .b -text $cursor } -body { .b configure -cursor $cursor } -cleanup { destroy .b } -result {} } # ------------------------------------------------------------------------- destroy .t # cleanup cleanupTests return tk8.5.19/tests/winfo.test0000644003604700454610000003031512612445655013753 0ustar dgp771div# This file is a Tcl script to test out the "winfo" command. It is # organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # eatColors -- # Creates a toplevel window and allocates enough colors in it to # use up all the slots in the colormap. # # Arguments: # w - Name of toplevel window to create. # options - Options for w, such as "-colormap new". proc eatColors {w {options ""}} { catch {destroy $w} eval toplevel $w $options wm geom $w +0+0 canvas $w.c -width 400 -height 200 -bd 0 pack $w.c for {set y 0} {$y < 8} {incr y} { for {set x 0} {$x < 40} {incr x} { set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] $w.c create rectangle [expr 10*$x] [expr 20*$y] \ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ -fill $color } } update } # XXX - This test file is woefully incomplete. At present, only a # few of the winfo options are tested. test winfo-1.1 {"winfo atom" command} { list [catch {winfo atom} msg] $msg } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} test winfo-1.2 {"winfo atom" command} { list [catch {winfo atom a b} msg] $msg } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} test winfo-1.3 {"winfo atom" command} { list [catch {winfo atom a b c d} msg] $msg } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} test winfo-1.4 {"winfo atom" command} { list [catch {winfo atom -displayof geek foo} msg] $msg } {1 {bad window path name "geek"}} test winfo-1.5 {"winfo atom" command} { winfo atom PRIMARY } 1 test winfo-1.6 {"winfo atom" command} { winfo atom -displayof . PRIMARY } 1 test winfo-2.1 {"winfo atomname" command} { list [catch {winfo atomname} msg] $msg } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}} test winfo-2.2 {"winfo atomname" command} { list [catch {winfo atomname a b} msg] $msg } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}} test winfo-2.3 {"winfo atomname" command} { list [catch {winfo atomname a b c d} msg] $msg } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}} test winfo-2.4 {"winfo atomname" command} { list [catch {winfo atomname -displayof geek foo} msg] $msg } {1 {bad window path name "geek"}} test winfo-2.5 {"winfo atomname" command} { list [catch {winfo atomname 44215} msg] $msg } {1 {no atom exists with id "44215"}} test winfo-2.6 {"winfo atomname" command} { winfo atomname 2 } SECONDARY test winfo-2.7 {"winfo atom" command} { winfo atomname -displayof . 2 } SECONDARY test winfo-3.1 {"winfo colormapfull" command} defaultPseudocolor8 { list [catch {winfo colormapfull} msg] $msg } {1 {wrong # args: should be "winfo colormapfull window"}} test winfo-3.2 {"winfo colormapfull" command} defaultPseudocolor8 { list [catch {winfo colormapfull a b} msg] $msg } {1 {wrong # args: should be "winfo colormapfull window"}} test winfo-3.3 {"winfo colormapfull" command} defaultPseudocolor8 { list [catch {winfo colormapfull foo} msg] $msg } {1 {bad window path name "foo"}} test winfo-3.4 {"winfo colormapfull" command} {unix defaultPseudocolor8} { eatColors .t {-colormap new} set result [list [winfo colormapfull .] [winfo colormapfull .t]] .t.c delete 34 lappend result [winfo colormapfull .t] .t.c create rectangle 30 30 80 80 -fill #441739 lappend result [winfo colormapfull .t] .t.c create rectangle 40 40 90 90 -fill #ffeedd lappend result [winfo colormapfull .t] destroy .t.c lappend result [winfo colormapfull .t] } {0 1 0 0 1 0} catch {destroy .t} toplevel .t -width 550 -height 400 frame .t.f -width 80 -height 60 -bd 2 -relief raised place .t.f -x 50 -y 50 wm geom .t +0+0 update test winfo-4.1 {"winfo containing" command} { list [catch {winfo containing 22} msg] $msg } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}} test winfo-4.2 {"winfo containing" command} { list [catch {winfo containing a b c} msg] $msg } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}} test winfo-4.3 {"winfo containing" command} { list [catch {winfo containing a b c d e} msg] $msg } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}} test winfo-4.4 {"winfo containing" command} { list [catch {winfo containing -displayof geek 25 30} msg] $msg } {1 {bad window path name "geek"}} test winfo-4.5 {"winfo containing" command} { raise .t winfo containing [winfo rootx .t.f] [winfo rooty .t.f] } .t.f test winfo-4.6 {"winfo containing" command} {nonPortable} { winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1] } .t test winfo-4.7 {"winfo containing" command} { set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \ [expr [winfo rooty .t.f]+450]] expr {($x == ".") || ($x == "")} } {1} destroy .t test winfo-5.1 {"winfo interps" command} { list [catch {winfo interps a} msg] $msg } {1 {wrong # args: should be "winfo interps ?-displayof window?"}} test winfo-5.2 {"winfo interps" command} { list [catch {winfo interps a b c} msg] $msg } {1 {wrong # args: should be "winfo interps ?-displayof window?"}} test winfo-5.3 {"winfo interps" command} { list [catch {winfo interps -displayof geek} msg] $msg } {1 {bad window path name "geek"}} test winfo-5.4 {"winfo interps" command} unix { expr [lsearch -exact [winfo interps] [tk appname]] >= 0 } {1} test winfo-5.5 {"winfo interps" command} unix { expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0 } {1} test winfo-6.1 {"winfo exists" command} { list [catch {winfo exists} msg] $msg } {1 {wrong # args: should be "winfo exists window"}} test winfo-6.2 {"winfo exists" command} { list [catch {winfo exists a b} msg] $msg } {1 {wrong # args: should be "winfo exists window"}} test winfo-6.3 {"winfo exists" command} { winfo exists gorp } {0} test winfo-6.4 {"winfo exists" command} { winfo exists . } {1} test winfo-6.5 {"winfo exists" command} { button .b -text "Test button" set x [winfo exists .b] pack .b update bind .b {lappend x [winfo exists .x]} destroy .b lappend x [winfo exists .x] } {1 0 0} catch {destroy .b} button .b -text "Help" update test winfo-7.1 {"winfo pathname" command} { list [catch {winfo pathname} msg] $msg } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}} test winfo-7.2 {"winfo pathname" command} { list [catch {winfo pathname a b} msg] $msg } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}} test winfo-7.3 {"winfo pathname" command} { list [catch {winfo pathname a b c d} msg] $msg } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}} test winfo-7.4 {"winfo pathname" command} { list [catch {winfo pathname -displayof geek 25} msg] $msg } {1 {bad window path name "geek"}} test winfo-7.5 {"winfo pathname" command} { list [catch {winfo pathname xyz} msg] $msg } {1 {expected integer but got "xyz"}} test winfo-7.6 {"winfo pathname" command} { list [catch {winfo pathname 224} msg] $msg } {1 {window id "224" doesn't exist in this application}} test winfo-7.7 {"winfo pathname" command} { winfo pathname -displayof .b [winfo id .] } {.} test winfo-7.8 {"winfo pathname" command} {unix testwrapper} { winfo pathname [testwrapper .] } {} test winfo-8.1 {"winfo pointerx" command} { catch [winfo pointerx .b] } 1 test winfo-8.2 {"winfo pointery" command} { catch [winfo pointery .b] } 1 test winfo-8.3 {"winfo pointerxy" command} { catch [winfo pointerxy .b] } 1 test winfo-9.1 {"winfo viewable" command} { list [catch {winfo viewable} msg] $msg } {1 {wrong # args: should be "winfo viewable window"}} test winfo-9.2 {"winfo viewable" command} { list [catch {winfo viewable foo} msg] $msg } {1 {bad window path name "foo"}} test winfo-9.3 {"winfo viewable" command} { winfo viewable . } {1} test winfo-9.4 {"winfo viewable" command} { wm iconify . winfo viewable . } {0} wm deiconify . test winfo-9.5 {"winfo viewable" command} { frame .f1 -width 100 -height 100 -relief raised -bd 2 place .f1 -x 0 -y 0 frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 place .f1.f2 -x 0 -y 0 update list [winfo viewable .f1] [winfo viewable .f1.f2] } {1 1} test winfo-9.6 {"winfo viewable" command} { deleteWindows frame .f1 -width 100 -height 100 -relief raised -bd 2 frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 place .f1.f2 -x 0 -y 0 update list [winfo viewable .f1] [winfo viewable .f1.f2] } {0 0} test winfo-9.7 {"winfo viewable" command} { deleteWindows frame .f1 -width 100 -height 100 -relief raised -bd 2 place .f1 -x 0 -y 0 frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 place .f1.f2 -x 0 -y 0 update wm iconify . list [winfo viewable .f1] [winfo viewable .f1.f2] } {0 0} wm deiconify . deleteWindows test winfo-10.1 {"winfo visualid" command} { list [catch {winfo visualid} msg] $msg } {1 {wrong # args: should be "winfo visualid window"}} test winfo-10.2 {"winfo visualid" command} { list [catch {winfo visualid gorp} msg] $msg } {1 {bad window path name "gorp"}} test winfo-10.3 {"winfo visualid" command} { expr 2+[winfo visualid .]-[winfo visualid .] } {2} test winfo-11.1 {"winfo visualid" command} { list [catch {winfo visualsavailable} msg] $msg } {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}} test winfo-11.2 {"winfo visualid" command} { list [catch {winfo visualsavailable gorp} msg] $msg } {1 {bad window path name "gorp"}} test winfo-11.3 {"winfo visualid" command} { list [catch {winfo visualsavailable . includeids foo} msg] $msg } {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}} test winfo-11.4 {"winfo visualid" command} { llength [lindex [winfo visualsa .] 0] } {2} test winfo-11.5 {"winfo visualid" command} { llength [lindex [winfo visualsa . includeids] 0] } {3} test winfo-11.6 {"winfo visualid" command} { set x [lindex [lindex [winfo visualsa . includeids] 0] 2] expr $x + 2 - $x } {2} test winfo-12.1 {GetDisplayOf procedure} { list [catch {winfo atom - foo x} msg] $msg } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} test winfo-12.2 {GetDisplayOf procedure} { list [catch {winfo atom -d bad_window x} msg] $msg } {1 {bad window path name "bad_window"}} # Some embedding tests # proc MakeEmbed {} { frame .con -container 1 pack .con -expand yes -fill both toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 button .emb.b pack .emb.b -expand yes -fill both update } test winfo-13.1 {root coordinates of embedded toplevel} { MakeEmbed set z [expr [winfo rootx .emb] == [winfo rootx .con] && \ [winfo rooty .emb] == [winfo rooty .con]] destroy .emb destroy .con set z } {1} test winfo-13.2 {destroying embedded toplevel} { destroy .emb update expr [winfo exists .emb.b] || [winfo exists .con] } 0 deleteWindows test winfo-13.3 {destroying container window} { MakeEmbed destroy .con update set z [expr [winfo exists .emb.b] || [winfo exists .emb]] catch {destroy .emb} catch {destroy .con} set z } 0 deleteWindows test winfo-13.4 {[winfo containing] with embedded windows} { MakeEmbed button .b pack .b -expand yes -fill both update set z [string compare \ [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b] catch {destroy .con} catch {destroy .emb} set z } 0 test winfo-14.1 {usage} { list [catch {winfo ismapped} msg] $msg } {1 {wrong # args: should be "winfo ismapped window"}} test winfo-14.2 {usage} { list [catch {winfo ismapped . .} msg] $msg } {1 {wrong # args: should be "winfo ismapped window"}} test winfo-14.3 {initially unmapped} { catch {destroy .t} toplevel .t winfo ismapped .t } 0 test winfo-14.4 {mapped at idle time} { catch {destroy .t} toplevel .t update idletasks winfo ismapped .t } 1 deleteWindows # cleanup cleanupTests return tk8.5.19/tests/pwrdLogo150.gif0000644003604700454610000000467112612445655014450 0ustar dgp771divGIF89aa̙f̙̙̙f̙fff3f333̙̙ffff3333fffffffff3ff333f3f3333f3! -dl-! ,a@pH,Ȥrl:·TBTجVzHj՚h&ѓt"FdgN~Yg}rgogYwWNZWftL~f NewɑפԿWMrڕOq Ǖ W-/i*`z F9/9- $6GSDZzB,nw64e4ޅHOtf) OXCeU(Qh T|P w$ kZF\RuF]Z --(v+)[Y =!W+]]_&/Ap j!b: {^= `U@Hf\?(Lq@ 0La&!]#]G \qAHX[(W,ƌ1aBW(t8AdG)(P=UuuAKM\'rR/Wd2a0訦GÎ?B#HƊ1Q0R %+0I{<QVtz' ynEpĹ0iIg΢L%ʫKAlphQ1eⲁZg2esmU&d;JÌyjL !"..v 䀥.kXůZMY' RlЯKLv%8ʣ~~A/9Mv%|50 J <U5\51\ 8iV=W;s=A tytQ넀K8eO#d"DjKV[wĽ ^mJvUma,9tTjm.A9036Ej;w o~BUyzU'S͌%+mgrP/>~g W˳f]Tw;|OaE^cWb!zghn wc!{wBx.DJLE'3B[2?]!.L@VD{`¦) ;cT6a%J$.aR*P >ᆧ O%>t[ `Ѽ1va Jh %V"h_d  جH6x4.AXy,uD:3$<.cYcxP za!Q>᱑lK! !zd:@ryG8 eU9JacEÝK@+4'`H"Oℎ@J@Mp0tiR¦$?5 r0D 5fsmA җ%]SJhI5E {ijR6L|*'ş4i-AN-(tD3"EE3rKDQfӈ "S iMQ@hBKDkK:#Vc!2XZ ȳ~# )|PԲZ=^Ek9jX̮x%^J ]o+V ="Pњ2Af\  Wlf`W,0Nb l9 kڔՂjs9 dQl,  8r@2B1V6)9 8Y[}  .Z% !5GHKeۉgDg,~Xvx+JIgsm¥ 1U 4|a9)"j/?bN54K"?\I"Yp= %;M~=)[yG߻,[)%tY4'hx枈V-M构 +(4TNY+ Pe*9'.7S;?a.)Fٜ ^2x5/4piT#%vI8/ t5hаQ jqKJ(_.2A|Lѐ^~l j^rK0\ ٭uS沾R}{z/p .ux>L[OϷ{\ 8?NrUJ:X%Oy*.r$_aN!;tk8.5.19/tests/msgbox.test0000644003604700454610000001207512612445655014133 0ustar dgp771div# This file is a Tcl script to test out Tk's "tk_messageBox" command. # It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands test msgbox-1.1 {tk_messageBox command} { list [catch {tk_messageBox -foo} msg] $msg } {1 {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}} test msgbox-1.2 {tk_messageBox command} { list [catch {tk_messageBox -foo bar} msg] $msg } {1 {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}} catch {tk_messageBox -foo bar} msg regsub -all , $msg "" options regsub \"-foo\" $options "" options foreach option $options { if {[string index $option 0] eq "-"} { test msgbox-1.3$option {tk_messageBox command} -body { tk_messageBox $option } -returnCodes error -result "value for \"$option\" missing" } } test msgbox-1.4 {tk_messageBox command} { list [catch {tk_messageBox -default} msg] $msg } {1 {value for "-default" missing}} test msgbox-1.5 {tk_messageBox command} { list [catch {tk_messageBox -type foo} msg] $msg } {1 {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}} proc createPlatformMsg {val} { global tcl_platform if {$tcl_platform(platform) == "unix"} { return "invalid default button \"$val\"" } return "bad -default value \"$val\": must be abort, retry, ignore, ok, cancel, no, or yes" } test msgbox-1.6 {tk_messageBox command} { list [catch {tk_messageBox -default 1.1} msg] $msg } [list 1 [createPlatformMsg "1.1"]] test msgbox-1.7 {tk_messageBox command} { list [catch {tk_messageBox -default foo} msg] $msg } [list 1 [createPlatformMsg "foo"]] test msgbox-1.8 {tk_messageBox command} { list [catch {tk_messageBox -type yesno -default 3} msg] $msg } [list 1 [createPlatformMsg "3"]] test msgbox-1.9 {tk_messageBox command} { list [catch {tk_messageBox -icon foo} msg] $msg } {1 {bad -icon value "foo": must be error, info, question, or warning}} test msgbox-1.10 {tk_messageBox command} { list [catch {tk_messageBox -parent foo.bar} msg] $msg } {1 {bad window path name "foo.bar"}} set isNative [expr {[info commands tk::MessageBox] == ""}] proc ChooseMsg {parent btn} { global isNative if {!$isNative} { after 100 SendEventToMsg $parent $btn mouse } } proc ChooseMsgByKey {parent btn} { global isNative if {!$isNative} { after 100 SendEventToMsg $parent $btn key } } proc PressButton {btn} { event generate $btn event generate $btn -x 5 -y 5 event generate $btn -x 5 -y 5 } proc SendEventToMsg {parent btn type} { if {$parent != "."} { set w $parent.__tk__messagebox } else { set w .__tk__messagebox } if ![winfo ismapped $w.$btn] { update } if {$type == "mouse"} { PressButton $w.$btn } else { event generate $w focus $w event generate $w.$btn event generate $w -keysym Return } } set parent . set specs { {"abortretryignore" MB_ABORTRETRYIGNORE 3 {"abort" "retry" "ignore"}} {"ok" MB_OK 1 {"ok" }} {"okcancel" MB_OKCANCEL 2 {"ok" "cancel" }} {"retrycancel" MB_RETRYCANCEL 2 {"retry" "cancel" }} {"yesno" MB_YESNO 2 {"yes" "no" }} {"yesnocancel" MB_YESNOCANCEL 3 {"yes" "no" "cancel"}} } # # Try out all combinations of (type) x (default button) and # (type) x (icon). # set count 1 foreach spec $specs { set type [lindex $spec 0] set buttons [lindex $spec 3] set button [lindex $buttons 0] test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction { ChooseMsg $parent $button tk_messageBox -title Hi -message "Please press $button" \ -type $type } $button incr count foreach icon {warning error info question} { test msgbox-2.$count {tk_messageBox command -icon option} \ nonUnixUserInteraction { ChooseMsg $parent $button tk_messageBox -title Hi -message "Please press $button" \ -type $type -icon $icon } $button incr count } foreach button $buttons { test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction { ChooseMsg $parent $button tk_messageBox -title Hi -message "Please press $button" \ -type $type -default $button } "$button" incr count } } # These tests will hang your test suite if they fail. test msgbox-3.1 {tk_messageBox handles withdrawn parent} nonUnixUserInteraction { wm withdraw . ChooseMsg . "ok" tk_messageBox -title Hi -message "Please press ok" \ -type ok -default ok } "ok" wm deiconify . test msgbox-3.2 {tk_messageBox handles iconified parent} nonUnixUserInteraction { wm iconify . ChooseMsg . "ok" tk_messageBox -title Hi -message "Please press ok" \ -type ok -default ok } "ok" wm deiconify . # cleanup cleanupTests return tk8.5.19/tests/event.test0000644003604700454610000005066112627134671013757 0ustar dgp771div# This file is a Tcl script to test the code in tkEvent.c. It is # organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # XXX This test file is woefully incomplete. Right now it only tests # a few of the procedures in tkEvent.c. Please add more tests whenever # 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 } # Most punctuation array set keypress_lookup { ! exclam % percent & ampersand ( parenleft ) parenright * asterisk + plus , comma - minus . period / slash : colon < less = equal > greater ? question @ at ^ asciicircum _ underscore | bar ~ asciitilde ' apostrophe } # Characters with meaning to Tcl... array set keypress_lookup [list \ \" quotedbl \ \# numbersign \ \$ dollar \ \; semicolon \ \[ bracketleft \ \\ backslash \ \] bracketright \ \{ braceleft \ \} braceright \ " " space \ "\n" Return \ "\t" Tab] } # 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] # Force focus to the window before delivering # each event so that a window manager using # a focus follows mouse will not steal away # the focus if the mouse is moved around. if {[focus] != $win} { focus -force $win } event generate $win _pause 50 if {[focus] != $win} { focus -force $win } event generate $win _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} { set bbox [$text bbox $ind] if {[llength $bbox] != 4} { error "got bbox \{$bbox\} from $text, index $ind" } foreach {x1 y1 width height} $bbox break set middle_y [expr {$y1 + ($height / 2)}] return [list $x1 $middle_y] } # Return selection only if owned by the given widget proc _get_selection {widget} { if {[string compare $widget [selection own]] != 0} { return "" } if {[catch {selection get} sel]} { return "" } return $sel } # Begining of the actual tests test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} { button .b -text Test pack .b bindtags .b .b update bind .b { lappend x destroy event generate .b <1> event generate .b } bind .b <1> { lappend x button } set x {} destroy .b set x } {destroy} test event-1.2 {event generate } { catch {destroy .e} catch {unset ::event12result} set ::event12result 0 pack [entry .e] update bind .e {set ::event12result "1"} focus -force .e ; event generate .e destroy .e set ::event12result } 1 test event-2.1(keypress) {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 {set return_binding 1} tkwait visibility $e _keypress_string $e HELLO\n list [$e get] $return_binding } {HELLO 1} test event-2.2(keypress) {type into entry widget and then delete some text} { destroy .t set t [toplevel .t] set e [entry $t.e] pack $e tkwait visibility $e _keypress_string $e MELLO _keypress $e BackSpace _keypress $e BackSpace $e get } MEL test event-2.3(keypress) {type into entry widget, triple click,\ hit Delete key, and then type some more} { destroy .t set t [toplevel .t] set e [entry $t.e] pack $e tkwait visibility $e _keypress_string $e JUMP set result [$e get] event generate $e for {set i 0} {$i < 3} {incr i} { _pause 100 event generate $e _pause 100 event generate $e } _keypress $e Delete _keypress_string $e UP lappend result [$e get] } {JUMP UP} test event-1.4(keypress) {type into text widget and hit Return} { destroy .t set t [toplevel .t] set e [text $t.e] pack $e set return_binding 0 bind $e {set return_binding 1} tkwait visibility $e _keypress_string $e HELLO\n list [$e get 1.0 end] $return_binding } [list "HELLO\n\n" 1] test event-2.5(keypress) {type into text widget and then delete some text} { destroy .t set t [toplevel .t] set e [text $t.e] pack $e tkwait visibility $e _keypress_string $e MELLO _keypress $e BackSpace _keypress $e BackSpace $e get 1.0 1.end } MEL test event-2.6(keypress) {type into text widget, triple click,\ hit Delete key, and then type some more} { destroy .t set t [toplevel .t] set e [text $t.e] pack $e tkwait visibility $e _keypress_string $e JUMP set result [$e get 1.0 1.end] event generate $e for {set i 0} {$i < 3} {incr i} { _pause 100 event generate $e _pause 100 event generate $e } _keypress $e Delete _keypress_string $e UP lappend result [$e get 1.0 1.end] } {JUMP UP} test event-3.1(click-drag) {click and drag in a text widget, this tests\ tkTextSelectTo in text.tcl} { destroy .t set t [toplevel .t] set e [text $t.e] pack $e tkwait visibility $e _keypress_string $e "A Tcl/Tk selection test!" set anchor 1.6 set selend 1.18 set result [list] lappend result [$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 event generate $e -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 -x $current_x -y $current_y set current [$e index [list $current + 1 char]] _pause 50 } event generate $e -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 [_get_selection $e] # Now click and click and drag to the left, over "Tcl/Tk selection" event generate $e -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 -x $current_x -y $current_y set current [$e index [list $current - 1 char]] _pause 50 } event generate $e -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 [_get_selection $e] } {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}} test event-3.2(click-drag) {click and drag in an entry widget, this\ tests tkEntryMouseSelect in entry.tcl} { destroy .t set t [toplevel .t] set e [entry $t.e] pack $e tkwait visibility $e _keypress_string $e "A Tcl/Tk selection!" set anchor 6 set selend 18 set result [list] lappend result [$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 event generate $e -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 -x $current_x -y $current_y incr current _pause 50 } event generate $e -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 [_get_selection $e] # Now click and click and drag to the left, over "Tcl/Tk selection" event generate $e -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 -x $current_x -y $current_y incr current -1 _pause 50 } event generate $e -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 [_get_selection $e] } {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} test event-4.1(double-click-drag) {click down, click up, click down again,\ then drag in a text widget} { destroy .t set t [toplevel .t] set e [text $t.e] pack $e tkwait visibility $e _keypress_string $e "Word select test" set anchor 1.8 # Get the x,y coords of the second e in "select" foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break # Click down, release, then click down again event generate $e event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 # Save the highlighted text set result [list] lappend result [_get_selection $e] # Insert cursor should be at beginning of "select" lappend result [$e index insert] # Move mouse one character to the left set current [$e index [list $anchor - 1 char]] foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 50 # Insert cursor should be before the l in "select" lappend result [$e index insert] # Selection should still be the word "select" lappend result [_get_selection $e] # Move mouse to the space before the word "select" set current [$e index [list $current - 3 char]] foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 200 lappend result [$e index insert] lappend result [_get_selection $e] # Move mouse to the r in "Word" set current 1.2 foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 50 # Selection should now be "Word select" lappend result [_get_selection $e] # Insert cursor should be before the r in "Word" lappend result [$e index insert] set result } {select 1.5 1.7 select 1.4 { select} {Word select} 1.2} test event-4.2(double-click-drag) {click down, click up, click down again,\ then drag in an entry widget} { destroy .t set t [toplevel .t] set e [entry $t.e] pack $e tkwait visibility $e _keypress_string $e "Word select test" set anchor 8 # Get the x,y coords of the second e in "select" foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break # Click down, release, then click down again event generate $e event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 set result [list] lappend result [_get_selection $e] # Insert cursor should be at the end of "select" lappend result [$e index insert] # Move mouse one character to the left set current [expr {$anchor - 1}] foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 50 # Insert cursor should be before the l in "select" lappend result [$e index insert] # Selection should still be the word "select" lappend result [_get_selection $e] # Move mouse to the space before the word "select" set current [expr {$current - 3}] foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 50 lappend result [$e index insert] lappend result [_get_selection $e] # Move mouse to the r in "Word" set current [expr {$current - 2}] foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 50 # Selection should now be "Word select" lappend result [_get_selection $e] # Insert cursor should be before the r in "Word" lappend result [$e index insert] set result } {select 11 7 select 4 { select} {Word select} 2} test event-5.1(triple-click-drag) {Triple click and drag across lines in\ a text widget, this should extend the selection to the new line} { destroy .t set t [toplevel .t] set e [text $t.e] pack $e tkwait visibility $e _keypress_string $e "LINE ONE\nLINE TWO\nLINE THREE" set anchor 3.2 # Triple click one third line leaving mouse down foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break event generate $e event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 set result [list] lappend result [_get_selection $e] # Drag up to second line set current [$e index [list $anchor - 1 line]] foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 50 lappend result [_get_selection $e] # Drag up to first line set current [$e index [list $current - 1 line]] foreach {current_x current_y} [_text_ind_to_x_y $e $current] break event generate $e -x $current_x -y $current_y _pause 50 lappend result [_get_selection $e] set result } [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \ "LINE ONE\nLINE TWO\nLINE THREE\n"] test event-6.1(button-state) {button press in a window that is then\ destroyed, when the mouse is moved into another window it\ should not generate a event since the mouse\ was not pressed down in that window} { destroy .t set t [toplevel .t] event generate $t destroy $t set t [toplevel .t] set motion nomotion bind $t {set motion inmotion} event generate $t set motion } nomotion test event-7.1(double-click) {A double click on a lone character in a text widget should select that character} { destroy .t set t [toplevel .t] set e [text $t.e] pack $e tkwait visibility $e focus -force $e _keypress_string $e "On A letter" set anchor 1.3 # Get x,y coords just inside the left # and right hand side of the letter A foreach {x1 y1 width height} [$e bbox $anchor] break set middle_y [expr {$y1 + ($height / 2)}] set left_x [expr {$x1 + 2}] set left_y $middle_y set right_x [expr {($x1 + $width) - 2}] set right_y $middle_y # Double click near left hand egde of the letter A event generate $e event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 set result [list] lappend result [$e index insert] lappend result [_get_selection $e] # Clear selection by clicking at 0,0 event generate $e -x 0 -y 0 _pause 50 event generate $e -x 0 -y 0 _pause 50 # Double click near right hand edge of the letter A event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 lappend result [$e index insert] lappend result [_get_selection $e] set result } {1.3 A 1.3 A} test event-7.2(double-click) {A double click on a lone character\ in an entry widget should select that character} { destroy .t set t [toplevel .t] set e [entry $t.e] pack $e tkwait visibility $e focus -force $e _keypress_string $e "On A letter" set anchor 3 # Get x,y coords just inside the left # and right hand side of the letter A foreach {x1 y1 width height} [$e bbox $anchor] break set middle_y [expr {$y1 + ($height / 2)}] set left_x [expr {$x1 + 2}] set left_y $middle_y set right_x [expr {($x1 + $width) - 2}] set right_y $middle_y # Double click near left hand egde of the letter A event generate $e event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 set result [list] lappend result [$e index insert] lappend result [_get_selection $e] # Clear selection by clicking at 0,0 event generate $e -x 0 -y 0 _pause 50 event generate $e -x 0 -y 0 _pause 50 # Double click near right hand edge of the letter A event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 lappend result [$e index insert] lappend result [_get_selection $e] set result } {4 A 4 A} # cleanup destroy .t unset -nocomplain keypress_lookup rename _init_keypress_lookup {} rename _keypress_lookup {} rename _keypress {} rename _pause {} rename _text_ind_to_x_y {} rename _get_selection {} cleanupTests return tk8.5.19/tests/canvImg.test0000644003604700454610000003215112612445655014215 0ustar dgp771div# This file is a Tcl script to test out the procedures in tkCanvImg.c, # which implement canvas "image" items. It is organized in the standard # fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands eval image delete [image names] canvas .c pack .c update if {[testConstraint testImageType]} { image create test foo -variable x image create test foo2 -variable y foo2 changed 0 0 0 0 80 60 } test canvImg-1.1 {options for image items} { .c delete all .c create image 50 50 -anchor nw -tags i1 .c itemconfigure i1 -anchor } {-anchor {} {} center nw} test canvImg-1.2 {options for image items} { .c delete all list [catch {.c create image 50 50 -anchor gorp -tags i1} msg] $msg } {1 {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center}} test canvImg-1.3 {options for image items} testImageType { .c delete all .c create image 50 50 -image foo -tags i1 .c itemconfigure i1 -image } {-image {} {} {} foo} test canvImg-1.4 {options for image items} { .c delete all list [catch {.c create image 50 50 -image unknown -tags i1} msg] $msg } {1 {image "unknown" doesn't exist}} test canvImg-1.5 {options for image items} testImageType { .c delete all .c create image 50 50 -image foo -tags {i1 foo} .c itemconfigure i1 -tags } {-tags {} {} {} {i1 foo}} test canvImg-2.1 {CreateImage procedure} { list [catch {.c create image 40} msg] $msg } {1 {wrong # coordinates: expected 2, got 1}} test canvImg-2.2 {CreateImage procedure} { list [catch {.c create image 40 50 60} msg] $msg } {1 {unknown option "60"}} test canvImg-2.3 {CreateImage procedure} { .c delete all set i [.c create image 50 50] list [lindex [.c itemconf $i -anchor] 4] \ [lindex [.c itemconf $i -image] 4] \ [lindex [.c itemconf $i -tags] 4] } {center {} {}} test canvImg-2.4 {CreateImage procedure} { list [catch {.c create image xyz 40} msg] $msg } {1 {bad screen distance "xyz"}} test canvImg-2.5 {CreateImage procedure} { list [catch {.c create image 50 qrs} msg] $msg } {1 {bad screen distance "qrs"}} test canvImg-2.6 {CreateImage procedure} testImageType { list [catch {.c create image 50 50 -gorp foo} msg] $msg } {1 {unknown option "-gorp"}} test canvImg-3.1 {ImageCoords procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 .c coords i1 } {50.0 100.0} test canvImg-3.2 {ImageCoords procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 list [catch {.c coords i1 dumb 100} msg] $msg } {1 {bad screen distance "dumb"}} test canvImg-3.3 {ImageCoords procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 list [catch {.c coords i1 250 dumb0} msg] $msg } {1 {bad screen distance "dumb0"}} test canvImg-3.4 {ImageCoords procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 list [catch {.c coords i1 250} msg] $msg } {1 {wrong # coordinates: expected 2, got 1}} test canvImg-3.5 {ImageCoords procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 list [catch {.c coords i1 250 300 400} msg] $msg } {1 {wrong # coordinates: expected 0 or 2, got 3}} test canvImg-4.1 {ConfiugreImage procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 update set x {} .c itemconfigure i1 -image {} update list $x [.c bbox i1] } {{{foo free}} {}} test canvImg-4.2 {ConfiugreImage procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} set y {} .c itemconfigure i1 -image foo2 update list $x $y [.c bbox i1] } {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}} test canvImg-4.3 {ConfiugreImage procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} set y {} list [catch {.c itemconfigure i1 -image lousy} msg] $msg } {1 {image "lousy" doesn't exist}} test canvImg-5.1 {DeleteImage procedure} testImageType { image create test xyzzy -variable z .c delete all .c create image 50 100 -image xyzzy -tags i1 update set names [lsort [image names]] image delete xyzzy set z {} set names2 [lsort [image names]] .c delete i1 update list $names $names2 $z [lsort [image names]] } {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} { .c delete all .c create image 50 100 -tags i1 update .c delete i1 update } {} test canvImg-6.1 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 15.51 17.51 -image foo -tags i1 -anchor nw .c bbox i1 } {16 18 46 33} test canvImg-6.2 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 15.49 17.49 -image foo -tags i1 -anchor nw .c bbox i1 } {15 17 45 32} test canvImg-6.3 {ComputeImageBbox procedure} { .c delete all .c create image 20 30 -tags i1 -anchor nw .c bbox i1 } {} test canvImg-6.4 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor nw .c bbox i1 } {20 30 50 45} test canvImg-6.5 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor n .c bbox i1 } {5 30 35 45} test canvImg-6.6 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor ne .c bbox i1 } {-10 30 20 45} test canvImg-6.7 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor e .c bbox i1 } {-10 23 20 38} test canvImg-6.8 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor se .c bbox i1 } {-10 15 20 30} test canvImg-6.9 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor s .c bbox i1 } {5 15 35 30} test canvImg-6.10 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor sw .c bbox i1 } {20 15 50 30} test canvImg-6.11 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor w .c bbox i1 } {20 23 50 38} test canvImg-6.12 {ComputeImageBbox procedure} testImageType { .c delete all .c create image 20 30 -image foo -tags i1 -anchor center .c bbox i1 } {5 23 35 38} # The following test is non-portable because of differences in # coordinate rounding on some machines (does 0.5 round up?). test canvImg-7.1 {DisplayImage procedure} {nonPortable testImageType} { .c delete all .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} .c create rect 55 110 65 115 -width 1 -outline black -fill white update set x } {{foo display 4 9 12 6 30 30}} test canvImg-7.2 {DisplayImage procedure, no image} { .c delete all .c create image 50 100 -tags i1 update .c create rect 55 110 65 115 -width 1 -outline black -fill white update } {} .c delete all if {[testConstraint testImageType]} { .c create image 50 100 -image foo -tags image -anchor nw } .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} foreach check { {canvImg-8.1 {50 70 80 81} {70 90} rect} {canvImg-8.2 {50 70 80 79} {70 90} image} {canvImg-8.3 {99 70 110 81} {90 90} rect} {canvImg-8.4 {101 70 110 79} {90 90} image} {canvImg-8.5 {99 100 110 115} {90 110} rect} {canvImg-8.6 {101 100 110 115} {90 110} image} {canvImg-8.7 {99 134 110 145} {90 125} rect} {canvImg-8.8 {101 136 110 145} {90 125} image} {canvImg-8.9 {50 134 80 145} {70 125} rect} {canvImg-8.10 {50 136 80 145} {70 125} image} {canvImg-8.11 {20 134 31 145} {40 125} rect} {canvImg-8.12 {20 136 29 145} {40 125} image} {canvImg-8.13 {20 100 31 115} {40 110} rect} {canvImg-8.14 {20 100 29 115} {40 110} image} {canvImg-8.15 {20 70 31 80} {40 90} rect} {canvImg-8.16 {20 70 29 79} {40 90} image} {canvImg-8.17 {60 70 69 109} {70 110} image} {canvImg-8.18 {60 70 71 111} {70 110} rect} } { lassign $check name rectCoords testPoint result test $name {ImageToPoint procedure} testImageType { .c coords rect {*}$rectCoords .c gettags [.c find closest {*}$testPoint] } $result } .c delete all if {[testConstraint testImageType]} { .c create image 50 100 -image foo -tags image -anchor nw } test canvImg-8.19 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 0 70 99] } {} test canvImg-8.20 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 0 70 99.999] } {} test canvImg-8.21 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 0 70 101] } {image} test canvImg-8.22 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 81 105 120 115] } {} test canvImg-8.23 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 80.001 105 120 115] } {} test canvImg-8.24 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 79 105 120 115] } {image} test canvImg-8.25 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 116 70 150] } {} test canvImg-8.26 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 115.001 70 150] } {} test canvImg-8.27 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 114 70 150] } {image} test canvImg-8.28 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 0 105 49 115] } {} test canvImg-8.29 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 0 105 50 114.999] } {} test canvImg-8.30 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 0 105 51 115] } {image} test canvImg-8.31 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 0 0 49.999 99.999] } {} test canvImg-8.32 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 0 0 51 101] } {image} test canvImg-8.33 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 80 0 150 100] } {} test canvImg-8.34 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 79 0 150 101] } {image} test canvImg-8.35 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 80.001 115.001 150 180] } {} test canvImg-8.36 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 79 114 150 180] } {image} test canvImg-8.37 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 0 115 50 180] } {} test canvImg-8.38 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 0 114 51 180] } {image} test canvImg-8.39 {ImageToArea procedure} testImageType { .c gettags [.c find enclosed 0 0 200 200] } {image} test canvImg-8.40 {ImageToArea procedure} testImageType { .c gettags [.c find enclosed 49.999 99.999 80.001 115.001] } {image} test canvImg-8.41 {ImageToArea procedure} testImageType { .c gettags [.c find enclosed 51 100 80 115] } {} test canvImg-8.42 {ImageToArea procedure} testImageType { .c gettags [.c find enclosed 50 101 80 115] } {} test canvImg-8.43 {ImageToArea procedure} testImageType { .c gettags [.c find enclosed 50 100 79 115] } {} test canvImg-8.44 {ImageToArea procedure} testImageType { .c gettags [.c find enclosed 50 100 80 114] } {} test canvImg-9.1 {DisplayImage procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags image -anchor nw .c scale image 25 0 2.0 1.5 .c bbox image } {75 150 105 165} test canvImg-10.1 {TranslateImage procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags image -anchor nw update set x {} foo changed 2 4 6 8 30 15 update set x } {{foo display 2 4 6 8 30 30}} test canvImg-11.1 {TranslateImage procedure} testImageType { .c delete all .c create image 50 100 -image foo -tags image -anchor nw update set x {} foo changed 2 4 6 8 40 50 update set x } {{foo display 0 0 40 50 30 30}} test canvImg-11.2 {ImageChangedProc procedure} testImageType { .c delete all image create test foo -variable x .c create image 50 100 -image foo -tags image -anchor center update set x {} foo changed 0 0 0 0 40 50 .c bbox image } {30 75 70 125} test canvImg-11.3 {ImageChangedProc procedure} testImageType { .c delete all image create test foo -variable x foo changed 0 0 0 0 40 50 .c create image 50 100 -image foo -tags image -anchor nw .c create image 70 110 -image foo2 -anchor nw update set y {} image create test foo -variable x update set y } {{foo2 display 0 0 20 40 50 40}} # cleanup cleanupTests return tk8.5.19/tests/get.test0000644003604700454610000000371512612445655013414 0ustar dgp771div# This file is a Tcl script to test out the procedures in the file # tkGet.c. It is organized in the standard fashion for Tcl # white-box tests. # # Copyright (c) 1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands button .b test get-1.1 {Tk_GetAnchorFromObj} { .b configure -anchor n .b cget -anchor } {n} test get-1.2 {Tk_GetAnchorFromObj} { .b configure -anchor ne .b cget -anchor } {ne} test get-1.3 {Tk_GetAnchorFromObj} { .b configure -anchor e .b cget -anchor } {e} test get-1.4 {Tk_GetAnchorFromObj} { .b configure -anchor se .b cget -anchor } {se} test get-1.5 {Tk_GetAnchorFromObj} { .b configure -anchor s .b cget -anchor } {s} test get-1.6 {Tk_GetAnchorFromObj} { .b configure -anchor sw .b cget -anchor } {sw} test get-1.7 {Tk_GetAnchorFromObj} { .b configure -anchor w .b cget -anchor } {w} test get-1.8 {Tk_GetAnchorFromObj} { .b configure -anchor nw .b cget -anchor } {nw} test get-1.9 {Tk_GetAnchorFromObj} { .b configure -anchor n .b cget -anchor } {n} test get-1.10 {Tk_GetAnchorFromObj} { .b configure -anchor center .b cget -anchor } {center} test get-1.11 {Tk_GetAnchorFromObj - error} { list [catch {.b configure -anchor unknown} msg] $msg } {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}} catch {destroy .b} button .b test get-2.1 {Tk_GetJustifyFromObj} { .b configure -justify left .b cget -justify } {left} test get-2.2 {Tk_GetJustifyFromObj} { .b configure -justify right .b cget -justify } {right} test get-2.3 {Tk_GetJustifyFromObj} { .b configure -justify center .b cget -justify } {center} test get-2.4 {Tk_GetJustifyFromObj - error} { list [catch {.b configure -justify stupid} msg] $msg } {1 {bad justification "stupid": must be left, right, or center}} # cleanup cleanupTests return tk8.5.19/tests/unixFont.test0000644003604700454610000002515012612445655014444 0ustar dgp771div# This file is a Tcl script to test out the procedures in tkUnixFont.c. # It is organized in the standard fashion for Tcl tests. # # Many of these tests are visually oriented and cannot be checked # programmatically (such as "does an underlined font appear to be # underlined?"); these tests attempt to exercise the code in question, # but there are no results that can be checked. Some tests depend on the # fonts having or not having certain properties, which may not be valid # at all sites. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands if {[tk windowingsystem] eq "x11"} { set xlsf [auto_execok xlsfonts] } foreach {constraint font} { hasArial arial hasCourierNew "courier new" hasTimesNew "times new roman" } { if {[tk windowingsystem] eq "x11"} { testConstraint $constraint 1 if {[llength $xlsf]} { if {![catch {eval exec $xlsf [list *-$font-*]} res] && ![string match *unmatched* $res]} { # Newer Unix systems have more default fonts installed, # so we can't rely on fallbacks for fonts to need to # fall back on anything. testConstraint $constraint 0 } } } else { testConstraint $constraint 0 } } catch {destroy .b} toplevel .b wm geom .b +0+0 update idletasks # Font should be fixed width and have chars missing below char 32, so can # test control char expansion and missing character code. set courier {Courier -10} set cx [font measure $courier 0] label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font fixed pack .b.l canvas .b.c -closeenough 0 set t [.b.c create text 0 0 -anchor nw -just left -font $courier] pack .b.c update set ax [winfo reqwidth .b.l] set ay [winfo reqheight .b.l] proc getsize {} { update return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" } test unixfont-1.1 {TkpGetNativeFont procedure: not native} {unix noExceed} { list [catch {font measure {} xyz} msg] $msg } {1 {font "" doesn't exist}} test unixfont-1.2 {TkpGetNativeFont procedure: native} unix { font measure fixed 0 } {6} test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} unix { font actual {-size 10} set x {} } {} test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} \ {unix noExceed hasTimesNew} { set x {} lappend x [lindex [font actual {-family "Times New Roman"}] 1] lappend x [lindex [font actual {-family "New York"}] 1] lappend x [lindex [font actual {-family "Times"}] 1] } {times times times} test unixfont-2.3 {TkpGetFontFromAttributes procedure: Courier relatives} \ {unix noExceed hasCourierNew} { set x {} lappend x [lindex [font actual {-family "Courier New"}] 1] lappend x [lindex [font actual {-family "Monaco"}] 1] lappend x [lindex [font actual {-family "Courier"}] 1] } {courier courier courier} test unixfont-2.4 {TkpGetFontFromAttributes procedure: Helvetica relatives} \ {unix noExceed hasArial} { set x {} lappend x [lindex [font actual {-family "Arial"}] 1] lappend x [lindex [font actual {-family "Geneva"}] 1] lappend x [lindex [font actual {-family "Helvetica"}] 1] } {helvetica helvetica helvetica} test unixfont-2.5 {TkpGetFontFromAttributes procedure: fallback} unix { font actual {-xyz-xyz-*-*-*-*-*-*-*-*-*-*-*-*} set x {} } {} test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} unix { lindex [font actual {-family fixed -size 10}] 1 } {fixed} test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} unix { # no test available } {} test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} unix { lindex [font actual {-family fixed -size 31}] 1 } {fixed} test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {unix noExceed} { lindex [font actual {-family courier}] 1 } {courier} test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} unix { lindex [font actual {-family courier -size 37}] 3 } {37} test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} unix { # On Linux, XListFonts() was returning names for fonts that do not # actually exist, causing the subsequent XLoadQueryFont() to fail # unexpectedly. Now falls back to another font if that happens. font actual {-size 14} set x {} } {} test unixfont-3.1 {TkpDeleteFont procedure} unix { font actual {-family xyz} set x {} } {} test unixfont-4.1 {TkpGetFontFamilies procedure} unix { font families set x {} } {} test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} unix { .b.l config -text "000000" -wrap [expr $ax*3] .b.l config -wrap 0 } {} test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} unix { .b.l config -text "000000" } {} test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} unix { .b.l config -text "0" .b.l config -text "\377" .b.l config -text "0\3770\377" .b.l config -text "000000000000000" } {} .b.l config -wrap [expr $ax*10] test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} unix { .b.l config -text "0000000000000" getsize } "[expr $ax*10] [expr $ay*2]" test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} unix { .b.l config -text "000000" getsize } "[expr $ax*6] $ay" test unixfont-5.6 {Tk_MeasureChars procedure: find last word} unix { .b.l config -text "000000 00000" getsize } "[expr $ax*6] [expr $ay*2]" test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} unix { .b.l config -text "000000 00000" getsize } "[expr $ax*6] [expr $ay*2]" test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} unix { .b.l config -text "00 000 00000" getsize } "[expr $ax*7] [expr $ay*2]" test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0000" .b.c index $t @[expr int($ax*2.5)],1 } {2} test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} unix { .b.l config -text "000000000000" getsize } "[expr $ax*10] [expr $ay*2]" test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} unix { set a [.b.l cget -wrap] .b.l config -text "000000" -wrap 1 set x [getsize] .b.l config -wrap $a set x } "$ax [expr $ay*6]" test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} unix { .b.l config -text "000 \n000" getsize } "[expr $ax*6] [expr $ay*2]" test unixfont-6.1 {Tk_DrawChars procedure: loop test} unix { .b.l config -text "a" update } {} test unixfont-6.2 {Tk_DrawChars procedure: loop test} unix { .b.l config -text "abcd" update } {} test unixfont-6.3 {Tk_DrawChars procedure: special char} unix { .b.l config -text "\001" update } {} test unixfont-6.4 {Tk_DrawChars procedure: normal then special} unix { .b.l config -text "ab\001" update } {} test unixfont-6.5 {Tk_DrawChars procedure: ends with special} unix { .b.l config -text "ab\001" update } {} test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} unix { .b.l config -text "ab\001def" update } {} test unixfont-7.1 {DrawChars procedure: no effects} unix { .b.l config -text "abc" update } {} test unixfont-7.2 {DrawChars procedure: underlining} unix { set f [.b.l cget -font] .b.l config -text "abc" -font "courier 10 underline" update .b.l config -font $f } {} test unixfont-7.3 {DrawChars procedure: overstrike} unix { set f [.b.l cget -font] .b.l config -text "abc" -font "courier 10 overstrike" update .b.l config -font $f } {} test unixfont-8.1 {AllocFont procedure: use old font} unix { font create xyz button .c -font xyz font configure xyz -family times update destroy .c font delete xyz } {} test unixfont-8.2 {AllocFont procedure: parse information from XLFD} unix { expr {[lindex [font actual {-family times -size 0}] 3] == 0} } {0} test unixfont-8.3 {AllocFont procedure: can't parse info from name} unix { catch {unset fontArray} # check that font actual returns the correct attributes. # the values of those attributes are system dependent. array set fontArray [font actual a12biluc] set result [lsort [array names fontArray]] catch {unset fontArray} set result } {-family -overstrike -size -slant -underline -weight} test unixfont-8.4 {AllocFont procedure: classify characters} unix { set x 0 incr x [font measure $courier "\u4000"] ;# 6 incr x [font measure $courier "\002"] ;# 4 incr x [font measure $courier "\012"] ;# 2 incr x [font measure $courier "\101"] ;# 1 set x } [expr $cx*13] test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} unix { font metrics $courier -fixed } {1} test unixfont-8.6 {AllocFont procedure: setup widths of special chars} unix { set x 0 incr x [font measure $courier "\001"] ;# 4 incr x [font measure $courier "\002"] ;# 4 incr x [font measure $courier "\012"] ;# 2 set x } [expr $cx*10] test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} unix { catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1} set x {} } {} test unixfont-8.8 {AllocFont procedure: no XA_UNDERLINE_POSITION} unix { catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific} set x {} } {} test unixfont-8.9 {AllocFont procedure: XA_UNDERLINE_THICKNESS} unix { catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1} set x {} } {} test unixfont-8.10 {AllocFont procedure: no XA_UNDERLINE_THICKNESS} unix { catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific} set x {} } {} test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} unix { catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1} set x {} } {} test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0\a0" set x {} lappend x [.b.c index $t @[expr $ax*0],0] lappend x [.b.c index $t @[expr $ax*1],0] lappend x [.b.c index $t @[expr $ax*2],0] lappend x [.b.c index $t @[expr $ax*3],0] } {0 1 1 2} test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0\0010" set x {} lappend x [.b.c index $t @[expr $ax*0],0] lappend x [.b.c index $t @[expr $ax*1],0] lappend x [.b.c index $t @[expr $ax*2],0] lappend x [.b.c index $t @[expr $ax*3],0] lappend x [.b.c index $t @[expr $ax*4],0] lappend x [.b.c index $t @[expr $ax*5],0] } {0 1 1 1 1 2} # cleanup cleanupTests return tk8.5.19/tests/grab.test0000644003604700454610000001360612612445655013550 0ustar dgp771div# Tests for the grab command. # # This file contains a collection of tests for one or more of the Tk # built-in commands. Sourcing this file runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # There's currently no way to test the actual grab effect, per se, # in an automated test. Therefore, this test suite only covers the # interface to the grab command (ie, error messages, etc.) test grab-1.1 {Tk_GrabObjCmd} { list [catch {grab} msg] $msg } [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""] test grab-1.2 {Tk_GrabObjCmd} { rename grab grabTest1.2 set res [list [catch {grabTest1.2} msg] $msg] rename grabTest1.2 grab set res } [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""] test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} { list [catch {grab .foo bar baz} msg] $msg } [list 1 "wrong # args: should be \"grab ?-global? window\""] test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} { catch {destroy .foo} list [catch {grab .foo} msg] $msg } [list 1 "bad window path name \".foo\""] test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} { list [catch {grab -foo bar} msg] $msg } [list 1 "bad option \"-foo\": must be -global"] test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} { catch {destroy .foo} list [catch {grab -global .foo} msg] $msg } [list 1 "bad window path name \".foo\""] test grab-1.7 {Tk_GrabObjCmd} { list [catch {grab foo} msg] $msg } [list 1 "bad option \"foo\": must be current, release, set, or status"] test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} { list [catch {grab current foo bar} msg] $msg } [list 1 "wrong # args: should be \"grab current ?window?\""] test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} { catch {destroy .foo} list [catch {grab current .foo} msg] $msg } [list 1 "bad window path name \".foo\""] test grab-1.10 {Tk_GrabObjCmd, "grab release window"} { list [catch {grab release} msg] $msg } [list 1 "wrong # args: should be \"grab release window\""] test grab-1.11 {Tk_GrabObjCmd, "grab release window"} { catch {destroy .foo} list [catch {grab release .foo} msg] $msg } [list 0 ""] test grab-1.12 {Tk_GrabObjCmd, "grab release window"} { list [catch {grab release foo} msg] $msg } [list 0 ""] test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} { list [catch {grab set} msg] $msg } [list 1 "wrong # args: should be \"grab set ?-global? window\""] test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} { list [catch {grab set foo bar baz} msg] $msg } [list 1 "wrong # args: should be \"grab set ?-global? window\""] test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} { catch {destroy .foo} list [catch {grab set .foo} msg] $msg } [list 1 "bad window path name \".foo\""] test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} { list [catch {grab set -foo bar} msg] $msg } [list 1 "bad option \"-foo\": must be -global"] test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} { catch {destroy .foo} list [catch {grab set -global .foo} msg] $msg } [list 1 "bad window path name \".foo\""] test grab-1.18 {Tk_GrabObjCmd, "grab status window"} { list [catch {grab status} msg] $msg } [list 1 "wrong # args: should be \"grab status window\""] test grab-1.19 {Tk_GrabObjCmd, "grab status window"} { list [catch {grab status foo bar} msg] $msg } [list 1 "wrong # args: should be \"grab status window\""] test grab-1.20 {Tk_GrabObjCmd, "grab status window"} { catch {destroy .foo} list [catch {grab status .foo} msg] $msg } [list 1 "bad window path name \".foo\""] test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } set result [grab status .] grab release . set result } "none" test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab . set result [grab status .] grab release . set result } "local" test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab -global . set result [grab status .] grab release . set result } "global" test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } set curr } "" test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab . set curr [grab current] grab release . set curr } "." test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab . set result [grab status .] grab release . lappend result [grab status .] grab -global . lappend result [grab status .] grab release . lappend result [grab status .] } [list "local" "none" "global" "none"] test grab-5.1 {Tk_GrabObjCmd, grab set} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab set . set result [list [grab current .] [grab status .]] grab release . set result } [list "." "local"] test grab-5.2 {Tk_GrabObjCmd, grab set} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab set -global . set result [list [grab current .] [grab status .]] grab release . set result } [list "." "global"] cleanupTests return tk8.5.19/tests/menubut.test0000644003604700454610000003210012612445655014302 0ustar dgp771div# This file is a Tcl script to test menubuttons in Tk. It is # organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # XXX This test file is woefully incomplete right now. If any part # XXX of a procedure has tests then the whole procedure has tests, # XXX but many procedures have no tests. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # Create entries in the option database to be sure that geometry options # like border width have predictable values. option add *Menubutton.borderWidth 2 option add *Menubutton.highlightThickness 2 option add *Menubutton.font {Helvetica -12 bold} option add *Button.borderWidth 2 option add *Button.highlightThickness 2 option add *Button.font {Helvetica -12 bold} eval image delete [image names] if {[testConstraint testImageType]} { image create test image1 } menubutton .mb -text "Test" pack .mb update set i 1 foreach test { {-activebackground #012345 #012345 non-existent {unknown color name "non-existent"}} {-activeforeground #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bd 4 4 badValue {bad screen distance "badValue"}} {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bitmap questhead questhead badValue {bitmap "badValue" not defined}} {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-cursor arrow arrow badValue {bad cursor spec "badValue"}} {-direction below below badValue {bad direction "badValue": must be above, below, flush, left, or right}} {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}} {-fg #110022 #110022 bogus {unknown color name "bogus"}} {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}} {-foreground #110022 #110022 bogus {unknown color name "bogus"}} {-height 18 18 20.0 {expected integer but got "20.0"}} {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}} {-highlightthickness 18 18 badValue {bad screen distance "badValue"}} {-image image1 image1 bogus {image "bogus" doesn't exist}} {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}} {-justify right right bogus {bad justification "bogus": must be left, right, or center}} {-menu "any old string" "any old string" {} {}} {-padx 12 12 420x {bad screen distance "420x"}} {-pady 12 12 420x {bad screen distance "420x"}} {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal}} {-takefocus "any string" "any string" {} {}} {-text "Sample text" {Sample text} {} {}} {-textvariable i i {} {}} {-underline 5 5 3p {expected integer but got "3p"}} {-width 402 402 3p {expected integer but got "3p"}} {-wraplength 100 100 6x {bad screen distance "6x"}} } { set name [lindex $test 0] test menubutton-1.$i {configuration options} testImageType { .mb configure $name [lindex $test 1] lindex [.mb configure $name] 4 } [lindex $test 2] incr i if {[lindex $test 3] != ""} { test menubutton-1.$i {configuration options} { list [catch {.mb configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } .mb configure $name [lindex [.mb configure $name] 3] incr i } test menubutton-2.1 {Tk_MenubuttonCmd procedure} { list [catch {menubutton} msg] $msg } {1 {wrong # args: should be "menubutton pathName ?options?"}} test menubutton-2.2 {Tk_MenubuttonCmd procedure} { list [catch {menubutton foo} msg] $msg } {1 {bad window path name "foo"}} test menubutton-2.3 {Tk_MenubuttonCmd procedure} { catch {destroy .mb} menubutton .mb winfo class .mb } {Menubutton} test menubutton-2.4 {Tk_ButtonCmd procedure} { catch {destroy .mb} list [catch {menubutton .mb -gorp foo} msg] $msg [winfo exists .mb] } {1 {unknown option "-gorp"} 0} catch {destroy .mb} menubutton .mb -text "Test Menu" pack .mb test menubutton-3.1 {MenuButtonWidgetCmd procedure} { list [catch {.mb} msg] $msg } {1 {wrong # args: should be ".mb option ?arg arg ...?"}} test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.mb c} msg] $msg } {1 {ambiguous option "c": must be cget or configure}} test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.mb cget} msg] $msg } {1 {wrong # args: should be ".mb cget option"}} test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.mb cget a b} msg] $msg } {1 {wrong # args: should be ".mb cget option"}} test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.mb cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} { .mb configure -highlightthickness 3 .mb cget -highlightthickness } {3} test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} { llength [.mb configure] } {33} test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.mb configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} test menubutton-3.9 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.mb co -bg #ffffff -fg} msg] $msg } {1 {value for "-fg" missing}} test menubutton-3.10 {ButtonWidgetCmd procedure, "configure" option} { .mb configure -fg #123456 .mb configure -bg #654321 lindex [.mb configure -fg] 4 } {#123456} test menubutton-3.11 {ButtonWidgetCmd procedure, "configure" option} { list [catch {.mb foobar} msg] $msg } {1 {bad option "foobar": must be cget or configure}} # XXX Need to add tests for several procedures here. The tests for XXX # XXX ConfigureMenuButton aren't complete either. XXX test menubutton-4.1 {ConfigureMenuButton procedure} { catch {destroy .mb1} button .mb1 -text "Menubutton 1" list [catch {.mb1 configure -width 1i} msg] $msg $errorInfo } {1 {expected integer but got "1i"} {expected integer but got "1i" (processing -width option) invoked from within ".mb1 configure -width 1i"}} test menubutton-4.2 {ConfigureMenuButton procedure} { catch {destroy .mb1} button .mb1 -text "Menubutton 1" list [catch {.mb1 configure -height 0.5c} msg] $msg $errorInfo } {1 {expected integer but got "0.5c"} {expected integer but got "0.5c" (processing -height option) invoked from within ".mb1 configure -height 0.5c"}} test menubutton-4.3 {ConfigureMenuButton procedure} { catch {destroy .mb1} button .mb1 -bitmap questhead list [catch {.mb1 configure -width abc} msg] $msg $errorInfo } {1 {bad screen distance "abc"} {bad screen distance "abc" (processing -width option) invoked from within ".mb1 configure -width abc"}} test menubutton-4.4 {ConfigureMenuButton procedure} testImageType { catch {destroy .mb1} eval image delete [image names] image create test image1 button .mb1 -image image1 list [catch {.mb1 configure -height 0.5x} msg] $msg $errorInfo } {1 {bad screen distance "0.5x"} {bad screen distance "0.5x" (processing -height option) invoked from within ".mb1 configure -height 0.5x"}} test menubutton-4.5 {ConfigureMenuButton procedure} {nonPortable fonts} { catch {destroy .mb1} button .mb1 -text "Sample text" -width 10 -height 2 pack .mb1 set result "[winfo reqwidth .mb1] [winfo reqheight .mb1]" .mb1 configure -bitmap questhead lappend result [winfo reqwidth .mb1] [winfo reqheight .mb1] } {102 46 20 12} test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} { catch {destroy .mb} menubutton .mb -text "Test" list [catch {.mb configure -direction badValue} msg] $msg \ [.mb cget -direction] [destroy .mb] } {1 {bad direction "badValue": must be above, below, flush, left, or right} below {}} # XXX Need to add tests for several procedures here. XXX test menubutton-5.1 {MenuButtonEventProc procedure} { deleteWindows menubutton .mb1 -bg #543210 rename .mb1 .mb2 set x {} lappend x [winfo children .] lappend x [.mb2 cget -bg] destroy .mb1 lappend x [info command .mb*] [winfo children .] } {.mb1 #543210 {} {}} test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} { deleteWindows menubutton .mb1 rename .mb1 {} list [info command .mb*] [winfo children .] } {{} {}} test menubutton-7.1 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 4 -highlightthickness 0 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {38 23} test menubutton-7.2 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 1 -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {36 21} test menubutton-7.3 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {34 19} test menubutton-7.4 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised -width 40 \ -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {48 23} test menubutton-7.5 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised -height 30 \ -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {38 38} test menubutton-7.6 {ComputeMenuButtonGeometry procedure} { catch {destroy .mb} menubutton .mb -bitmap question -bd 2 -relief raised \ -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {25 35} test menubutton-7.7 {ComputeMenuButtonGeometry procedure} { catch {destroy .mb} menubutton .mb -bitmap question -bd 2 -relief raised -width 40 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {46 33} test menubutton-7.8 {ComputeMenuButtonGeometry procedure} { catch {destroy .mb} menubutton .mb -bitmap question -bd 2 -relief raised -height 50 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {23 56} test menubutton-7.9 {ComputeMenuButtonGeometry procedure} {fonts} { catch {destroy .mb} menubutton .mb -text String -bd 2 -relief raised -padx 0 -pady 0 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {42 20} test menubutton-7.10 {ComputeMenuButtonGeometry procedure} {fonts} { catch {destroy .mb} menubutton .mb -text String -bd 2 -relief raised -width 20 \ -padx 0 -pady 0 -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {146 20} test menubutton-7.11 {ComputeMenuButtonGeometry procedure} {fonts} { catch {destroy .mb} menubutton .mb -text String -bd 2 -relief raised -height 2 \ -padx 0 -pady 0 -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {42 34} test menubutton-7.12 {ComputeMenuButtonGeometry procedure} {fonts} { catch {destroy .mb} menubutton .mb -text String -bd 2 -relief raised -padx 10 -pady 5 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {62 30} test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {nonPortable fonts} { catch {destroy .mb} menubutton .mb -text String -bd 2 -relief raised \ -highlightthickness 1 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {78 28} test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {testImageType unix nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised \ -highlightthickness 2 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {64 23} test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {testImageType win nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised \ -highlightthickness 2 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {65 23} set l [interp hidden] deleteWindows test menubutton-8.1 {menubutton vs hidden commands} { catch {destroy .mb} menubutton .mb interp hide {} .mb destroy .mb list [winfo children .] [interp hidden] } [list {} $l] eval image delete [image names] deleteWindows option clear # cleanup cleanupTests return tk8.5.19/tests/option.file20000644003604700454610000000004212612445655014155 0ustar dgp771div*foo1: magenta foo2 missing colon tk8.5.19/tests/bind.test0000644003604700454610000025723512612445655013561 0ustar dgp771div# This file is a Tcl script to test out Tk's "bind" and "bindtags" # commands plus the procedures in tkBind.c. It is organized in the # standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands tk useinputmethods 0 catch {destroy .b} toplevel .b -width 100 -height 50 wm geom .b +0+0 update idletasks proc setup {} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 pack .b.f focus -force .b.f foreach p [event info] {event delete $p} update } proc setup2 {} { catch {destroy .b.e} entry .b.e pack .b.e focus -force .b.e foreach p [event info] {event delete $p} update } setup foreach i [bind Test] { bind Test $i {} } foreach i [bind all] { bind all $i {} } test bind-1.1 {bind command} { list [catch {bind} msg] $msg } {1 {wrong # args: should be "bind window ?pattern? ?command?"}} test bind-1.2 {bind command} { list [catch {bind a b c d} msg] $msg } {1 {wrong # args: should be "bind window ?pattern? ?command?"}} test bind-1.3 {bind command} { list [catch {bind .gorp} msg] $msg } {1 {bad window path name ".gorp"}} test bind-1.4 {bind command} { list [catch {bind foo} msg] $msg } {0 {}} test bind-1.5 {bind command} { list [catch {bind .b {}} msg] $msg } {0 {}} test bind-1.6 {bind command} { catch {destroy .b.f} frame .b.f bind .b.f {test script} set result [bind .b.f ] bind .b.f {} list $result [bind .b.f ] } {{test script} {}} test bind-1.7 {bind command} { catch {destroy .b.f} frame .b.f bind .b.f {test script} bind .b.f {+more text} bind .b.f } {test script more text} test bind-1.8 {bind command} { list [catch {bind .b {test script}} msg] $msg [bind .b] } {1 {bad event type or keysym "gorp"} {}} test bind-1.9 {bind command} { list [catch {bind .b } msg] $msg } {0 {}} test bind-1.10 {bind command} { catch {destroy .b.f} frame .b.f bind .b.f {script 1} bind .b.f {script 2} bind .b.f a {script for a} bind .b.f b {script for b} lsort [bind .b.f] } { a b} test bind-2.1 {bindtags command} { list [catch {bindtags} msg] $msg } {1 {wrong # args: should be "bindtags window ?taglist?"}} test bind-2.2 {bindtags command} { list [catch {bindtags a b c} msg] $msg } {1 {wrong # args: should be "bindtags window ?taglist?"}} test bind-2.3 {bindtags command} { list [catch {bindtags .foo} msg] $msg } {1 {bad window path name ".foo"}} test bind-2.4 {bindtags command} { bindtags .b } {.b Toplevel all} test bind-2.5 {bindtags command} { catch {destroy .b.f} frame .b.f bindtags .b.f } {.b.f Frame .b all} test bind-2.6 {bindtags command} { catch {destroy .b.f} frame .b.f bindtags .b.f {{x y z} b c d} bindtags .b.f } {{x y z} b c d} test bind-2.7 {bindtags command} { catch {destroy .b.f} frame .b.f bindtags .b.f {x y z} bindtags .b.f {} bindtags .b.f } {.b.f Frame .b all} test bind-2.8 {bindtags command} { catch {destroy .b.f} frame .b.f bindtags .b.f {x y z} bindtags .b.f {a b c d} bindtags .b.f } {a b c d} test bind-2.9 {bindtags command} { catch {destroy .b.f} frame .b.f bindtags .b.f {a b c} list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f] } {1 {unmatched open brace in list} {.b.f Frame .b all}} test bind-2.10 {bindtags command} { catch {destroy .b.f} frame .b.f bindtags .b.f {a b c} list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f] } {0 {} {a .gorp b}} test bind-3.1 {TkFreeBindingTags procedure} { catch {destroy .b.f} frame .b.f bindtags .b.f "a b c d" destroy .b.f } {} test bind-3.2 {TkFreeBindingTags procedure} { catch {destroy .b.f} frame .b.f catch {bindtags .b.f "a .gorp b .b.f"} destroy .b.f } {} bind all {lappend x "%W enter all"} bind Test {lappend x "%W enter frame"} bind Toplevel {lappend x "%W enter toplevel"} bind xyz {lappend x "%W enter xyz"} bind {a b} {lappend x "%W enter {a b}"} bind .b {lappend x "%W enter .b"} test bind-4.1 {TkBindEventProc procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 pack .b.f update bind .b.f {lappend x "%W enter .b.f"} set x {} event gen .b.f set x } {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}} test bind-4.2 {TkBindEventProc procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 pack .b.f update bind .b.f {lappend x "%W enter .b.f"} bindtags .b.f {.b.f {a b} xyz} set x {} event gen .b.f set x } {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}} test bind-4.3 {TkBindEventProc procedure} { set x {} event gen .b set x } {{.b enter .b} {.b enter toplevel} {.b enter all}} test bind-4.4 {TkBindEventProc procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 pack .b.f update bindtags .b.f {.b.f .b.f2 .b.f3} frame .b.f3 -width 50 -height 50 pack .b.f3 bind .b.f {lappend x "%W enter .b.f"} bind .b.f3 {lappend x "%W enter .b.f3"} set x {} event gen .b.f destroy .b.f3 set x } {{.b.f enter .b.f} {.b.f enter .b.f3}} test bind-4.5 {TkBindEventProc procedure} { # This tests memory allocation for objPtr; it won't serve any useful # purpose unless run with some sort of allocation checker turned on. catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 pack .b.f update bindtags .b.f {a b c d e f g h i j k l m n o p q r s t u v w x y z} event gen .b.f } {} bind all {} bind Test {} bind Toplevel {} bind xyz {} bind {a b} {} bind .b {} test bind-5.1 {Tk_CreateBindingTable procedure} { catch {destroy .b.c} canvas .b.c .b.c bind foo } {} test bind-6.1 {Tk_DeleteBindTable procedure} { catch {destroy .b.c} canvas .b.c .b.c bind foo <1> {string 1} .b.c create rectangle 0 0 100 100 .b.c bind 1 <2> {string 2} destroy .b.c } {} test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} testcbind { catch {interp delete foo} interp create foo foo eval { load {} Tk tk useinputmethods 0 load {} Tktest wm geometry . +0+0 frame .t -width 50 -height 50 bindtags .t {a b c d} pack .t update set x {} testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1" bind b <1> "lappend x b1" testcbind c <1> "lappend x c1" "lappend x bye.c1" testcbind c <2> "lappend x all2" "lappend x bye.all2" event gen .t <1> } set x [foo eval set x] interp delete foo set x } {a1 bye.all2 bye.a1 b1 bye.c1} test bind-7.1 {Tk_CreateBinding procedure: bad binding} { catch {destroy .b.c} canvas .b.c list [catch {.b.c bind foo <} msg] $msg } {1 {no event type or button # or keysym}} test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} testcbind { catch {destroy .b.f} frame .b.f testcbind .b.f <1> "xyz" "lappend x bye.1" set x {} bind .b.f <1> "abc" destroy .b.f set x } {bye.1} test bind-7.3 {Tk_CreateBinding procedure: append} { catch {destroy .b.c} canvas .b.c .b.c bind foo <1> "button 1" .b.c bind foo <1> "+more button 1" .b.c bind foo <1> } {button 1 more button 1} test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} { catch {destroy .b.c} canvas .b.c .b.c bind foo <1> "+button 1" .b.c bind foo <1> } {button 1} test bind-8.1 {TkCreateBindingProcedure: error} testcbind { list [catch {testcbind . "xyz"} msg] $msg } {1 {bad event type or keysym "xyz"}} test bind-8.2 {TkCreateBindingProcedure: new binding} testcbind { catch {destroy .b.f} frame .b.f testcbind .b.f <1> "lappend x 1" "lappend x bye.1" set x {} event gen .b.f <1> destroy .b.f set x } {bye.1} test bind-8.3 {TkCreateBindingProcedure: replace existing} testcbind { catch {destroy .b.f} frame .b.f pack .b.f set x {} testcbind .b.f <1> "lappend x old1" "lappend x bye.old1" testcbind .b.f <1> "lappend x new1" "lappend x bye.new1" set x } {bye.old1} test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} testcbind { catch {destroy .b.f} frame .b.f pack .b.f update testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}" testcbind Frame <1> "lappend x never" set x {} event gen .b.f <1> bind .b.f <1> {} set x } {.b.f Frame} test bind-9.1 {Tk_DeleteBinding procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 list [catch {bind .b.f <} msg] $msg } {0 {}} test bind-9.2 {Tk_DeleteBinding procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 foreach i {a b c d} { bind .b.f $i "binding for $i" } set result {} foreach i {b d a c} { bind .b.f $i {} lappend result [lsort [bind .b.f]] } set result } {{a c d} {a c} c {}} test bind-9.3 {Tk_DeleteBinding procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 foreach i {<1> } { bind .b.f $i "binding for $i" } set result {} foreach i { <1> } { bind .b.f $i {} lappend result [lsort [bind .b.f]] } set result } {{ } { } {}} test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} testcbind { catch {destroy .b.f} frame .b.f pack .b.f update bindtags .b.f {a b c} testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1} bind b <1> {lappend x b1} testcbind c <1> {lappend x c1} {lappend x bye.c1} testcbind c <2> {lappend x c2} {lappend x bye.c2} set x {} event gen .b.f <1> bind a <1> {} bind b <1> {} set x } {a1 bye.c2 b1 bye.c1 bye.a1} test bind-10.1 {Tk_GetBinding procedure} { catch {destroy .b.c} canvas .b.c list [catch {.b.c bind foo <} msg] $msg } {1 {no event type or button # or keysym}} test bind-10.2 {Tk_GetBinding procedure} { catch {destroy .b.c} canvas .b.c .b.c bind foo a Test .b.c bind foo a } {Test} test bind-10.3 {Tk_GetBinding procedure: C binding} testcbind { catch {destroy .b.f} frame .b.f testcbind .b.f <1> "foo" list [bind .b.f] [bind .b.f <1>] } { {}} test bind-11.1 {Tk_GetAllBindings procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 foreach i "! a \\\{ ~ <> " { bind .b.f $i Test } lsort [bind .b.f] } {! <> a \{ ~} test bind-11.2 {Tk_GetAllBindings procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 foreach i " <1>" { bind .b.f $i Test } lsort [bind .b.f] } { } test bind-11.3 {Tk_GetAllBindings procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 foreach i " abcd ab" { bind .b.f $i Test } lsort [bind .b.f] } { ab abcd} test bind-12.1 {Tk_DeleteAllBindings procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 destroy .b.f } {} test bind-12.2 {Tk_DeleteAllBindings procedure} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 foreach i "a b c " { bind .b.f $i x } destroy .b.f } {} test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} testcbind { catch {destroy .b.f} frame .b.f pack .b.f update testcbind .b.f <1> {lappend x before; event gen .b.f <2>; lappend x after} {lappend x bye.f1} testcbind .b.f <2> {destroy .b.f} {lappend x bye.f2} bind .b.f {lappend x fDestroy} testcbind .b.f <3> {foo} {lappend x bye.f3} set x {} event gen .b.f <1> set x } {before fDestroy bye.f3 bye.f2 after bye.f1} bind Test {lappend x "%W %K Test press any"} bind all {lappend x "%W %K all press any"} bind Test a {lappend x "%W %K Test press a"} bind all x {lappend x "%W %K all press x"} test bind-13.1 {Tk_BindEvent procedure} { setup bind .b.f a {lappend x "%W %K .b.f press a"} set x {} event gen .b.f event gen .b.f event gen .b.f set x } {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}} bind Test {lappend x "%W %K Test press any"; break} bind all {continue; lappend x "%W %K all press any"} test bind-13.2 {Tk_BindEvent procedure} { setup bind .b.f b {lappend x "%W %K .b.f press a"} set x {} event gen .b.f set x } {{.b.f b .b.f press a} {.b.f b Test press any}} if {[info procs bgerror] == "bgerror"} { rename bgerror {} } proc bgerror args {} bind Test {lappend x "%W %K Test press any"; error Test} test bind-13.3 {Tk_BindEvent procedure} { setup bind .b.f b {lappend x "%W %K .b.f press a"} set x {} event gen .b.f update list $x $errorInfo } {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test while executing "error Test" (command bound to event)}} rename bgerror {} test bind-13.4 {Tk_BindEvent procedure} { proc foo {} { set x 44 event gen .b.f } setup bind .b.f a {lappend x "%W %K .b.f press a"} set x {} foo set x } {{.b.f a .b.f press a} {.b.f a Test press a}} test bind-13.5 {Tk_BindEvent procedure} { bind all {lappend x "%W destroyed"} set x {} list [catch {frame .b.g -gorp foo} msg] $msg $x } {1 {unknown option "-gorp"} {{.b.g destroyed}}} foreach i [bind all] { bind all $i {} } foreach i [bind Test] { bind Test $i {} } test bind-13.6 {Tk_BindEvent procedure} { setup bind .b.f z {lappend x "%W z (.b.f binding)"} bind Test z {lappend x "%W z (.b.f binding)"} bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"} set x {} event gen .b.f bind Test z {} bind all z {} set x } {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} test bind-13.7 {Tk_BindEvent procedure} { setup bind .b.f z {lappend x "%W z (.b.f binding)"} bind Test z {lappend x "%W z (.b.f binding)"} bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"} set x {} event gen .b.f bind Test z {} bind all z {} set x } {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} test bind-13.8 {Tk_BindEvent procedure} { setup bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"} bind .b.f {lappend x "%W z (.b.f binding)"} set x {} event gen .b.f event gen .b.f set x } {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f binding)}} test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} { setup bind .b.f "lappend x Enter%#" bind .b.f "lappend x Leave%#" set x {} event gen .b.f -serial 100 -detail NotifyAncestor event gen .b.f -serial 101 -detail NotifyInferior event gen .b.f -serial 102 -detail NotifyAncestor event gen .b.f -serial 103 -detail NotifyInferior set x } {Enter100 Leave102} test bind-13.10 {Tk_BindEvent procedure: collapse Motions} { setup bind .b.f "lappend x Motion%#(%x,%y)" set x {} event gen .b.f -serial 100 -x 100 -y 200 -when tail update event gen .b.f -serial 101 -x 200 -y 300 -when tail event gen .b.f -serial 102 -x 300 -y 400 -when tail update set x } {Motion100(100,200) Motion102(300,400)} test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} { setup bind .b.f "lappend x %K%#" bind .b.f "lappend x %K%#" event gen .b.f -serial 100 -when tail event gen .b.f -serial 101 -when tail event gen .b.f -serial 102 -when tail event gen .b.f -serial 103 -when tail update } {} test bind-13.12 {Tk_BindEvent procedure: valid key detail} { setup bind .b.f "lappend x Key%K" bind .b.f "lappend x Release%K" set x {} event gen .b.f -keysym a event gen .b.f -keysym a set x } {Keya Releasea} test bind-13.13 {Tk_BindEvent procedure: invalid key detail} { setup bind .b.f "lappend x Key%K" bind .b.f "lappend x Release%K" set x {} event gen .b.f -keycode 0 event gen .b.f -keycode 0 set x } {Key?? Release??} test bind-13.14 {Tk_BindEvent procedure: button detail} { setup bind .b.f