diff options
author | wolfsuit <wolfsuit> | 2002-06-10 05:07:59 (GMT) |
---|---|---|
committer | wolfsuit <wolfsuit> | 2002-06-10 05:07:59 (GMT) |
commit | 62b2e5a6d41984327fb1459770b4c654bf2b9177 (patch) | |
tree | 5680eb6cf7f9df960a958990bd4ed6b4a8fb690d | |
parent | 2edf49a29d5a8023bfe7448370c7c85fca26de0f (diff) | |
download | tk-62b2e5a6d41984327fb1459770b4c654bf2b9177.zip tk-62b2e5a6d41984327fb1459770b4c654bf2b9177.tar.gz tk-62b2e5a6d41984327fb1459770b4c654bf2b9177.tar.bz2 |
Adding missing files from TOT merge.
-rw-r--r-- | doc/panedwindow.n | 246 | ||||
-rw-r--r-- | generic/tkPanedWindow.c | 2789 | ||||
-rw-r--r-- | library/demos/paned1.tcl | 34 | ||||
-rw-r--r-- | library/demos/paned2.tcl | 76 | ||||
-rw-r--r-- | library/panedwindow.tcl | 181 | ||||
-rw-r--r-- | mac/tkMacTclCode.r | 71 | ||||
-rw-r--r-- | tests/embed.test | 51 | ||||
-rw-r--r-- | tests/panedwindow.test | 2380 | ||||
-rw-r--r-- | win/lamp.bmp | bin | 0 -> 2102 bytes | |||
-rw-r--r-- | win/nmakehlp.c | 297 |
10 files changed, 6125 insertions, 0 deletions
diff --git a/doc/panedwindow.n b/doc/panedwindow.n new file mode 100644 index 0000000..0c6cd60 --- /dev/null +++ b/doc/panedwindow.n @@ -0,0 +1,246 @@ +'\" +'\" Copyright (c) 1992 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. +'\" +'\" RCS: @(#) $Id: panedwindow.n,v 1.1.4.1 2002/06/10 05:07:59 wolfsuit Exp $ +'\" +.so man.macros +.TH panedwindow n 8.4 Tk "Tk Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +panedwindow \- Create and manipulate panedwindow widgets +.SH SYNOPSIS +\fBpanedwindow\fR \fIpathName \fR?\fIoptions\fR? +.SO +\-background \-height \-width +\-borderwidth \-orient +\-cursor \-relief +.SE +.SH "WIDGET-SPECIFIC OPTIONS" +.OP \-handlepad handlePad HandlePad +When sash handles are drawn, specifies the distance from the top or +left end of the sash (depending on the orientation of the widget) at +which to draw the handle. May be any value accepted by \fBTk_GetPixels\fR. +.OP \-handlesize handleSize HandleSize +Specifies the side length of a sash handle. Handles are always +drawn as squares. May be any value accepted by \fBTk_GetPixels\fR. +.OP \-opaqueresize opaqueResize OpaqueResize +Specifies whether panes should be resized as a sash is moved (true), +or if resizing should be deferred until the sash is placed (false). +.OP \-sashcursor sashCursor SashCursor +Mouse cursor to use when over a sash. If null, +\fBsb_h_double_arrow\fR will be used for horizontal panedwindows, and +\fBsb_v_double_arrow\fR will be used for vertical panedwindows. +.OP \-sashpad sashPad SashPad +Specifies the amount of padding to leave of each side of a sash. May +be any value accepted by \fBTk_GetPixels\fR. +.OP \-sashrelief sashRelief SashRelief +Relief to use when drawing a sash. May be any of the standard Tk +relief values. +.OP \-sashwidth sashWidth SashWidth +Specifies the width of each sash. May be any value accepted by +\fBTk_GetPixels\fR. +.OP \-showhandle showHandle ShowHandle +Specifies whether sash handles should be shown. May be any valid Tcl +boolean value. +.BE + +.SH DESCRIPTION +.PP +The \fBpanedwindow\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a panedwindow widget. +Additional options, described above, may be specified on the command +line or in the option database to configure aspects of the panedwindow +such as its default background color and relief. The +\fBpanedwindow\fR command returns the path name of the new window. +.PP +A panedwindow widget contains any number of panes, arranged +horizontally or vertically, according to the value of the +\fB\-orient\fR option. Each pane contains one widget, and each pair of +panes is separated by a moveable (via mouse movements) sash. Moving a +sash causes the widgets on either side of the sash to be resized. + +.SH "WIDGET COMMAND" +.PP +The \fBpanedwindow\fR command creates a new Tcl command whose name is +the same as the path name of the panedwindow's window. This command +may be used to invoke various operations on the widget. It has the +following general form: +.CS +\fIpathName option \fR?\fIarg arg ...\fR? +.CE +\fIPathName\fR is the name of the command, which is the same as +the panedwindow widget's path name. \fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for panedwindow widgets: +.TP +\fIpathName \fBadd \fIwindow ?window ...? ?option value ...?\fR +Add one or more windows to the panedwindow, each in a separate pane. +The arguments consist of the names of one or more windows +followed by pairs of arguments that specify how to manage the windows. +\fIOption\fR may have any of the values accepted by the +\fBconfigure\fR subcommand. +.TP +\fIpathName \fBcget \fIoption\fR +Returns the current value of the configuration option given by +\fIoption\fR. \fIOption\fR may have any of the values accepted by the +\fBpanedwindow\fR command. +.TP +\fIpathName \fBconfigure \fI?option? ?value option value ...?\fR +Query or modify the configuration options of the widget. If no +\fIoption\fR is specified, returns a list describing all of the +available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. \fIOption\fR may have +any of the values accepted by the \fBpanedwindow\fR command. +.TP +\fIpathName \fBforget \fIwindow ?window ...?\fR +Remove the pane containing \fIwindow\fR from the panedwindow. All +geometry management options for \fIwindow\fR will be forgotten. +.TP +\fIpathName \fBidentify \fIx y\fR +Identify the panedwindow component underneath the point given by +\fIx\fR and \fIy\fR, in window coordinates. If the point is over a +sash or a sash handle, the result is a two element list containing the +index of the sash or handle, and a word indicating whether it is over +a sash or a handle, such as {0 sash} or {2 handle}. If the point is +over any other part of the panedwindow, the result is an empty list. +.TP +\fIpathName \fBproxy \fI?args?\fR +This command is used to query and change the position of the sash +proxy, used for rubberband-style pane resizing. It can take any of +the following forms: +.RS +.TP +\fIpathName \fBproxy coord\fR +Return a list containing the x and y coordinates of the most recent +proxy location. +.TP +\fIpathname \fBproxy forget\fR +Remove the proxy from the display. +.TP +\fIpathName \fBproxy place \fIx y\fR +Place the proxy at the given \fIx\fR and \fIy\fR coordinates. +.RE +.TP +\fIpathName \fBsash \fI?args?\fR +This command is used to query and change the position of sashes in the +panedwindow. It can take any of the following forms: +.RS +.TP +\fIpathName \fBsash coord \fIindex\fR +Return the current x and y coordinate pair for the sash given by +\fIindex\fR. \fIIndex\fR must be an integer between 0 and 1 less than +the number of panes in the panedwindow. The coordinates given are +those of the top left corner of the region containing the sash. +\fIpathName \fBsash dragto \fIindex x y\fR +This command computes the difference between the given coordinates and the +coordinates given to the last \fBsash coord\fR command for the given +sash. It then moves that sash the computed difference. The return +value is the empty string. +.TP +\fIpathName \fBsash mark \fIindex x y\fR +Records \fIx\fR and \fIy\fR for the sash given by \fIindex\fR; used in +conjunction with later dragto commands to move the sash. +.TP +\fIpathName \fBsash place \fIindex x y\fR +Place the sash given by \fIindex\fR at the given coordinates. +.RE +.TP +\fIpathName \fBpanecget \fIwindow option\fR +Query a management option for \fIwindow\fR. \fIOption\fR may be any +value allowed by the \fBpaneconfigure\fR subcommand. +.TP +\fIpathName \fBpaneconfigure \fIwindow ?option? ?value option value ...?\fR +Query or modify the management options for \fIwindow\fR. If no +\fIoption\fR is specified, returns a list describing all of the +available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. The following options +are supported: +.RS +.TP +\fB\-after \fIwindow\fR +Insert the window after the window specified. \fIwindow\fR should be the +name of a window already managed by \fIpathName\fR. +.TP +\fB\-before \fIwindow\fR +Insert the window before the window specified. \fIwindow\fR should be +the name of a window already managed by \fIpathName\fR. +.TP +\fB\-height \fIsize\fR +Specify a height for the window. The height will be the outer +dimension of the window including its border, if any. If \fIsize\fR +is an empty string, or if \fB\-height\fR is not specified, then the +height requested internally by the window will be used initially; the +height may later be adjusted by the movement of sashes in the +panedwindow. \fISize\fR may be any value accepted by \fBTk_GetPixels\fR. +.TP +\fB\-minsize \fIn\fR +Specifies that the size of the window cannot be made less than +\fIn\fR. This constraint only affects the size of the widget in the +paned dimension -- the x dimension for horizontal panedwindows, the y +dimension for vertical panedwindows. May be any value accepted by +\fBTk_GetPixels\fR. +.TP +\fB\-padx \fIn\fR +Specifies a non-negative value indicating how much extra space to +leave on each side of the window in the X-direction. The value may +have any of the forms accepted by \fBTk_GetPixels\fR. +.TP +\fB\-pady \fIn\fR +Specifies a non-negative value indicating how much extra space to +leave on each side of the window in the Y-direction. The value may +have any of the forms accepted by \fBTk_GetPixels\fR. +.TP +\fB\-sticky \fIstyle\fR +If a window's pane is larger than the requested dimensions of the +window, this option may be used to position (or stretch) the window +within its pane. \fIStyle\fR is a string that contains zero or more +of the characters \fBn\fP, \fBs\fP, \fBe\fP or \fBw\fP. The string +can optionally contains spaces or commas, but they are ignored. Each +letter refers to a side (north, south, east, or west) that the window +will "stick" to. If both \fBn\fP and \fBs\fP (or \fBe\fP and \fBw\fP) +are specified, the window will be stretched to fill the entire height +(or width) of its cavity. +.TP +\fB\-width \fIsize\fR +Specify a width for the window. The width will be the outer +dimension of the window including its border, if any. If \fIsize\fR +is an empty string, or if \fB\-width\fR is not specified, then the +width requested internally by the window will be used initially; the +width may later be adjusted by the movement of sashes in the +panedwindow. \fISize\fR may be any value accepted by \fBTk_GetPixels\fR. +.RE +.TP +\fIpathName \fBpanes\fR +Returns an ordered list of the widgets managed by \fIpathName\fR. + +.SH "RESIZING PANES" + +A pane is resized by grabbing the sash (or sash handle if present) and +dragging with the mouse. This is accomplished via mouse motion +bindings on the widget. When a sash is moved, the sizes of the panes +on each side of the sash, and thus the widgets in those panes, are +adjusted. +.PP +When a pane is resized from outside (eg, it is packed to expand and +fill, and the containing toplevel is resized), space is added to the final +(rightmost or bottommost) pane in the window. + +.SH KEYWORDS +panedwindow, widget, geometry management diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c new file mode 100644 index 0000000..2fd2768 --- /dev/null +++ b/generic/tkPanedWindow.c @@ -0,0 +1,2789 @@ +/* + * tkPanedWindow.c -- + * + * This module implements "paned window" widgets that are object + * based. A "paned window" is a widget that manages the geometry for + * some number of other widgets, placing a movable "sash" between them, + * which can be used to alter the relative sizes of adjacent widgets. + * + * Copyright (c) 1997 Sun Microsystems, Inc. + * Copyright (c) 2000 Ajuba Solutions. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkPanedWindow.c,v 1.3.2.1 2002/06/10 05:07:59 wolfsuit Exp $ + */ + +#include "tkPort.h" +#include "default.h" +#include "tkInt.h" + +#if ((TCL_MAJOR_VERSION > 8) || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 4)) +#define TCL_84 +#endif + +/* + * We need to have TK_OPTION_CUSTOM, et al defined to compile with any + * stubs-enable version of Tk, but we'll only allow the widget to + * be created in 8.4+. These are taken from 8.4+ tk.h. + */ +#ifndef TCL_84 + +/* + * Generating code for accessing these parts of the stub table when + * compiling against a core older than 8.4a2 is a hassle because + * we have to write up some macros hiding some very hackish pointer + * arithmetics to get at these fields. We assume that pointer to + * functions are always of the same size. + */ + +#define STUB_BASE ((char*)(&(tkStubsPtr->tk_GetAnchorFromObj))) /*field 200*/ +#define procPtrSize (sizeof(Tcl_DriverBlockModeProc *)) +#define IDX(n) (((n)-200) * procPtrSize) +#define SLOT(n) (STUB_BASE + IDX(n)) + +typedef Tk_Window (tk_CreateAnonymousWindow) _ANSI_ARGS_((Tcl_Interp * interp, + Tk_Window parent, char * screenName)); /* 241 */ +#define Tk_CreateAnonymousWindow (*((tk_CreateAnonymousWindow**) (SLOT(241)))) + +#define TK_OPTION_CUSTOM (TK_OPTION_END + 1) +typedef int (Tk_CustomOptionSetProc) _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj **value, char *widgRec, + int offset, char *saveInternalPtr, int flags)); +typedef Tcl_Obj *(Tk_CustomOptionGetProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *widgRec, int offset)); +typedef void (Tk_CustomOptionRestoreProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr, char *saveInternalPtr)); +typedef void (Tk_CustomOptionFreeProc) _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr)); + +typedef struct Tk_ObjCustomOption { + char *name; /* Name of the custom option. */ + Tk_CustomOptionSetProc *setProc; /* Function to use to set a record's + * option value from a Tcl_Obj */ + Tk_CustomOptionGetProc *getProc; /* Function to use to get a Tcl_Obj + * representation from an internal + * representation of an option. */ + Tk_CustomOptionRestoreProc *restoreProc; /* Function to use to restore a + * saved value for the internal + * representation. */ + Tk_CustomOptionFreeProc *freeProc; /* Function to use to free the internal + * representation of an option. */ + ClientData clientData; /* Arbitrary one-word value passed to + * the handling procs. */ +} Tk_ObjCustomOption; + +#endif + +/* Flag values for "sticky"ness The 16 combinations subsume the packer's + * notion of anchor and fill. + * + * STICK_NORTH This window sticks to the top of its cavity. + * STICK_EAST This window sticks to the right edge of its cavity. + * STICK_SOUTH This window sticks to the bottom of its cavity. + * STICK_WEST This window sticks to the left edge of its cavity. + */ + +#define STICK_NORTH 1 +#define STICK_EAST 2 +#define STICK_SOUTH 4 +#define STICK_WEST 8 +/* + * The following table defines the legal values for the -orient option. + */ + +static char *orientStrings[] = { + "horizontal", "vertical", (char *) NULL +}; + +enum orient { ORIENT_HORIZONTAL, ORIENT_VERTICAL }; + +typedef struct { + Tk_OptionTable pwOptions; /* Token for paned window option table. */ + Tk_OptionTable slaveOpts; /* Token for slave cget option table. */ +} OptionTables; + +/* + * One structure of the following type is kept for each window + * managed by a paned window widget. + */ + +typedef struct Slave { + Tk_Window tkwin; /* Window being managed. */ + + int minSize; /* Minimum size of this pane, on the + * relevant axis, in pixels. */ + int padx; /* Additional padding requested for + * slave, in the x dimension. */ + int pady; /* Additional padding requested for + * slave, in the y dimension. */ + Tcl_Obj *widthPtr, *heightPtr; /* Tcl_Obj rep's of slave width/height, + * to allow for null values. */ + int width; /* Slave width. */ + int height; /* Slave height. */ + int sticky; /* Sticky string. */ + int x, y; /* Coordinates of the widget. */ + int paneWidth, paneHeight; /* Pane dimensions (may be different + * from slave width/height). */ + int sashx, sashy; /* Coordinates of the sash of the + * right or bottom of this pane. */ + int markx, marky; /* Coordinates of the last mark set + * for the sash. */ + int handlex, handley; /* Coordinates of the sash handle. */ + struct PanedWindow *masterPtr; /* Paned window managing the window. */ + Tk_Window after; /* Placeholder for parsing options. */ + Tk_Window before; /* Placeholder for parsing options. */ +} Slave; + +/* + * A data structure of the following type is kept for each paned window + * widget managed by this file: + */ + +typedef struct PanedWindow { + Tk_Window tkwin; /* Window that embodies the paned window. */ + Tk_Window proxywin; /* Window for the resizing proxy. */ + Display *display; /* X's token for the window's display. */ + Tcl_Interp *interp; /* Interpreter associated with widget. */ + Tcl_Command widgetCmd; /* Token for square's widget command. */ + Tk_OptionTable optionTable; /* Token representing the configuration + * specifications. */ + Tk_OptionTable slaveOpts; /* Token for slave cget table. */ + Tk_3DBorder background; /* Background color. */ + int borderWidth; /* Value of -borderwidth option. */ + int relief; /* 3D border effect (TK_RELIEF_RAISED, etc) */ + Tcl_Obj *widthPtr; /* Tcl_Obj rep for width. */ + Tcl_Obj *heightPtr; /* Tcl_Obj rep for height. */ + int width, height; /* Width and height of the widget. */ + enum orient orient; /* Orientation of the widget. */ + Tk_Cursor cursor; /* Current cursor for window, or None. */ + int resizeOpaque; /* Boolean indicating whether resize should be + * opaque or rubberband style. */ + + int sashRelief; /* Relief used to draw sash. */ + int sashWidth; /* Width of each sash, in pixels. */ + Tcl_Obj *sashWidthPtr; /* Tcl_Obj rep for sash width. */ + int sashPad; /* Additional padding around each sash. */ + Tcl_Obj *sashPadPtr; /* Tcl_Obj rep for sash padding. */ + int showHandle; /* Boolean indicating whether sash handles + * should be drawn. */ + int handleSize; /* Size of one side of a sash handle (handles + * are square), in pixels. */ + int handlePad; /* Distance from border to draw handle. */ + Tcl_Obj *handleSizePtr; /* Tcl_Obj rep for handle size. */ + Tk_Cursor sashCursor; /* Cursor used when mouse is above a sash. */ + + GC gc; /* Graphics context for copying from + * off-screen pixmap onto screen. */ + int proxyx, proxyy; /* Proxy x,y coordinates. */ + Slave **slaves; /* Pointer to array of Slaves. */ + int numSlaves; /* Number of slaves. */ + int sizeofSlaves; /* Number of elements in the slaves array. */ + int flags; /* Flags for widget; see below. */ +} PanedWindow; + +/* + * Flags used for paned windows: + * + * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has + * been queued to redraw this window. + * + * WIDGET_DELETED: Non-zero means that the paned window has + * been, or is in the process of being, deleted. + */ + +#define REDRAW_PENDING 0x0001 +#define WIDGET_DELETED 0x0002 +#define REQUESTED_RELAYOUT 0x0004 +#define RECOMPUTE_GEOMETRY 0x0008 +#define PROXY_REDRAW_PENDING 0x0010 +/* + * Forward declarations for procedures defined later in this file: + */ + +int Tk_PanedWindowObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); +static void PanedWindowCmdDeletedProc _ANSI_ARGS_((ClientData clientData)); +static int ConfigurePanedWindow _ANSI_ARGS_((Tcl_Interp *interp, + PanedWindow *pwPtr, int objc, Tcl_Obj *CONST objv[])); +static void DestroyPanedWindow _ANSI_ARGS_((PanedWindow *pwPtr)); +static void DisplayPanedWindow _ANSI_ARGS_((ClientData clientData)); +static void PanedWindowEventProc _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); +static void ProxyWindowEventProc _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); +static void DisplayProxyWindow _ANSI_ARGS_((ClientData clientData)); +void PanedWindowWorldChanged _ANSI_ARGS_((ClientData instanceData)); +static int PanedWindowWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *, int objc, Tcl_Obj * CONST objv[])); +static void PanedWindowLostSlaveProc _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin)); +static void PanedWindowReqProc _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin)); +static void ArrangePanes _ANSI_ARGS_((ClientData clientData)); +static void Unlink _ANSI_ARGS_((Slave *slavePtr)); +static Slave * GetPane _ANSI_ARGS_((PanedWindow *pwPtr, Tk_Window tkwin)); +static void SlaveStructureProc _ANSI_ARGS_((ClientData clientData, + XEvent *eventPtr)); +static int PanedWindowSashCommand _ANSI_ARGS_((PanedWindow *pwPtr, + Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); +static int PanedWindowProxyCommand _ANSI_ARGS_((PanedWindow *pwPtr, + Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); +static void ComputeGeometry _ANSI_ARGS_((PanedWindow *pwPtr)); +static int ConfigureSlaves _ANSI_ARGS_((PanedWindow *pwPtr, + Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); +static void DestroyOptionTables _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp)); +static int SetSticky _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, Tk_Window tkwin, + Tcl_Obj **value, char *recordPtr, int internalOffset, + char *oldInternalPtr, int flags)); +static Tcl_Obj *GetSticky _ANSI_ARGS_((ClientData clientData, Tk_Window tkwin, + char *recordPtr, int internalOffset)); +static void RestoreSticky _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin, char *internalPtr, + char *oldInternalPtr)); +static void AdjustForSticky _ANSI_ARGS_((int sticky, int cavityWidth, + int cavityHeight, int *xPtr, int *yPtr, + int *slaveWidthPtr, int *slaveHeightPtr)); +static void MoveSash _ANSI_ARGS_((PanedWindow *pwPtr, int sash, int diff)); +static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr)); +static char * ComputeSlotAddress _ANSI_ARGS_((char *recordPtr, int offset)); +static int PanedWindowIdentifyCoords _ANSI_ARGS_((PanedWindow *pwPtr, + Tcl_Interp *interp, int x, int y)); + +static Tk_GeomMgr panedWindowMgrType = { + "panedwindow", /* name */ + PanedWindowReqProc, /* requestProc */ + PanedWindowLostSlaveProc, /* lostSlaveProc */ +}; + +/* + * Information used for objv parsing. + */ + +#define GEOMETRY 0x0001 + +/* + * The following structure contains pointers to functions used for processing + * the custom "-sticky" option for slave windows. + */ + +static Tk_ObjCustomOption stickyOption = { + "sticky", /* name */ + SetSticky, /* setProc */ + GetSticky, /* getProc */ + RestoreSticky, /* restoreProc */ + (Tk_CustomOptionFreeProc *)NULL, /* freeProc */ + 0 +}; + +static Tk_OptionSpec optionSpecs[] = { + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_PANEDWINDOW_BG_COLOR, -1, Tk_Offset(PanedWindow, background), 0, + (ClientData) DEF_PANEDWINDOW_BG_MONO}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background"}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_PANEDWINDOW_BORDERWIDTH, -1, Tk_Offset(PanedWindow, borderWidth), + 0, 0, GEOMETRY}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_PANEDWINDOW_CURSOR, -1, Tk_Offset(PanedWindow, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-handlepad", "handlePad", "HandlePad", + DEF_PANEDWINDOW_HANDLEPAD, -1, Tk_Offset(PanedWindow, handlePad), + 0, 0}, + {TK_OPTION_PIXELS, "-handlesize", "handleSize", "HandleSize", + DEF_PANEDWINDOW_HANDLESIZE, Tk_Offset(PanedWindow, handleSizePtr), + Tk_Offset(PanedWindow, handleSize), 0, 0, GEOMETRY}, + {TK_OPTION_PIXELS, "-height", "height", "Height", + DEF_PANEDWINDOW_HEIGHT, Tk_Offset(PanedWindow, heightPtr), + Tk_Offset(PanedWindow, height), TK_OPTION_NULL_OK, 0, GEOMETRY}, + {TK_OPTION_BOOLEAN, "-opaqueresize", "opaqueResize", "OpaqueResize", + DEF_PANEDWINDOW_OPAQUERESIZE, -1, + Tk_Offset(PanedWindow, resizeOpaque), 0, 0, 0}, + {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", + DEF_PANEDWINDOW_ORIENT, -1, Tk_Offset(PanedWindow, orient), + 0, (ClientData) orientStrings, GEOMETRY}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_PANEDWINDOW_RELIEF, -1, Tk_Offset(PanedWindow, relief), 0, 0, 0}, + {TK_OPTION_CURSOR, "-sashcursor", "sashCursor", "Cursor", + DEF_PANEDWINDOW_SASHCURSOR, -1, Tk_Offset(PanedWindow, sashCursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-sashpad", "sashPad", "SashPad", + DEF_PANEDWINDOW_SASHPAD, -1, Tk_Offset(PanedWindow, sashPad), + 0, 0, GEOMETRY}, + {TK_OPTION_RELIEF, "-sashrelief", "sashRelief", "Relief", + DEF_PANEDWINDOW_SASHRELIEF, -1, Tk_Offset(PanedWindow, sashRelief), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-sashwidth", "sashWidth", "Width", + DEF_PANEDWINDOW_SASHWIDTH, Tk_Offset(PanedWindow, sashWidthPtr), + Tk_Offset(PanedWindow, sashWidth), 0, 0, GEOMETRY}, + {TK_OPTION_BOOLEAN, "-showhandle", "showHandle", "ShowHandle", + DEF_PANEDWINDOW_SHOWHANDLE, -1, Tk_Offset(PanedWindow, showHandle), + 0, 0, GEOMETRY}, + {TK_OPTION_PIXELS, "-width", "width", "Width", + DEF_PANEDWINDOW_WIDTH, Tk_Offset(PanedWindow, widthPtr), + Tk_Offset(PanedWindow, width), TK_OPTION_NULL_OK, 0, GEOMETRY}, + {TK_OPTION_END} +}; + +static Tk_OptionSpec slaveOptionSpecs[] = { + {TK_OPTION_WINDOW, "-after", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_AFTER, -1, Tk_Offset(Slave, after), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_WINDOW, "-before", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_BEFORE, -1, Tk_Offset(Slave, before), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-height", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_HEIGHT, Tk_Offset(Slave, heightPtr), + Tk_Offset(Slave, height), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-minsize", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_MINSIZE, -1, Tk_Offset(Slave, minSize), 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_PADX, -1, Tk_Offset(Slave, padx), 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_PADY, -1, Tk_Offset(Slave, pady), 0, 0, 0}, + {TK_OPTION_CUSTOM, "-sticky", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_STICKY, -1, Tk_Offset(Slave, sticky), 0, + (ClientData) &stickyOption, 0}, + {TK_OPTION_PIXELS, "-width", (char *) NULL, (char *) NULL, + DEF_PANEDWINDOW_PANE_WIDTH, Tk_Offset(Slave, widthPtr), + Tk_Offset(Slave, width), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_END} +}; + + +/* + *-------------------------------------------------------------- + * + * Tk_PanedWindowObjCmd -- + * + * This procedure is invoked to process the "panedwindow" Tcl + * command. It creates a new "panedwindow" widget. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A new widget is created and configured. + * + *-------------------------------------------------------------- + */ + +int +Tk_PanedWindowObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* NULL. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj * CONST objv[]; /* Argument objects. */ +{ + PanedWindow *pwPtr; + Tk_Window tkwin, parent; + OptionTables *pwOpts; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + return TCL_ERROR; + } + + tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), + Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + + pwOpts = (OptionTables *) + Tcl_GetAssocData(interp, "PanedWindowOptionTables", NULL); + if (pwOpts == NULL) { + /* + * The first time this procedure is invoked, the option tables will + * be NULL. We then create the option tables from the templates + * and store a pointer to the tables as the command's clinical so + * we'll have easy access to it in the future. + */ + pwOpts = (OptionTables *) ckalloc(sizeof(OptionTables)); + /* Set up an exit handler to free the optionTables struct */ + Tcl_SetAssocData(interp, "PanedWindowOptionTables", + DestroyOptionTables, (ClientData) pwOpts); + + /* Create the paned window option tables. */ + pwOpts->pwOptions = Tk_CreateOptionTable(interp, optionSpecs); + pwOpts->slaveOpts = Tk_CreateOptionTable(interp, slaveOptionSpecs); + } + + Tk_SetClass(tkwin, "PanedWindow"); + + /* + * Allocate and initialize the widget record. + */ + + pwPtr = (PanedWindow *) ckalloc(sizeof(PanedWindow)); + memset((void *)pwPtr, 0, (sizeof(PanedWindow))); + pwPtr->tkwin = tkwin; + pwPtr->display = Tk_Display(tkwin); + pwPtr->interp = interp; + pwPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(pwPtr->tkwin), PanedWindowWidgetObjCmd, + (ClientData) pwPtr, PanedWindowCmdDeletedProc); + pwPtr->optionTable = pwOpts->pwOptions; + pwPtr->slaveOpts = pwOpts->slaveOpts; + pwPtr->relief = TK_RELIEF_RAISED; + pwPtr->gc = None; + pwPtr->cursor = None; + pwPtr->sashCursor = None; + + if (Tk_InitOptions(interp, (char *) pwPtr, pwOpts->pwOptions, + tkwin) != TCL_OK) { + Tk_DestroyWindow(pwPtr->tkwin); + ckfree((char *) pwPtr); + return TCL_ERROR; + } + + Tk_CreateEventHandler(pwPtr->tkwin, ExposureMask|StructureNotifyMask, + PanedWindowEventProc, (ClientData) pwPtr); + + /* + * Find the toplevel ancestor of the panedwindow, and make a proxy + * win as a child of that window; this way the proxy can always float + * above slaves in the panedwindow. + */ + parent = Tk_Parent(pwPtr->tkwin); + while (!(Tk_IsTopLevel(parent))) { + parent = Tk_Parent(parent); + if (parent == NULL) { + parent = pwPtr->tkwin; + break; + } + } + + pwPtr->proxywin = Tk_CreateAnonymousWindow(interp, parent, (char *) NULL); + Tk_CreateEventHandler(pwPtr->proxywin, ExposureMask, ProxyWindowEventProc, + (ClientData) pwPtr); + + if (ConfigurePanedWindow(interp, pwPtr, objc - 2, objv + 2) != TCL_OK) { + Tk_DestroyWindow(pwPtr->tkwin); + Tk_DestroyWindow(pwPtr->proxywin); + ckfree((char *) pwPtr); + return TCL_ERROR; + } + + Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(pwPtr->tkwin), -1); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * PanedWindowWidgetObjCmd -- + * + * This procedure is invoked to process the Tcl command + * that corresponds to a widget managed by this module. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + +static int +PanedWindowWidgetObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Information about square widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj * CONST objv[]; /* Argument objects. */ +{ + PanedWindow *pwPtr = (PanedWindow *) clientData; + int result = TCL_OK; + static CONST char *optionStrings[] = {"add", "cget", "configure", "forget", + "identify", "panecget", + "paneconfigure", "panes", + "proxy", "sash", (char *) NULL}; + enum options { PW_ADD, PW_CGET, PW_CONFIGURE, PW_FORGET, PW_IDENTIFY, + PW_PANECGET, PW_PANECONFIGURE, PW_PANES, PW_PROXY, + PW_SASH }; + Tcl_Obj *resultObj; + int index, count, i, x, y; + Tk_Window tkwin; + Slave *slavePtr; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "command", + 0, &index) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_Preserve((ClientData) pwPtr); + + switch ((enum options) index) { + case PW_ADD: { + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "widget ?widget ...?"); + result = TCL_ERROR; + break; + } + + result = ConfigureSlaves(pwPtr, interp, objc, objv); + break; + } + + case PW_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); + result = TCL_ERROR; + break; + } + resultObj = Tk_GetOptionValue(interp, (char *) pwPtr, + pwPtr->optionTable, objv[2], pwPtr->tkwin); + if (resultObj == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObj); + } + break; + } + + case PW_CONFIGURE: { + resultObj = NULL; + if (objc <= 3) { + resultObj = Tk_GetOptionInfo(interp, (char *) pwPtr, + pwPtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + pwPtr->tkwin); + if (resultObj == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObj); + } + } else { + result = ConfigurePanedWindow(interp, pwPtr, objc - 2, + objv + 2); + } + break; + } + + case PW_FORGET: { + Tk_Window slave; + int i; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "widget ?widget ...?"); + result = TCL_ERROR; + break; + } + + /* + * Clean up each window named in the arg list. + */ + for (count = 0, i = 2; i < objc; i++) { + slave = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), + pwPtr->tkwin); + if (slave == NULL) { + continue; + } + slavePtr = GetPane(pwPtr, slave); + if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) { + count++; + Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL, + (ClientData) NULL); + Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin); + Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask, + SlaveStructureProc, (ClientData) slavePtr); + Tk_UnmapWindow(slavePtr->tkwin); + Unlink(slavePtr); + } + if (count != 0) { + ComputeGeometry(pwPtr); + } + } + break; + } + + case PW_IDENTIFY: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "x y"); + result = TCL_ERROR; + break; + } + + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { + result = TCL_ERROR; + break; + } + + result = PanedWindowIdentifyCoords(pwPtr, interp, x, y); + break; + } + + case PW_PANECGET: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "pane option"); + result = TCL_ERROR; + break; + } + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), + pwPtr->tkwin); + if (tkwin == NULL) { + result = TCL_ERROR; + break; + } + resultObj = NULL; + for (i = 0; i < pwPtr->numSlaves; i++) { + if (pwPtr->slaves[i]->tkwin == tkwin) { + resultObj = Tk_GetOptionValue(interp, + (char *) pwPtr->slaves[i], pwPtr->slaveOpts, + objv[3], tkwin); + } + } + if (i == pwPtr->numSlaves) { + Tcl_SetResult(interp, "not managed by this window", + TCL_STATIC); + } + if (resultObj == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObj); + } + break; + } + + case PW_PANECONFIGURE: { + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, + "pane ?option? ?value option value ...?"); + result = TCL_ERROR; + break; + } + resultObj = NULL; + if (objc <= 4) { + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), + pwPtr->tkwin); + for (i = 0; i < pwPtr->numSlaves; i++) { + if (pwPtr->slaves[i]->tkwin == tkwin) { + resultObj = Tk_GetOptionInfo(interp, + (char *) pwPtr->slaves[i], + pwPtr->slaveOpts, + (objc == 4) ? objv[3] : (Tcl_Obj *) NULL, + pwPtr->tkwin); + if (resultObj == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObj); + } + break; + } + } + } else { + result = ConfigureSlaves(pwPtr, interp, objc, objv); + } + break; + } + + case PW_PANES: { + resultObj = Tcl_NewObj(); + + Tcl_IncrRefCount(resultObj); + + for (i = 0; i < pwPtr->numSlaves; i++) { + Tcl_ListObjAppendElement(interp, resultObj, + Tcl_NewStringObj(Tk_PathName(pwPtr->slaves[i]->tkwin), + -1)); + } + Tcl_SetObjResult(interp, resultObj); + Tcl_DecrRefCount(resultObj); + break; + } + + case PW_PROXY: { + result = PanedWindowProxyCommand(pwPtr, interp, objc, objv); + break; + } + + case PW_SASH: { + result = PanedWindowSashCommand(pwPtr, interp, objc, objv); + break; + } + } + Tcl_Release((ClientData) pwPtr); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureSlaves -- + * + * Add or alter the configuration options of a slave in a paned + * window. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Depends on options; may add a slave to the paned window, may + * alter the geometry management options of a slave. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureSlaves(pwPtr, interp, objc, objv) + PanedWindow *pwPtr; /* Information about paned window. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj * CONST objv[]; /* Argument objects. */ +{ + int i, firstOptionArg, j, found, doubleBw, index, numNewSlaves, haveLoc; + int insertIndex; + Tk_Window tkwin = NULL, ancestor, parent; + Slave *slavePtr, **inserts, **new; + Slave options; + char *arg; + + /* + * Find the non-window name arguments; these are the configure options + * for the slaves. Also validate that the window names given are + * legitimate (ie, they are real windows, they are not the panedwindow + * itself, etc.). + */ + for (i = 2; i < objc; i++) { + arg = Tcl_GetString(objv[i]); + if (arg[0] == '-') { + break; + } else { + tkwin = Tk_NameToWindow(interp, arg, pwPtr->tkwin); + if (tkwin == NULL) { + /* + * Just a plain old bad window; Tk_NameToWindow filled in an + * error message for us. + */ + return TCL_ERROR; + } else if (tkwin == pwPtr->tkwin) { + /* + * A panedwindow cannot manage itself. + */ + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "can't add ", arg, " to itself", + (char *) NULL); + return TCL_ERROR; + } else if (Tk_IsTopLevel(tkwin)) { + /* + * A panedwindow cannot manage a toplevel. + */ + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "can't add toplevel ", arg, " to ", + Tk_PathName(pwPtr->tkwin), (char *) NULL); + return TCL_ERROR; + } else { + /* + * Make sure the panedwindow is the parent of the slave, + * or a descendant of the slave's parent. + */ + parent = Tk_Parent(tkwin); + for (ancestor = pwPtr->tkwin;;ancestor = Tk_Parent(ancestor)) { + if (ancestor == parent) { + break; + } + if (Tk_IsTopLevel(ancestor)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "can't add ", arg, + " to ", Tk_PathName(pwPtr->tkwin), + (char *) NULL); + return TCL_ERROR; + } + } + } + } + } + firstOptionArg = i; + + /* + * Pre-parse the configuration options, to get the before/after specifiers + * into an easy-to-find location (a local variable). Also, check the + * return from Tk_SetOptions once, here, so we can save a little bit of + * extra testing in the for loop below. + */ + memset((void *)&options, 0, sizeof(Slave)); + if (Tk_SetOptions(interp, (char *) &options, pwPtr->slaveOpts, + objc - firstOptionArg, objv + firstOptionArg, + pwPtr->tkwin, NULL, NULL) != TCL_OK) { + return TCL_ERROR; + } + + /* + * If either -after or -before was given, find the numerical index that + * corresponds to the given window. If both -after and -before are + * given, the option precedence is: -after, then -before. + */ + index = -1; + haveLoc = 0; + if (options.after != None) { + tkwin = options.after; + haveLoc = 1; + for (i = 0; i < pwPtr->numSlaves; i++) { + if (options.after == pwPtr->slaves[i]->tkwin) { + index = i + 1; + break; + } + } + } else if (options.before != None) { + tkwin = options.before; + haveLoc = 1; + for (i = 0; i < pwPtr->numSlaves; i++) { + if (options.before == pwPtr->slaves[i]->tkwin) { + index = i; + break; + } + } + } + + /* + * If a window was given for -after/-before, but it's not a window + * managed by the panedwindow, throw an error + */ + if (haveLoc && index == -1) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "window \"", Tk_PathName(tkwin), + "\" is not managed by ", Tk_PathName(pwPtr->tkwin), + (char *) NULL); + Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, + pwPtr->tkwin); + return TCL_ERROR; + } + + /* + * Allocate an array to hold, in order, the pointers to the slave + * structures corresponding to the windows specified. Some of those + * structures may already have existed, some may be new. + */ + inserts = (Slave **)ckalloc(sizeof(Slave *) * (firstOptionArg - 2)); + insertIndex = 0; + + /* + * Populate the inserts array, creating new slave structures as necessary, + * applying the options to each structure as we go, and, if necessary, + * marking the spot in the original slaves array as empty (for pre-existing + * slave structures). + */ + for (i = 0, numNewSlaves = 0; i < firstOptionArg - 2; i++) { + /* + * We don't check that tkwin is NULL here, because the pre-pass above + * guarantees that the input at this stage is good. + */ + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i + 2]), + pwPtr->tkwin); + + found = 0; + for (j = 0; j < pwPtr->numSlaves; j++) { + if (pwPtr->slaves[j] != NULL && pwPtr->slaves[j]->tkwin == tkwin) { + Tk_SetOptions(interp, (char *) pwPtr->slaves[j], + pwPtr->slaveOpts, objc - firstOptionArg, + objv + firstOptionArg, pwPtr->tkwin, NULL, NULL); + found = 1; + + /* + * If the slave is supposed to move, add it to the inserts + * array now; otherwise, leave it where it is. + */ + + if (index != -1) { + inserts[insertIndex++] = pwPtr->slaves[j]; + pwPtr->slaves[j] = NULL; + } + break; + } + } + + if (found) { + continue; + } + + /* + * Make sure this slave wasn't already put into the inserts array, + * ie, when the user specifies the same window multiple times in + * a single add commaned. + */ + for (j = 0; j < insertIndex; j++) { + if (inserts[j]->tkwin == tkwin) { + found = 1; + break; + } + } + if (found) { + continue; + } + + /* + * Create a new slave structure and initialize it. All slaves + * start out with their "natural" dimensions. + */ + + slavePtr = (Slave *) ckalloc(sizeof(Slave)); + memset(slavePtr, 0, sizeof(Slave)); + Tk_InitOptions(interp, (char *)slavePtr, pwPtr->slaveOpts, + pwPtr->tkwin); + Tk_SetOptions(interp, (char *)slavePtr, pwPtr->slaveOpts, + objc - firstOptionArg, objv + firstOptionArg, + pwPtr->tkwin, NULL, NULL); + slavePtr->tkwin = tkwin; + slavePtr->masterPtr = pwPtr; + doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width; + if (slavePtr->width > 0) { + slavePtr->paneWidth = slavePtr->width; + } else { + slavePtr->paneWidth = Tk_ReqWidth(tkwin) + doubleBw; + } + if (slavePtr->height > 0) { + slavePtr->paneHeight = slavePtr->height; + } else { + slavePtr->paneHeight = Tk_ReqHeight(tkwin) + doubleBw; + } + + /* + * Set up the geometry management callbacks for this slave. + */ + + Tk_CreateEventHandler(slavePtr->tkwin, StructureNotifyMask, + SlaveStructureProc, (ClientData) slavePtr); + Tk_ManageGeometry(slavePtr->tkwin, &panedWindowMgrType, + (ClientData) slavePtr); + inserts[insertIndex++] = slavePtr; + numNewSlaves++; + } + + /* + * Allocate the new slaves array, then copy the slaves into it, in + * order. + */ + i = sizeof(Slave *) * (pwPtr->numSlaves+numNewSlaves); + new = (Slave **)ckalloc((unsigned) i); + memset(new, 0, (size_t) i); + if (index == -1) { + /* + * If none of the existing slaves have to be moved, just copy the old + * and append the new. + */ + memcpy((void *)&(new[0]), pwPtr->slaves, + sizeof(Slave *) * pwPtr->numSlaves); + memcpy((void *)&(new[pwPtr->numSlaves]), inserts, + sizeof(Slave *) * numNewSlaves); + } else { + /* + * If some of the existing slaves were moved, the old slaves array + * will be partially populated, with some valid and some invalid + * entries. Walk through it, copying valid entries to the new slaves + * array as we go; when we get to the insert location for the new + * slaves, copy the inserts array over, then finish off the old slaves + * array. + */ + for (i = 0, j = 0; i < index; i++) { + if (pwPtr->slaves[i] != NULL) { + new[j] = pwPtr->slaves[i]; + j++; + } + } + + memcpy((void *)&(new[j]), inserts, sizeof(Slave *) * (insertIndex)); + j += firstOptionArg - 2; + + for (i = index; i < pwPtr->numSlaves; i++) { + if (pwPtr->slaves[i] != NULL) { + new[j] = pwPtr->slaves[i]; + j++; + } + } + } + + /* + * Make the new slaves array the paned window's slave array, and clean up. + */ + ckfree((void *)pwPtr->slaves); + ckfree((void *)inserts); + pwPtr->slaves = new; + + /* + * Set the paned window's slave count to the new value. + */ + pwPtr->numSlaves += numNewSlaves; + + Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, pwPtr->tkwin); + + ComputeGeometry(pwPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * PanedWindowSashCommand -- + * + * Implementation of the panedwindow sash subcommand. See the user + * documentation for details on what it does. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Depends on the arguments. + * + *---------------------------------------------------------------------- + */ + +static int +PanedWindowSashCommand(pwPtr, interp, objc, objv) + PanedWindow *pwPtr; /* Pointer to paned window information. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj * CONST objv[]; /* Argument objects. */ +{ + static CONST char *sashOptionStrings[] = { "coord", "dragto", "mark", + "place", (char *) NULL }; + enum sashOptions { SASH_COORD, SASH_DRAGTO, SASH_MARK, SASH_PLACE }; + int index, sash, x, y, diff; + Tcl_Obj *coords[2]; + Slave *slavePtr; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], sashOptionStrings, + "option", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_ResetResult(interp); + switch ((enum sashOptions) index) { + case SASH_COORD: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index"); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) { + return TCL_ERROR; + } + + if (sash >= pwPtr->numSlaves - 1) { + Tcl_ResetResult(interp); + Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + return TCL_ERROR; + } + slavePtr = pwPtr->slaves[sash]; + + coords[0] = Tcl_NewIntObj(slavePtr->sashx); + coords[1] = Tcl_NewIntObj(slavePtr->sashy); + Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords); + break; + } + + case SASH_MARK: { + if (objc != 6 && objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index ?x y?"); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) { + return TCL_ERROR; + } + + if (sash >= pwPtr->numSlaves - 1) { + Tcl_ResetResult(interp); + Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + return TCL_ERROR; + } + + if (objc == 6) { + if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK) { + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK) { + return TCL_ERROR; + } + + pwPtr->slaves[sash]->markx = x; + pwPtr->slaves[sash]->marky = y; + } else { + coords[0] = Tcl_NewIntObj(pwPtr->slaves[sash]->markx); + coords[1] = Tcl_NewIntObj(pwPtr->slaves[sash]->marky); + Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords); + } + + break; + } + + case SASH_DRAGTO: + case SASH_PLACE: { + if (objc != 6) { + Tcl_WrongNumArgs(interp, 3, objv, "index x y"); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) { + return TCL_ERROR; + } + + if (sash >= pwPtr->numSlaves - 1) { + Tcl_ResetResult(interp); + Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK) { + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK) { + return TCL_ERROR; + } + + slavePtr = pwPtr->slaves[sash]; + if (pwPtr->orient == ORIENT_HORIZONTAL) { + if (index == SASH_PLACE) { + diff = x - pwPtr->slaves[sash]->sashx; + } else { + diff = x - pwPtr->slaves[sash]->markx; + } + } else { + if (index == SASH_PLACE) { + diff = y - pwPtr->slaves[sash]->sashy; + } else { + diff = y - pwPtr->slaves[sash]->marky; + } + } + + MoveSash(pwPtr, sash, diff); + ComputeGeometry(pwPtr); + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ConfigurePanedWindow -- + * + * This procedure is called to process an argv/argc list in + * conjunction with the Tk option database to configure (or + * reconfigure) a paned window widget. + * + * Results: + * The return value is a standard Tcl result. If TCL_ERROR is + * returned, then the interp's result contains an error message. + * + * Side effects: + * Configuration information, such as colors, border width, + * etc. get set for pwPtr; old resources get freed, + * if there were any. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigurePanedWindow(interp, pwPtr, objc, objv) + Tcl_Interp *interp; /* Used for error reporting. */ + PanedWindow *pwPtr; /* Information about widget. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument values. */ +{ + Tk_SavedOptions savedOptions; + int typemask = 0; + + if (Tk_SetOptions(interp, (char *) pwPtr, pwPtr->optionTable, objc, objv, + pwPtr->tkwin, &savedOptions, &typemask) != TCL_OK) { + Tk_RestoreSavedOptions(&savedOptions); + return TCL_ERROR; + } + + Tk_FreeSavedOptions(&savedOptions); + + PanedWindowWorldChanged((ClientData) pwPtr); + + /* + * If an option that affects geometry has changed, make a relayout + * request. + */ + + if (typemask & GEOMETRY) { + ComputeGeometry(pwPtr); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * PanedWindowWorldChanged -- + * + * This procedure is invoked anytime a paned window's world has + * changed in some way that causes the widget to have to recompute + * graphics contexts and geometry. + * + * Results: + * None. + * + * Side effects: + * Paned window will be relayed out and redisplayed. + * + *---------------------------------------------------------------------- + */ + +void +PanedWindowWorldChanged(instanceData) + ClientData instanceData; /* Information about the paned window. */ +{ + XGCValues gcValues; + GC newGC; + PanedWindow *pwPtr = (PanedWindow *) instanceData; + + /* + * Allocated a graphics context for drawing the paned window widget + * elements (background, sashes, etc.). + */ + + gcValues.background = Tk_3DBorderColor(pwPtr->background)->pixel; + newGC = Tk_GetGC(pwPtr->tkwin, GCBackground, &gcValues); + if (pwPtr->gc != None) { + Tk_FreeGC(pwPtr->display, pwPtr->gc); + } + pwPtr->gc = newGC; + + /* + * Issue geometry size requests to Tk. + */ + + Tk_SetInternalBorder(pwPtr->tkwin, pwPtr->borderWidth); + if (pwPtr->width > 0 || pwPtr->height > 0) { + Tk_GeometryRequest(pwPtr->tkwin, pwPtr->width, pwPtr->height); + } + + /* + * Arrange for the window to be redrawn, if neccessary. + */ + + if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) { + Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + pwPtr->flags |= REDRAW_PENDING; + } +} + +/* + *-------------------------------------------------------------- + * + * PanedWindowEventProc -- + * + * This procedure is invoked by the Tk dispatcher for various + * events on paned windows. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +PanedWindowEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + XEvent *eventPtr; /* Information about event. */ +{ + PanedWindow *pwPtr = (PanedWindow *) clientData; + + if (eventPtr->type == Expose) { + if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) { + Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + pwPtr->flags |= REDRAW_PENDING; + } + } else if (eventPtr->type == ConfigureNotify) { + pwPtr->flags |= REQUESTED_RELAYOUT; + if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) { + Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + pwPtr->flags |= REDRAW_PENDING; + } + } else if (eventPtr->type == DestroyNotify) { + DestroyPanedWindow(pwPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * PanedWindowCmdDeletedProc -- + * + * This procedure is invoked when a widget command is deleted. If + * the widget isn't already in the process of being destroyed, + * this command destroys it. + * + * Results: + * None. + * + * Side effects: + * The widget is destroyed. + * + *---------------------------------------------------------------------- + */ + +static void +PanedWindowCmdDeletedProc(clientData) + ClientData clientData; /* Pointer to widget record for widget. */ +{ + PanedWindow *pwPtr = (PanedWindow *) clientData; + + /* + * This procedure could be invoked either because the window was + * destroyed and the command was then deleted or because the command was + * deleted, and then this procedure destroys the widget. The + * WIDGET_DELETED flag distinguishes these cases. + */ + + if (!(pwPtr->flags & WIDGET_DELETED)) { + Tk_DestroyWindow(pwPtr->tkwin); + Tk_DestroyWindow(pwPtr->proxywin); + } +} + +/* + *-------------------------------------------------------------- + * + * DisplayPanedWindow -- + * + * This procedure redraws the contents of a paned window widget. + * 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. + * + *-------------------------------------------------------------- + */ + +static void +DisplayPanedWindow(clientData) + ClientData clientData; /* Information about window. */ +{ + PanedWindow *pwPtr = (PanedWindow *) clientData; + Pixmap pixmap; + Tk_Window tkwin = pwPtr->tkwin; + int i, sashWidth, sashHeight; + + pwPtr->flags &= ~REDRAW_PENDING; + if ((pwPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) { + return; + } + + if (pwPtr->flags & REQUESTED_RELAYOUT) { + ArrangePanes(clientData); + } + + /* + * Create a pixmap for double-buffering, if necessary. + */ + + pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin), + Tk_Width(tkwin), Tk_Height(tkwin), + DefaultDepthOfScreen(Tk_Screen(tkwin))); + + /* + * Redraw the widget's background and border. + */ + Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), pwPtr->borderWidth, + pwPtr->relief); + + /* + * Set up boilerplate geometry values for sashes (width, height, common + * coordinates). + */ + + if (pwPtr->orient == ORIENT_HORIZONTAL) { + sashHeight = Tk_Height(tkwin) - (2 * Tk_InternalBorderWidth(tkwin)); + sashWidth = pwPtr->sashWidth; + } else { + sashWidth = Tk_Width(tkwin) - (2 * Tk_InternalBorderWidth(tkwin)); + sashHeight = pwPtr->sashWidth; + } + + /* + * Draw the sashes. + */ + for (i = 0; i < pwPtr->numSlaves - 1; i++) { + Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, + pwPtr->slaves[i]->sashx, pwPtr->slaves[i]->sashy, + sashWidth, sashHeight, 1, pwPtr->sashRelief); + + if (pwPtr->showHandle) { + Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, + pwPtr->slaves[i]->handlex, pwPtr->slaves[i]->handley, + pwPtr->handleSize, pwPtr->handleSize, 1, + TK_RELIEF_RAISED); + } + } + + /* + * Copy the information from the off-screen pixmap onto the screen, + * then delete the pixmap. + */ + + XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin), pwPtr->gc, + 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), + 0, 0); + Tk_FreePixmap(Tk_Display(tkwin), pixmap); +} + +/* + *---------------------------------------------------------------------- + * + * DestroyPanedWindow -- + * + * This procedure is invoked by PanedWindowEventProc to free the + * internal structure of a paned window. + * + * Results: + * None. + * + * Side effects: + * Everything associated with the paned window is freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyPanedWindow(pwPtr) + PanedWindow *pwPtr; /* Info about paned window widget. */ +{ + int i; + + /* + * First mark the widget as in the process of being deleted, + * so that any code that causes calls to other paned window procedures + * will abort. + */ + + pwPtr->flags |= WIDGET_DELETED; + + /* + * Cancel idle callbacks for redrawing the widget and for rearranging + * the panes. + */ + if (pwPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayPanedWindow, (ClientData) pwPtr); + } + + /* + * Clean up the slave list; foreach slave: + * o Cancel the slave's structure notification callback + * o Cancel geometry management for the slave. + * o Free memory for the slave + */ + + for (i = 0; i < pwPtr->numSlaves; i++) { + Tk_DeleteEventHandler(pwPtr->slaves[i]->tkwin, StructureNotifyMask, + SlaveStructureProc, (ClientData) pwPtr->slaves[i]); + Tk_ManageGeometry(pwPtr->slaves[i]->tkwin, NULL, NULL); + Tk_FreeConfigOptions((char *)pwPtr->slaves[i], pwPtr->slaveOpts, + pwPtr->tkwin); + ckfree((void *)pwPtr->slaves[i]); + pwPtr->slaves[i] = NULL; + } + if (pwPtr->slaves) { + ckfree((char *) pwPtr->slaves); + } + + /* + * Remove the widget command from the interpreter. + */ + + Tcl_DeleteCommandFromToken(pwPtr->interp, pwPtr->widgetCmd); + + /* + * Let Tk_FreeConfigOptions clean up the rest. + */ + + Tk_FreeConfigOptions((char *) pwPtr, pwPtr->optionTable, pwPtr->tkwin); + pwPtr->tkwin = NULL; + + Tcl_EventuallyFree((ClientData) pwPtr, TCL_DYNAMIC); +} + +/* + *-------------------------------------------------------------- + * + * PanedWindowReqProc -- + * + * This procedure is invoked by Tk_GeometryRequest for + * windows managed by a paned window. + * + * Results: + * None. + * + * Side effects: + * Arranges for tkwin, and all its managed siblings, to + * be re-arranged at the next idle point. + * + *-------------------------------------------------------------- + */ + +static void +PanedWindowReqProc(clientData, tkwin) + ClientData clientData; /* Paned window's information about + * window that got new preferred + * geometry. */ + Tk_Window tkwin; /* Other Tk-related information + * about the window. */ +{ + Slave *panePtr = (Slave *) clientData; + PanedWindow *pwPtr = (PanedWindow *) (panePtr->masterPtr); + ComputeGeometry(pwPtr); +} + +/* + *-------------------------------------------------------------- + * + * PanedWindowLostSlaveProc -- + * + * This procedure is invoked by Tk whenever some other geometry + * claims control over a slave that used to be managed by us. + * + * Results: + * None. + * + * Side effects: + * Forgets all information about the slave. Causes geometry to + * be recomputed for the panedwindow. + * + *-------------------------------------------------------------- + */ + +static void +PanedWindowLostSlaveProc(clientData, tkwin) + ClientData clientData; /* Grid structure for slave window that + * was stolen away. */ + Tk_Window tkwin; /* Tk's handle for the slave window. */ +{ + register Slave *slavePtr = (Slave *) clientData; + PanedWindow *pwPtr = (PanedWindow *) (slavePtr->masterPtr); + if (pwPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { + Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin); + } + Unlink(slavePtr); + Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask, + SlaveStructureProc, (ClientData) slavePtr); + Tk_UnmapWindow(slavePtr->tkwin); + slavePtr->tkwin = NULL; + ckfree((void *)slavePtr); + ComputeGeometry(pwPtr); +} + +/* + *-------------------------------------------------------------- + * + * ArrangePanes -- + * + * This procedure is invoked (using the Tcl_DoWhenIdle + * mechanism) to re-layout a set of windows managed by + * a paned window. It is invoked at idle time so that a + * series of pane requests can be merged into a single + * layout operation. + * + * Results: + * None. + * + * Side effects: + * The slaves of masterPtr may get resized or moved. + * + *-------------------------------------------------------------- + */ + +static void +ArrangePanes(clientData) + ClientData clientData; /* Structure describing parent whose slaves + * are to be re-layed out. */ +{ + register PanedWindow *pwPtr = (PanedWindow *) clientData; + register Slave *slavePtr; + int i, slaveWidth, slaveHeight, slaveX, slaveY, paneWidth, paneHeight; + int doubleBw; + + pwPtr->flags &= ~REQUESTED_RELAYOUT; + + /* + * If the parent has no slaves anymore, then don't do anything + * at all: just leave the parent's size as-is. Otherwise there is + * no way to "relinquish" control over the parent so another geometry + * manager can take over. + */ + + if (pwPtr->numSlaves == 0) { + return; + } + + Tcl_Preserve((ClientData) pwPtr); + for (i = 0; i < pwPtr->numSlaves; i++) { + slavePtr = pwPtr->slaves[i]; + + /* + * Compute the size of this slave. The algorithm (assuming a + * horizontal paned window) is: + * + * 1. Get "base" dimensions. If a width or height is specified + * for this slave, use those values; else use the + * ReqWidth/ReqHeight. + * 2. Using base dimensions, pane dimensions, and sticky values, + * determine the x and y, and actual width and height of the + * widget. + */ + + doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width; + slaveWidth = (slavePtr->width > 0 ? slavePtr->width : + Tk_ReqWidth(slavePtr->tkwin) + doubleBw); + slaveHeight = (slavePtr->height > 0 ? slavePtr->height : + Tk_ReqHeight(slavePtr->tkwin) + doubleBw); + + if (pwPtr->orient == ORIENT_HORIZONTAL) { + paneWidth = slavePtr->paneWidth; + if (i == pwPtr->numSlaves - 1 && Tk_IsMapped(pwPtr->tkwin)) { + if (Tk_Width(pwPtr->tkwin) > Tk_ReqWidth(pwPtr->tkwin)) { + paneWidth += Tk_Width(pwPtr->tkwin) - + Tk_ReqWidth(pwPtr->tkwin) - + Tk_InternalBorderWidth(pwPtr->tkwin); + } + } + paneHeight = Tk_Height(pwPtr->tkwin) - (2 * slavePtr->pady) - + (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); + } else { + paneHeight = slavePtr->paneHeight; + if (i == pwPtr->numSlaves - 1 && Tk_IsMapped(pwPtr->tkwin)) { + if (Tk_Height(pwPtr->tkwin) > Tk_ReqHeight(pwPtr->tkwin)) { + paneHeight += Tk_Height(pwPtr->tkwin) - + Tk_ReqHeight(pwPtr->tkwin) - + Tk_InternalBorderWidth(pwPtr->tkwin); + } + } + paneWidth = Tk_Width(pwPtr->tkwin) - (2 * slavePtr->padx) - + (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); + } + + if (slaveWidth > paneWidth) { + slaveWidth = paneWidth; + } + if (slaveHeight > paneHeight) { + slaveHeight = paneHeight; + } + + slaveX = slavePtr->x; + slaveY = slavePtr->y; + AdjustForSticky(slavePtr->sticky, paneWidth, paneHeight, + &slaveX, &slaveY, &slaveWidth, &slaveHeight); + + slaveX += slavePtr->padx; + slaveY += slavePtr->pady; + + /* + * Now put the window in the proper spot. + */ + if ((slaveWidth <= 0) || (slaveHeight <= 0)) { + Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin); + Tk_UnmapWindow(slavePtr->tkwin); + } else { + Tk_MaintainGeometry(slavePtr->tkwin, pwPtr->tkwin, + slaveX, slaveY, slaveWidth, slaveHeight); + } + } + Tcl_Release((ClientData) pwPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Unlink -- + * + * Remove a slave from a paned window. + * + * Results: + * None. + * + * Side effects: + * The paned window will be scheduled for re-arranging and redrawing. + * + *---------------------------------------------------------------------- + */ + +static void +Unlink(slavePtr) + register Slave *slavePtr; /* Window to unlink. */ +{ + register PanedWindow *masterPtr; + int i, j; + + masterPtr = slavePtr->masterPtr; + if (masterPtr == NULL) { + return; + } + + /* + * Find the specified slave in the panedwindow's list of slaves, then + * remove it from that list. + */ + + for (i = 0; i < masterPtr->numSlaves; i++) { + if (masterPtr->slaves[i] == slavePtr) { + for (j = i; j < masterPtr->numSlaves - 1; j++) { + masterPtr->slaves[j] = masterPtr->slaves[j + 1]; + } + break; + } + } + + masterPtr->flags |= REQUESTED_RELAYOUT; + if (!(masterPtr->flags & REDRAW_PENDING)) { + masterPtr->flags |= REDRAW_PENDING; + Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) masterPtr); + } + + /* + * Set the slave's masterPtr to NULL, so that we can tell that the + * slave is no longer attached to any panedwindow. + */ + slavePtr->masterPtr = NULL; + + masterPtr->numSlaves--; +} + +/* + *---------------------------------------------------------------------- + * + * GetPane -- + * + * Given a token to a Tk window, find the pane that corresponds to + * that token in a given paned window. + * + * Results: + * Pointer to the slave structure, or NULL if the window is not + * managed by this paned window. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Slave * +GetPane(pwPtr, tkwin) + PanedWindow *pwPtr; /* Pointer to the paned window info. */ + Tk_Window tkwin; /* Window to search for. */ +{ + int i; + for (i = 0; i < pwPtr->numSlaves; i++) { + if (pwPtr->slaves[i]->tkwin == tkwin) { + return pwPtr->slaves[i]; + } + } + return NULL; +} + +/* + *-------------------------------------------------------------- + * + * SlaveStructureProc -- + * + * This procedure is invoked whenever StructureNotify events + * occur for a window that's managed by a paned window. This + * procedure's only purpose is to clean up when windows are + * deleted. + * + * Results: + * None. + * + * Side effects: + * The paned window slave structure associated with the window + * is freed, and the slave is disassociated from the paned + * window which managed it. + * + *-------------------------------------------------------------- + */ + +static void +SlaveStructureProc(clientData, eventPtr) + ClientData clientData; /* Pointer to record describing window item. */ + XEvent *eventPtr; /* Describes what just happened. */ +{ + Slave *slavePtr = (Slave *) clientData; + PanedWindow *pwPtr = slavePtr->masterPtr; + + if (eventPtr->type == DestroyNotify) { + Unlink(slavePtr); + slavePtr->tkwin = NULL; + ckfree((void *)slavePtr); + ComputeGeometry(pwPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ComputeGeometry -- + * + * Compute geometry for the paned window, including coordinates of + * all slave windows and each sash. + * + * Results: + * None. + * + * Side effects: + * Recomputes geometry information for a paned window. + * + *---------------------------------------------------------------------- + */ + +static void +ComputeGeometry(pwPtr) + PanedWindow *pwPtr; /* Pointer to the Paned Window structure. */ +{ + int i, x, y, doubleBw, internalBw; + int reqWidth, reqHeight, sashWidth, sxOff, syOff, hxOff, hyOff, dim; + Slave *slavePtr; + + pwPtr->flags |= REQUESTED_RELAYOUT; + + x = y = internalBw = Tk_InternalBorderWidth(pwPtr->tkwin); + reqWidth = reqHeight = 0; + + /* + * Sashes and handles share space on the display. To simplify + * processing below, precompute the x and y offsets of the handles and + * sashes within the space occupied by their combination; later, just add + * those offsets blindly (avoiding the extra showHandle, etc, checks). + */ + sxOff = syOff = hxOff = hyOff = 0; + if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) { + sashWidth = pwPtr->handleSize; + if (pwPtr->orient == ORIENT_HORIZONTAL) { + sxOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2; + hyOff = pwPtr->handlePad; + } else { + syOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2; + hxOff = pwPtr->handlePad; + } + } else { + sashWidth = pwPtr->sashWidth; + if (pwPtr->orient == ORIENT_HORIZONTAL) { + hxOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2; + hyOff = pwPtr->handlePad; + } else { + hyOff = (pwPtr->handleSize - pwPtr->sashWidth) / 2; + hxOff = pwPtr->handlePad; + } + } + + for (i = 0; i < pwPtr->numSlaves; i++) { + slavePtr = pwPtr->slaves[i]; + /* + * First set the coordinates for the top left corner of the slave's + * parcel. + */ + slavePtr->x = x; + slavePtr->y = y; + + /* + * Make sure the pane's paned dimension is at least minsize. + * This check may be redundant, since the only way to change a pane's + * size is by moving a sash, and that code checks the minsize. + */ + if (pwPtr->orient == ORIENT_HORIZONTAL) { + if (slavePtr->paneWidth < slavePtr->minSize) { + slavePtr->paneWidth = slavePtr->minSize; + } + } else { + if (slavePtr->paneHeight < slavePtr->minSize) { + slavePtr->paneHeight = slavePtr->minSize; + } + } + + /* + * Compute the location of the sash at the right or bottom of the + * parcel. + */ + if (pwPtr->orient == ORIENT_HORIZONTAL) { + x += slavePtr->paneWidth + (2 * slavePtr->padx) + pwPtr->sashPad; + } else { + y += slavePtr->paneHeight + (2 * slavePtr->pady) + pwPtr->sashPad; + } + slavePtr->sashx = x + sxOff; + slavePtr->sashy = y + syOff; + slavePtr->handlex = x + hxOff; + slavePtr->handley = y + hyOff; + + /* + * Compute the location of the next parcel. + */ + + if (pwPtr->orient == ORIENT_HORIZONTAL) { + x += sashWidth + pwPtr->sashPad; + } else { + y += sashWidth + pwPtr->sashPad; + } + + /* + * Find the maximum height/width of the slaves, for computing the + * requested height/width of the paned window. + */ + if (pwPtr->orient == ORIENT_HORIZONTAL) { + /* + * If the slave has an explicit height set, use that; otherwise, + * use the slave's requested height. + */ + if (slavePtr->height > 0) { + dim = slavePtr->height; + } else { + doubleBw = (2 * Tk_Changes(slavePtr->tkwin)->border_width); + dim = Tk_ReqHeight(slavePtr->tkwin) + doubleBw; + } + dim += (2 * slavePtr->pady); + if (dim > reqHeight) { + reqHeight = dim; + } + } else { + /* + * If the slave has an explicit width set use that; otherwise, + * use the slave's requested width. + */ + if (slavePtr->width > 0) { + dim = slavePtr->width; + } else { + doubleBw = (2 * Tk_Changes(slavePtr->tkwin)->border_width); + dim = Tk_ReqWidth(slavePtr->tkwin) + doubleBw; + } + dim += (2 * slavePtr->padx); + if (dim > reqWidth) { + reqWidth = dim; + } + } + } + + /* + * The loop above should have left x (or y) equal to the sum of the + * widths (or heights) of the widgets, plus the size of one sash and + * the sash padding for each widget, plus the width of the left (or top) + * border of the paned window. + * + * The requested width (or height) is therefore x (or y) minus the size of + * one sash and padding, plus the width of the right (or bottom) border + * of the paned window. + * + * The height (or width) is equal to the maximum height (or width) of + * the slaves, plus the width of the border of the top and bottom (or left + * and right) of the paned window. + */ + if (pwPtr->orient == ORIENT_HORIZONTAL) { + reqWidth = x - (sashWidth + (2 * pwPtr->sashPad)) + internalBw; + reqHeight += 2 * internalBw; + } else { + reqHeight = y - (sashWidth + (2 * pwPtr->sashPad)) + internalBw; + reqWidth += 2 * internalBw; + } + if (pwPtr->width <= 0 && pwPtr->height <= 0) { + Tk_GeometryRequest(pwPtr->tkwin, reqWidth, reqHeight); + } + if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) { + pwPtr->flags |= REDRAW_PENDING; + Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * DestroyOptionTables -- + * + * This procedure is registered as an exit callback when the paned window + * command is first called. It cleans up the OptionTables structure + * allocated by that command. + * + * Results: + * None. + * + * Side effects: + * Frees memory. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyOptionTables(clientData, interp) + ClientData clientData; /* Pointer to the OptionTables struct */ + Tcl_Interp *interp; /* Pointer to the calling interp */ +{ + ckfree((char *)clientData); + return; +} + +/* + *---------------------------------------------------------------------- + * + * GetSticky - + * + * Converts an internal boolean combination of "sticky" bits into a + * a Tcl string obj containing zero or mor of n, s, e, or w. + * + * Results: + * Tcl_Obj containing the string representation of the sticky value. + * + * Side effects: + * Creates a new Tcl_Obj. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj * +GetSticky(clientData, tkwin, recordPtr, internalOffset) + ClientData clientData; + Tk_Window tkwin; + char *recordPtr; /* Pointer to widget record. */ + int internalOffset; /* Offset within *recordPtr containing the + * sticky value. */ +{ + int sticky = *(int *)(recordPtr + internalOffset); + static char buffer[5]; + int count = 0; + + if (sticky & STICK_NORTH) { + buffer[count++] = 'n'; + } + if (sticky & STICK_EAST) { + buffer[count++] = 'e'; + } + if (sticky & STICK_SOUTH) { + buffer[count++] = 's'; + } + if (sticky & STICK_WEST) { + buffer[count++] = 'w'; + } + buffer[count] = '\0'; + + return Tcl_NewStringObj(buffer, -1); +} + +/* + *---------------------------------------------------------------------- + * + * SetSticky -- + * + * Converts a Tcl_Obj representing a widgets stickyness into an + * integer value. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * May store the integer value into the internal representation + * pointer. May change the pointer to the Tcl_Obj to NULL to indicate + * that the specified string was empty and that is acceptable. + * + *---------------------------------------------------------------------- + */ + +static int +SetSticky(clientData, interp, tkwin, value, recordPtr, internalOffset, + oldInternalPtr, flags) + ClientData clientData; + Tcl_Interp *interp; /* Current interp; may be used for errors. */ + Tk_Window tkwin; /* Window for which option is being set. */ + Tcl_Obj **value; /* Pointer to the pointer to the value object. + * We use a pointer to the pointer because + * we may need to return a value (NULL). */ + char *recordPtr; /* Pointer to storage for the widget record. */ + int internalOffset; /* Offset within *recordPtr at which the + internal value is to be stored. */ + char *oldInternalPtr; /* Pointer to storage for the old value. */ + int flags; /* Flags for the option, set Tk_SetOptions. */ +{ + int sticky = 0; + char c, *string, *internalPtr; + + internalPtr = ComputeSlotAddress(recordPtr, internalOffset); + + if (flags & TK_OPTION_NULL_OK && ObjectIsEmpty(*value)) { + *value = NULL; + } else { + /* + * Convert the sticky specifier into an integer value. + */ + + string = Tcl_GetString(*value); + + while ((c = *string++) != '\0') { + switch (c) { + case 'n': case 'N': sticky |= STICK_NORTH; break; + case 'e': case 'E': sticky |= STICK_EAST; break; + case 's': case 'S': sticky |= STICK_SOUTH; break; + case 'w': case 'W': sticky |= STICK_WEST; break; + case ' ': case ',': case '\t': case '\r': case '\n': break; + default: { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad stickyness value \"", + Tcl_GetString(*value), "\": must be a string ", + "containing zero or more of n, e, s, and w", + (char *)NULL); + return TCL_ERROR; + } + } + } + } + + if (internalPtr != NULL) { + *((int *) oldInternalPtr) = *((int *) internalPtr); + *((int *) internalPtr) = sticky; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * RestoreSticky -- + * + * Restore a sticky option value from a saved value. + * + * Results: + * None. + * + * Side effects: + * Restores the old value. + * + *---------------------------------------------------------------------- + */ + +static void +RestoreSticky(clientData, tkwin, internalPtr, oldInternalPtr) + ClientData clientData; + Tk_Window tkwin; + char *internalPtr; /* Pointer to storage for value. */ + char *oldInternalPtr; /* Pointer to old value. */ +{ + *(int *)internalPtr = *(int *)oldInternalPtr; +} + +/* + *---------------------------------------------------------------------- + * + * AdjustForSticky -- + * + * Given the x,y coords of the top-left corner of a pane, the + * dimensions of that pane, and the dimensions of a slave, compute + * the x,y coords and actual dimensions of the slave based on the slave's + * sticky value. + * + * Results: + * No direct return; sets the x, y, slaveWidth and slaveHeight to + * correct values. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +AdjustForSticky(sticky, cavityWidth, cavityHeight, xPtr, yPtr, + slaveWidthPtr, slaveHeightPtr) + int sticky; /* Sticky value; see top of file for definition. */ + int cavityWidth; /* Width of the cavity. */ + int cavityHeight; /* Height of the cavity. */ + int *xPtr, *yPtr; /* Initially, coordinates of the top-left + * corner of cavity; also return values for + * actual x, y coords of slave. */ + int *slaveWidthPtr; /* Slave width. */ + int *slaveHeightPtr; /* Slave height. */ +{ + int diffx=0; /* Cavity width - slave width. */ + int diffy=0; /* Cavity hight - slave height. */ + + if (cavityWidth > *slaveWidthPtr) { + diffx = cavityWidth - *slaveWidthPtr; + } + + if (cavityHeight > *slaveHeightPtr) { + diffy = cavityHeight - *slaveHeightPtr; + } + + if ((sticky & STICK_EAST) && (sticky & STICK_WEST)) { + *slaveWidthPtr += diffx; + } + if ((sticky & STICK_NORTH) && (sticky & STICK_SOUTH)) { + *slaveHeightPtr += diffy; + } + if (!(sticky & STICK_WEST)) { + *xPtr += (sticky & STICK_EAST) ? diffx : diffx/2; + } + if (!(sticky & STICK_NORTH)) { + *yPtr += (sticky & STICK_SOUTH) ? diffy : diffy/2; + } +} + +/* + *---------------------------------------------------------------------- + * + * MoveSash -- + * + * Move the sash given by index the amount given. + * + * Results: + * None. + * + * Side effects: + * Recomputes the sizes of the panes in a panedwindow. + * + *---------------------------------------------------------------------- + */ + +static void +MoveSash(pwPtr, sash, diff) + PanedWindow *pwPtr; + int sash; + int diff; +{ + int diffConsumed = 0, i, extra, maxCoord, currCoord; + int *lengthPtr, newLength; + Slave *slave; + + if (diff > 0) { + /* + * Growing the pane, at the expense of panes to the right. + */ + + + /* + * First check that moving the sash the requested distance will not + * leave it off the screen. If necessary, clip the requested diff + * to the maximum possible while remaining visible. + */ + if (pwPtr->orient == ORIENT_HORIZONTAL) { + if (Tk_IsMapped(pwPtr->tkwin)) { + maxCoord = Tk_Width(pwPtr->tkwin); + } else { + maxCoord = Tk_ReqWidth(pwPtr->tkwin); + } + extra = Tk_Width(pwPtr->tkwin) - Tk_ReqWidth(pwPtr->tkwin); + currCoord = pwPtr->slaves[sash]->sashx; + } else { + if (Tk_IsMapped(pwPtr->tkwin)) { + maxCoord = Tk_Height(pwPtr->tkwin); + } else { + maxCoord = Tk_ReqHeight(pwPtr->tkwin); + } + extra = Tk_Height(pwPtr->tkwin) - Tk_ReqHeight(pwPtr->tkwin); + currCoord = pwPtr->slaves[sash]->sashy; + } + + maxCoord -= (pwPtr->borderWidth + pwPtr->sashWidth + pwPtr->sashPad); + if (currCoord + diff >= maxCoord) { + diff = maxCoord - currCoord; + } + + for (i = sash + 1; i < pwPtr->numSlaves; i++) { + if (diffConsumed == diff) { + break; + } + slave = pwPtr->slaves[i]; + + if (pwPtr->orient == ORIENT_HORIZONTAL) { + lengthPtr = &(slave->paneWidth); + } else { + lengthPtr = &(slave->paneHeight); + } + + /* + * Remove as much space from this pane as possible (constrained + * by the minsize value and the visible dimensions of the window). + */ + + if (i == pwPtr->numSlaves - 1 && extra > 0) { + /* + * The last pane may have some additional "virtual" space, + * if the width (or height) of the paned window is bigger + * than the requested width (or height). + * + * That extra space is not included in the paneWidth + * (or paneHeight) value, so we have to handle the last + * pane specially. + */ + newLength = (*lengthPtr + extra) - (diff - diffConsumed); + if (newLength < slave->minSize) { + newLength = slave->minSize; + } + if (newLength < 0) { + newLength = 0; + } + diffConsumed += (*lengthPtr + extra) - newLength; + if (newLength < *lengthPtr) { + *lengthPtr = newLength; + } + } else { + newLength = *lengthPtr - (diff - diffConsumed); + if (newLength < slave->minSize) { + newLength = slave->minSize; + } + if (newLength < 0) { + newLength = 0; + } + diffConsumed += *lengthPtr - newLength; + *lengthPtr = newLength; + } + } + if (pwPtr->orient == ORIENT_HORIZONTAL) { + pwPtr->slaves[sash]->paneWidth += diffConsumed; + } else { + pwPtr->slaves[sash]->paneHeight += diffConsumed; + } + } else if (diff < 0) { + /* + * Shrinking the pane; additional space is given to the pane to the + * right. + */ + for (i = sash; i >= 0; i--) { + if (diffConsumed == diff) { + break; + } + /* + * Remove as much space from this pane as possible. + */ + slave = pwPtr->slaves[i]; + + if (pwPtr->orient == ORIENT_HORIZONTAL) { + lengthPtr = &(slave->paneWidth); + } else { + lengthPtr = &(slave->paneHeight); + } + + newLength = *lengthPtr + (diff - diffConsumed); + if (newLength < slave->minSize) { + newLength = slave->minSize; + } + if (newLength < 0) { + newLength = 0; + } + diffConsumed -= *lengthPtr - newLength; + *lengthPtr = newLength; + } + if (pwPtr->orient == ORIENT_HORIZONTAL) { + pwPtr->slaves[sash + 1]->paneWidth -= diffConsumed; + } else { + pwPtr->slaves[sash + 1]->paneHeight -= diffConsumed; + } + } + +} + +/* + *---------------------------------------------------------------------- + * + * ProxyWindowEventProc -- + * + * This procedure is invoked by the Tk dispatcher for various + * events on paned window proxy windows. + * + * Results: + * None. + * + * Side effects: + * When the window gets deleted, internal structures get + * cleaned up. When it gets exposed, it is redisplayed. + * + *-------------------------------------------------------------- + */ + +static void +ProxyWindowEventProc(clientData, eventPtr) + ClientData clientData; /* Information about window. */ + XEvent *eventPtr; /* Information about event. */ +{ + PanedWindow *pwPtr = (PanedWindow *) clientData; + + if (eventPtr->type == Expose) { + if (pwPtr->proxywin != NULL &&!(pwPtr->flags & PROXY_REDRAW_PENDING)) { + Tcl_DoWhenIdle(DisplayProxyWindow, (ClientData) pwPtr); + pwPtr->flags |= PROXY_REDRAW_PENDING; + } + } +} + +/* + *-------------------------------------------------------------- + * + * DisplayProxyWindow -- + * + * This procedure redraws a paned window proxy 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. + * + *-------------------------------------------------------------- + */ + +static void +DisplayProxyWindow(clientData) + ClientData clientData; /* Information about window. */ +{ + PanedWindow *pwPtr = (PanedWindow *) clientData; + Pixmap pixmap; + Tk_Window tkwin = pwPtr->proxywin; + pwPtr->flags &= ~PROXY_REDRAW_PENDING; + if ((tkwin == NULL) || !Tk_IsMapped(tkwin)) { + return; + } + + /* + * Create a pixmap for double-buffering, if necessary. + */ + + pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin), + Tk_Width(tkwin), Tk_Height(tkwin), + DefaultDepthOfScreen(Tk_Screen(tkwin))); + + /* + * Redraw the widget's background and border. + */ + Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 2, pwPtr->sashRelief); + + /* + * Copy the pixmap to the display. + */ + XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin), pwPtr->gc, + 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), + 0, 0); + Tk_FreePixmap(Tk_Display(tkwin), pixmap); +} + +/* + *---------------------------------------------------------------------- + * + * PanedWindowProxyCommand -- + * + * Handles the panedwindow proxy subcommand. See the user + * documentation for details. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * May map or unmap the proxy sash. + * + *---------------------------------------------------------------------- + */ + +static int +PanedWindowProxyCommand(pwPtr, interp, objc, objv) + PanedWindow *pwPtr; /* Pointer to paned window information. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj * CONST objv[]; /* Argument objects. */ +{ + static CONST char *optionStrings[] = { "coord", "forget", "place", + (char *) NULL }; + enum options { PROXY_COORD, PROXY_FORGET, PROXY_PLACE }; + int index, x, y, sashWidth, sashHeight; + Tcl_Obj *coords[2]; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum options) index) { + case PROXY_COORD: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + + coords[0] = Tcl_NewIntObj(pwPtr->proxyx); + coords[1] = Tcl_NewIntObj(pwPtr->proxyy); + Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords); + break; + + case PROXY_FORGET: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + if (Tk_IsMapped(pwPtr->proxywin)) { + Tk_UnmapWindow(pwPtr->proxywin); + Tk_UnmaintainGeometry(pwPtr->proxywin, pwPtr->tkwin); + } + break; + + case PROXY_PLACE: { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 3, objv, "x y"); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) { + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) { + return TCL_ERROR; + } + + if (pwPtr->orient == ORIENT_HORIZONTAL) { + if (x < 0) { + x = 0; + } + y = Tk_InternalBorderWidth(pwPtr->tkwin); + sashWidth = pwPtr->sashWidth; + sashHeight = Tk_Height(pwPtr->tkwin) - + (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); + } else { + if (y < 0) { + y = 0; + } + x = Tk_InternalBorderWidth(pwPtr->tkwin); + sashHeight = pwPtr->sashWidth; + sashWidth = Tk_Width(pwPtr->tkwin) - + (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); + } + + /* + * Stash the proxy coordinates for future "proxy coord" calls. + */ + + pwPtr->proxyx = x; + pwPtr->proxyy = y; + + /* + * Make sure the proxy window is higher in the stacking order + * than the slaves, so that it will be visible when drawn. + * It would be more correct to push the proxy window just high + * enough to appear above the highest slave, but it's much easier + * to just force it all the way to the top of the stacking order. + */ + + Tk_RestackWindow(pwPtr->proxywin, Above, NULL); + + /* + * Let Tk_MaintainGeometry take care of placing the window at + * the right coordinates. + */ + Tk_MaintainGeometry(pwPtr->proxywin, pwPtr->tkwin, + x, y, sashWidth, sashHeight); + break; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ObjectIsEmpty -- + * + * This procedure tests whether the string value of an object is + * empty. + * + * Results: + * The return value is 1 if the string value of objPtr has length + * zero, and 0 otherwise. + * + * Side effects: + * May cause object shimmering, since this function can force a + * conversion to a string object. + * + *---------------------------------------------------------------------- + */ + +static int +ObjectIsEmpty(objPtr) + Tcl_Obj *objPtr; /* Object to test. May be NULL. */ +{ + int length; + + if (objPtr == NULL) { + return 1; + } + if (objPtr->bytes != NULL) { + return (objPtr->length == 0); + } + Tcl_GetStringFromObj(objPtr, &length); + return (length == 0); +} + +/* + *---------------------------------------------------------------------- + * + * ComputeInternalPointer -- + * + * Given a pointer to the start of a record and the offset of a slot + * within that record, compute the address of that slot. + * + * Results: + * If offset is non-negative, returns the computed address; else, + * returns NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static char * +ComputeSlotAddress(recordPtr, offset) + char *recordPtr; /* Pointer to the start of a record. */ + int offset; /* Offset of a slot within that record; may be < 0. */ +{ + if (offset >= 0) { + return recordPtr + offset; + } else { + return NULL; + } +} + +/* + *---------------------------------------------------------------------- + * + * PanedWindowIdentifyCoords -- + * + * Given a pair of x,y coordinates, identify the panedwindow component + * at that point, if any. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Modifies the interpreter's result to contain either an empty list, + * or a two element list of the form {sash n} or {handle n} to indicate + * that the point lies within the n'th sash or handle. + * + *---------------------------------------------------------------------- + */ + +static int +PanedWindowIdentifyCoords(pwPtr, interp, x, y) + PanedWindow *pwPtr; /* Information about the widget. */ + Tcl_Interp *interp; /* Interpreter in which to store result. */ + int x, y; /* Coordinates of the point to identify. */ +{ + Tcl_Obj *list; + int i, sashHeight, sashWidth, thisx, thisy; + int found, isHandle, lpad, rpad, tpad, bpad; + list = Tcl_NewObj(); + + if (pwPtr->orient == ORIENT_HORIZONTAL) { + if (Tk_IsMapped(pwPtr->tkwin)) { + sashHeight = Tk_Height(pwPtr->tkwin); + } else { + sashHeight = Tk_ReqHeight(pwPtr->tkwin); + } + sashHeight -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin); + if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) { + sashWidth = pwPtr->handleSize; + lpad = (pwPtr->handleSize - pwPtr->sashWidth) / 2; + rpad = pwPtr->handleSize - lpad; + lpad += pwPtr->sashPad; + rpad += pwPtr->sashPad; + } else { + sashWidth = pwPtr->sashWidth; + lpad = rpad = pwPtr->sashPad; + } + tpad = bpad = 0; + } else { + if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) { + sashHeight = pwPtr->handleSize; + tpad = (pwPtr->handleSize - pwPtr->sashWidth) / 2; + bpad = pwPtr->handleSize - tpad; + tpad += pwPtr->sashPad; + bpad += pwPtr->sashPad; + } else { + sashHeight = pwPtr->sashWidth; + tpad = bpad = pwPtr->sashPad; + } + if (Tk_IsMapped(pwPtr->tkwin)) { + sashWidth = Tk_Width(pwPtr->tkwin); + } else { + sashWidth = Tk_ReqWidth(pwPtr->tkwin); + } + sashWidth -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin); + lpad = rpad = 0; + } + + isHandle = 0; + found = -1; + for (i = 0; i < pwPtr->numSlaves - 1; i++) { + thisx = pwPtr->slaves[i]->sashx; + thisy = pwPtr->slaves[i]->sashy; + + if (((thisx - lpad) <= x && x <= (thisx + rpad + sashWidth)) && + ((thisy - tpad) <= y && y <= (thisy + bpad + sashHeight))) { + found = i; + + /* + * Determine if the point is over the handle or the sash. + */ + if (pwPtr->showHandle) { + thisx = pwPtr->slaves[i]->handlex; + thisy = pwPtr->slaves[i]->handley; + if (pwPtr->orient == ORIENT_HORIZONTAL) { + if (thisy <= y && y <= (thisy + pwPtr->handleSize)) { + isHandle = 1; + } + } else { + if (thisx <= x && x <= (thisx + pwPtr->handleSize)) { + isHandle = 1; + } + } + } + break; + } + } + + /* + * Set results. + */ + if (found != -1) { + Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(found)); + if (isHandle) { + Tcl_ListObjAppendElement(interp, list, + Tcl_NewStringObj("handle", -1)); + } else { + Tcl_ListObjAppendElement(interp, list, + Tcl_NewStringObj("sash", -1)); + } + } + + Tcl_SetObjResult(interp, list); + return TCL_OK; +} diff --git a/library/demos/paned1.tcl b/library/demos/paned1.tcl new file mode 100644 index 0000000..1ea358c --- /dev/null +++ b/library/demos/paned1.tcl @@ -0,0 +1,34 @@ +# paned1.tcl -- +# +# This demonstration script creates a toplevel window containing +# a paned window that separates two windows horizontally. +# +# RCS: @(#) $Id: paned1.tcl,v 1.1.4.1 2002/06/10 05:07:59 wolfsuit Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .paned1 +catch {destroy $w} +toplevel $w +wm title $w "Horizontal Paned Window Demonstration" +wm iconname $w "paned1" +positionWindow $w + +label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two coloured windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)" +pack $w.msg -side top + +frame $w.buttons +pack $w.buttons -side bottom -fill x -pady 2m +button $w.buttons.dismiss -text Dismiss -command "destroy $w" +button $w.buttons.code -text "See Code" -command "showCode $w" +pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + +panedwindow $w.pane +pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m + +label $w.pane.left -text "This is the\nleft side" -bg yellow +label $w.pane.right -text "This is the\nright side" -bg cyan + +$w.pane add $w.pane.left $w.pane.right diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl new file mode 100644 index 0000000..d53742d --- /dev/null +++ b/library/demos/paned2.tcl @@ -0,0 +1,76 @@ +# paned2.tcl -- +# +# This demonstration script creates a toplevel window containing +# a paned window that separates two windows vertically. +# +# RCS: @(#) $Id: paned2.tcl,v 1.1.4.1 2002/06/10 05:07:59 wolfsuit Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .paned2 +catch {destroy $w} +toplevel $w +wm title $w "Vertical Paned Window Demonstration" +wm iconname $w "paned2" +positionWindow $w + +label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two scrolled windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)" +pack $w.msg -side top + +frame $w.buttons +pack $w.buttons -side bottom -fill x -pady 2m +button $w.buttons.dismiss -text Dismiss -command "destroy $w" +button $w.buttons.code -text "See Code" -command "showCode $w" +pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + +# Create the pane itself +panedwindow $w.pane -orient vertical +pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m + +# The top window is a listbox with scrollbar +set paneList { + {List of Tk Widgets} + button + canvas + checkbutton + entry + frame + label + labelframe + listbox + menu + menubutton + message + panedwindow + radiobutton + scale + scrollbar + spinbox + text + toplevel +} +set f [frame $w.pane.top] +listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set" +# Invert the first item to highlight it +$f.list itemconfigure 0 \ + -background [$f.list cget -fg] -foreground [$f.list cget -bg] +scrollbar $f.scr -orient vertical -command "$f.list yview" +pack $f.scr -side right -fill y +pack $f.list -fill both -expand 1 + +# The bottom window is a text widget with scrollbar +set f [frame $w.pane.bottom] +text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \ + -width 30 -wrap none +scrollbar $f.xscr -orient horizontal -command "$f.text xview" +scrollbar $f.yscr -orient vertical -command "$f.text yview" +grid $f.text $f.yscr -sticky nsew +grid $f.xscr -sticky nsew +grid columnconfigure $f 0 -weight 1 +grid rowconfigure $f 0 -weight 1 +$f.text insert 1.0 "This is just a normal text widget" + +# Now add our contents to the paned window +$w.pane add $w.pane.top $w.pane.bottom diff --git a/library/panedwindow.tcl b/library/panedwindow.tcl new file mode 100644 index 0000000..1a6e493 --- /dev/null +++ b/library/panedwindow.tcl @@ -0,0 +1,181 @@ +# panedwindow.tcl -- +# +# This file defines the default bindings for Tk panedwindow widgets and +# provides procedures that help in implementing those bindings. +# +# RCS: @(#) $Id: panedwindow.tcl,v 1.5.4.1 2002/06/10 05:07:59 wolfsuit Exp $ +# + +bind PanedWindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 } +bind PanedWindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 } + +bind PanedWindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 } +bind PanedWindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 } + +bind PanedWindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1} +bind PanedWindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0} + +bind PanedWindow <Motion> { ::tk::panedwindow::Motion %W %x %y } + +bind PanedWindow <Leave> { ::tk::panedwindow::Leave %W } + +# Initialize namespace +namespace eval ::tk::panedwindow {} + +# ::tk::panedwindow::MarkSash -- +# +# Handle marking the correct sash for possible dragging +# +# Arguments: +# w the widget +# x widget local x coord +# y widget local y coord +# proxy whether this should be a proxy sash +# Results: +# None +# +proc ::tk::panedwindow::MarkSash {w x y proxy} { + set what [$w identify $x $y] + if { [llength $what] == 2 } { + foreach {index which} $what break + if { !$::tk_strictMotif || [string equal $which "handle"] } { + if {!$proxy} { $w sash mark $index $x $y } + set ::tk::Priv(sash) $index + foreach {sx sy} [$w sash coord $index] break + set ::tk::Priv(dx) [expr {$sx-$x}] + set ::tk::Priv(dy) [expr {$sy-$y}] + } + } +} + +# ::tk::panedwindow::DragSash -- +# +# Handle dragging of the correct sash +# +# Arguments: +# w the widget +# x widget local x coord +# y widget local y coord +# proxy whether this should be a proxy sash +# Results: +# Moves sash +# +proc ::tk::panedwindow::DragSash {w x y proxy} { + if { [info exists ::tk::Priv(sash)] } { + if {$proxy} { + $w proxy place \ + [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}] + } else { + $w sash place $::tk::Priv(sash) \ + [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}] + } + } +} + +# ::tk::panedwindow::ReleaseSash -- +# +# Handle releasing of the sash +# +# Arguments: +# w the widget +# proxy whether this should be a proxy sash +# Results: +# Returns ... +# +proc ::tk::panedwindow::ReleaseSash {w proxy} { + if { [info exists ::tk::Priv(sash)] } { + if {$proxy} { + foreach {x y} [$w proxy coord] break + $w sash place $::tk::Priv(sash) $x $y + $w proxy forget + } + unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy) + } +} + +# ::tk::panedwindow::Motion -- +# +# Handle motion on the widget. This is used to change the cursor +# when the user moves over the sash area. +# +# Arguments: +# w the widget +# x widget local x coord +# y widget local y coord +# Results: +# May change the cursor. Sets up a timer to verify that we are still +# over the widget. +# +proc ::tk::panedwindow::Motion {w x y} { + variable ::tk::Priv + set id [$w identify $x $y] + if {([llength $id] == 2) && \ + (!$::tk_strictMotif || [string equal [lindex $id 1] "handle"])} { + if { ![info exists Priv(panecursor)] } { + set Priv(panecursor) [$w cget -cursor] + if { [string equal [$w cget -sashcursor] ""] } { + if { [string equal [$w cget -orient] "horizontal"] } { + $w configure -cursor sb_h_double_arrow + } else { + $w configure -cursor sb_v_double_arrow + } + } else { + $w configure -cursor [$w cget -sashcursor] + } + if {[info exists Priv(pwAfterId)]} { + after cancel $Priv(pwAfterId) + } + set Priv(pwAfterId) [after 150 \ + [list ::tk::panedwindow::Cursor $w]] + } + return + } + if { [info exists Priv(panecursor)] } { + $w configure -cursor $Priv(panecursor) + unset Priv(panecursor) + } +} + +# ::tk::panedwindow::Cursor -- +# +# Handles returning the normal cursor when we are no longer over the +# sash area. This needs to be done this way, because the PanedWindow +# won't see Leave events when the mouse moves from the sash to a +# paned child, although the child does receive an Enter event. +# +# Arguments: +# w the widget +# Results: +# May restore the default cursor, or schedule a timer to do it. +# +proc ::tk::panedwindow::Cursor {w} { + variable ::tk::Priv + if {[info exists Priv(panecursor)]} { + if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == $w} { + set Priv(pwAfterId) [after 150 [list ::tk::panedwindow::Cursor $w]] + } else { + $w configure -cursor $Priv(panecursor) + unset Priv(panecursor) + if {[info exists Priv(pwAfterId)]} { + after cancel $Priv(pwAfterId) + unset Priv(pwAfterId) + } + } + } +} + +# ::tk::panedwindow::Leave -- +# +# Return to default cursor when leaving the pw widget. +# +# Arguments: +# w the widget +# Results: +# Restores the default cursor +# +proc ::tk::panedwindow::Leave {w} { + if {[info exists ::tk::Priv(panecursor)]} { + $w configure -cursor $::tk::Priv(panecursor) + unset ::tk::Priv(panecursor) + } +} diff --git a/mac/tkMacTclCode.r b/mac/tkMacTclCode.r new file mode 100644 index 0000000..adbd0f6 --- /dev/null +++ b/mac/tkMacTclCode.r @@ -0,0 +1,71 @@ +/* + * tkMacTclCode.r -- + * + * This file creates resources from the Tcl code that is + * usually stored in the TCL_LIBRARY + * + * 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. + * + * SCCS: @(#) tkMacTclCode.r 1.1 98/01/21 22:22:38 + */ + +#include <Types.r> +#include <SysTypes.r> + +#define TK_LIBRARY_RESOURCES 3000 + +/* + * The mechanisim below loads Tcl source into the resource fork of the + * application. The example below creates a TEXT resource named + * "Init" from the file "init.tcl". This allows applications to use + * Tcl to define the behavior of the application without having to + * require some predetermined file structure - all needed Tcl "files" + * are located within the application. To source a file for the + * resource fork the source command has been modified to support + * sourcing from resources. In the below case "source -rsrc {Init}" + * will load the TEXT resource named "Init". + */ + +read 'TEXT' (TK_LIBRARY_RESOURCES+1, "tk", purgeable,preload) + "::library:tk.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+2, "button", purgeable) + "::library:button.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+3, "dialog", purgeable) + "::library:dialog.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+4, "entry", purgeable) + "::library:entry.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+5, "focus", purgeable) + "::library:focus.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+6, "listbox", purgeable) + "::library:listbox.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+7, "menu", purgeable) + "::library:menu.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+8, "optMenu", purgeable) + "::library:optMenu.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+9, "palette", purgeable) + "::library:palette.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+10, "scale", purgeable) + "::library:scale.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+11, "scrlbar", purgeable) + "::library:scrlbar.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+12, "tearoff", purgeable) + "::library:tearoff.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+13, "text", purgeable) + "::library:text.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+14, "bgerror", purgeable) + "::library:bgerror.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+15, "console", purgeable) + "::library:console.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+16, "msgbox", purgeable) + "::library:msgbox.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+17, "comdlg", purgeable) + "::library:comdlg.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+18, "spinbox", purgeable) + "::library:spinbox.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+19, "panedwindow", purgeable) + "::library:panedwindow.tcl"; +read 'TEXT' (TK_LIBRARY_RESOURCES+20, "msgcat", purgeable) + ":::tcl:library:msgcat:msgcat.tcl"; diff --git a/tests/embed.test b/tests/embed.test new file mode 100644 index 0000000..f169247 --- /dev/null +++ b/tests/embed.test @@ -0,0 +1,51 @@ +# This file is a Tcl script to test out embedded Windows. +# +# Copyright (c) 1996-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: embed.test,v 1.1.2.1 2002/06/10 05:08:00 wolfsuit Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +proc deleteWindows {} { + foreach i [winfo children .] { + destroy $i + } +} + +test embed-1.1 {TkpUseWindow procedure, bad window identifier} { + deleteWindows + list [catch {toplevel .t -use xyz} msg] $msg +} {1 {expected integer but got "xyz"}} + +test embed-1.2 {CreateFrame procedure, bad window identifier} { + deleteWindows + list [catch {toplevel .t -container xyz} msg] $msg +} {1 {expected boolean value but got "xyz"}} + +test embed-1.3 {CreateFrame procedure, both -use and + -container is invalid } { + deleteWindows + toplevel .container -container 1 + list [catch {toplevel .t -use [winfo id .container] \ + -container 1} msg] $msg +} {1 {A window cannot have both the -use and the -container option set.}} + +test embed-1.4 {TkpUseWindow procedure, -container must be set} { + deleteWindows + toplevel .container + list [catch {toplevel .embd -use [winfo id .container]} err] $err +} {1 {window ".container" doesn't have -container option set}} + +test embed-1.5 {TkpUseWindow procedure, -container must be set} { + deleteWindows + frame .container + list [catch {toplevel .embd -use [winfo id .container]} err] $err +} {1 {window ".container" doesn't have -container option set}} + + +# FIXME: test cases common to unixEmbed.test and macEmbed.test should +# be moved here. diff --git a/tests/panedwindow.test b/tests/panedwindow.test new file mode 100644 index 0000000..a5f626a --- /dev/null +++ b/tests/panedwindow.test @@ -0,0 +1,2380 @@ +# 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. +# +# RCS: @(#) $Id: panedwindow.test,v 1.1.4.1 2002/06/10 05:08:00 wolfsuit Exp $ + +if {[info tclversion] < 8.4} { + puts "panedwindow requires Tk 8.4" + exit +} + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +foreach i [winfo children .] { + destroy $i +} + +wm geometry . {} +raise . + +set i 1 +panedwindow .p +foreach test { + {-background "#ff0000" "#ff0000" non-existent + {unknown color name "non-existent"}} + {-bd 4 4 badValue {bad screen distance "badValue"}} + {-bg "#ff0000" "#ff0000" non-existent {unknown color name "non-existent"}} + {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} + {-cursor arrow arrow badValue {bad cursor spec "badValue"}} + {-handlesize 20 20 badValue {bad screen distance "badValue"}} + {-height 20 20 badValue {bad screen distance "badValue"}} + {-opaqueresize true 1 foo {expected boolean value but got "foo"}} + {-orient horizontal horizontal badValue + {bad orient "badValue": must be horizontal or vertical}} + {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} + {-sashcursor arrow arrow badValue {bad cursor spec "badValue"}} + {-sashpad 1.3 1 badValue {bad screen distance "badValue"}} + {-sashrelief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} + {-sashwidth 10 10 badValue {bad screen distance "badValue"}} + {-showhandle true 1 foo {expected boolean value but got "foo"}} + {-width 402 402 badValue {bad screen distance "badValue"}} +} { + set name [lindex $test 0] + test panedwindow-1.$i {configuration options} { + .p configure $name [lindex $test 1] + list [lindex [.p configure $name] 4] [.p cget $name] + } [list [lindex $test 2] [lindex $test 2]] + incr i + if {[lindex $test 3] != ""} { + test entry-1.$i {configuration options} { + list [catch {.p configure $name [lindex $test 3]} msg] $msg + } [list 1 [lindex $test 4]] + } + .p configure $name [lindex [.p configure $name] 3] + incr i +} +.p add [button .b] +.p add [button .c] +foreach test { + {-after .c .c badValue {bad window path name "badValue"}} + {-before .c .c badValue {bad window path name "badValue"}} + {-height 10 10 badValue {bad screen distance "badValue"}} + {-minsize 10 10 badValue {bad screen distance "badValue"}} + {-padx 1.3 1 badValue {bad screen distance "badValue"}} + {-pady 1.3 1 badValue {bad screen distance "badValue"}} + {-sticky nsew nesw abcd {bad stickyness value "abcd": must be a string containing zero or more of n, e, s, and w}} + {-width 10 10 badValue {bad screen distance "badValue"}} +} { + set name [lindex $test 0] + test panedwindow-1.$i {configuration options} { + .p paneconfigure .b $name [lindex $test 1] + list [lindex [.p paneconfigure .b $name] 4] [.p panecget .b $name] + } [list [lindex $test 2] [lindex $test 2]] + incr i + if {[lindex $test 3] != ""} { + test entry-1.$i {configuration options} { + list [catch {.p paneconfigure .b $name [lindex $test 3]} msg] $msg + } [list 1 [lindex $test 4]] + } + .p paneconfigure .b $name [lindex [.p paneconfigure .b $name] 3] + incr i +} +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-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] + .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] + .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} { + panedwindow .p + set result [list [catch {.p sash place foo bar baz} msg] $msg] + destroy .p + set result +} [list 1 "expected integer but got \"foo\""] +test panedwindow-11.3 {sash place subcommand, errors} { + panedwindow .p + set result [list [catch {.p sash place 0 foo bar} msg] $msg] + destroy .p + set result +} [list 1 "invalid sash index"] +test panedwindow-11.4 {sash place subcommand, errors} { + panedwindow .p + .p add [button .b] [button .c] + set result [list [catch {.p sash place 0 foo bar} msg] $msg] + destroy .p .b .c + set result +} [list 1 "expected integer but got \"foo\""] +test panedwindow-11.5 {sash place subcommand, errors} { + panedwindow .p + .p add [button .b] [button .c] + set result [list [catch {.p sash place 0 0 bar} msg] $msg] + destroy .p .b .c + set result +} [list 1 "expected integer but got \"bar\""] +test panedwindow-11.6 {sash place subcommand, moves sash} { + panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 + .p add [frame .f -width 20 -height 20] [button .c] + .p sash place 0 10 0 + set result [.p sash coord 0] + destroy .p .f .c + set result +} [list 10 0] +test panedwindow-11.7 {sash place subcommand, moves sash} { + 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 + set result [.p sash coord 0] + destroy .p .f .c + set result +} [list 0 10] +test panedwindow-11.8 {sash place subcommand, 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 place 0 10 0 + set result [.p sash coord 0] + destroy .p .f .c + set result +} [list 15 0] + +test panedwindow-12.1 {moving sash changes size of pane to left} { + panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false + .p add [frame .f -width 20 -height 20] [button .c] -sticky nsew + .p sash place 0 30 0 + pack .p + update + set result [winfo width .f] + destroy .p .f .c + set result +} 30 +test panedwindow-12.2 {moving sash changes size of pane to right} { + 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] + destroy .p .f .f2 + set result +} {20 10} +test panedwindow-12.3 {moving sash does not change reqsize of panedwindow} { + 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 + set result [winfo reqwidth .p] + destroy .p .f .f2 + set result +} 44 +test panedwindow-12.4 {moving sash changes size of pane above} { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ + -orient vertical + .p add [frame .f -width 20 -height 10] [button .c] -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} { + 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} { + 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} { + 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} { + 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} { + 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 .p.f .p.f2 + 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. + 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. + 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} { + 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-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-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-22.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-22.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-22.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-22.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-22.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-22.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-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-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.14 {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} + + +# cleanup +::tcltest::cleanupTests +return diff --git a/win/lamp.bmp b/win/lamp.bmp Binary files differnew file mode 100644 index 0000000..834c0f9 --- /dev/null +++ b/win/lamp.bmp diff --git a/win/nmakehlp.c b/win/nmakehlp.c new file mode 100644 index 0000000..42a168c --- /dev/null +++ b/win/nmakehlp.c @@ -0,0 +1,297 @@ +/* ---------------------------------------------------------------------------- + * nmakehlp.c -- + * + * This is used to fix limitations within nmake and the environment. + * + * Copyright (c) 2002 by David Gravereaux. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: nmakehlp.c,v 1.1.4.1 2002/06/10 05:08:00 wolfsuit Exp $ + * ---------------------------------------------------------------------------- + */ +#include <windows.h> +#pragma comment (lib, "user32.lib") +#pragma comment (lib, "kernel32.lib") + +/* protos */ +int CheckForCompilerFeature (const char *option); +int CheckForLinkerFeature (const char *option); +int IsIn (const char *string, const char *substring); +DWORD WINAPI ReadFromPipe (LPVOID args); + +/* globals */ +typedef struct { + HANDLE pipe; + char buffer[1000]; +} pipeinfo; + +pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; +pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}; + + + +/* exitcodes: 0 == no, 1 == yes, 2 == error */ +int +main (int argc, char *argv[]) +{ + char msg[300]; + DWORD dwWritten; + int chars; + + if (argc > 1 && *argv[1] == '-') { + switch (*(argv[1]+1)) { + case 'c': + if (argc != 3) { + chars = wsprintf(msg, "usage: %s -c <compiler option>\n" + "Tests for whether cl.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; + } + return CheckForCompilerFeature(argv[2]); + case 'l': + if (argc != 3) { + chars = wsprintf(msg, "usage: %s -l <linker option>\n" + "Tests for whether link.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; + } + return CheckForLinkerFeature(argv[2]); + case 'f': + if (argc == 2) { + chars = wsprintf(msg, "usage: %s -f <string> <substring>\n" + "Find a substring within another\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; + } else if (argc == 3) { + /* if the string is blank, there is no match */ + return 0; + } else { + return IsIn(argv[2], argv[3]); + } + } + } + chars = wsprintf(msg, "usage: %s -c|-l|-f ...\n" + "This is a little helper app to equalize shell differences between WinNT and\n" + "Win9x and get nmake.exe to accomplish its job.\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; +} + +int +CheckForCompilerFeature (const char *option) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + char cmdline[100]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = FALSE; + + /* create a non-inheritible pipe. */ + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* dupe the write side, make it inheritible, and close the original. */ + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* Same as above, but for the error side. */ + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* base command line */ + strcpy(cmdline, "cl.exe -nologo -c -TC -Fdtemp "); + /* append our option for testing */ + strcat(cmdline, option); + /* filename to compile, which exists, but is nothing and empty. */ + strcat(cmdline, " nul"); + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); + return 2; + } + + /* close our references to the write handles that have now been inherited. */ + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* start the pipe reader threads. */ + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* block waiting for the process to end. */ + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* clean up temporary files before returning */ + DeleteFile("temp.idb"); + DeleteFile("temp.pdb"); + + /* wait for our pipe to get done reading, should it be a little slow. */ + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* look for the commandline warning code in both streams. */ + return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL); +} + +int +CheckForLinkerFeature (const char *option) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + char cmdline[100]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = TRUE; + + /* create a non-inheritible pipe. */ + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* dupe the write side, make it inheritible, and close the original. */ + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* Same as above, but for the error side. */ + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* base command line */ + strcpy(cmdline, "link.exe -nologo "); + /* append our option for testing */ + strcat(cmdline, option); + /* filename to compile, which exists, but is nothing and empty. */ +// strcat(cmdline, " nul"); + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); + return 2; + } + + /* close our references to the write handles that have now been inherited. */ + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* start the pipe reader threads. */ + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* block waiting for the process to end. */ + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* wait for our pipe to get done reading, should it be a little slow. */ + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* look for the commandline warning code in the stderr stream. */ + return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL); +} + +DWORD WINAPI +ReadFromPipe (LPVOID args) +{ + pipeinfo *pi = (pipeinfo *) args; + char *lastBuf = pi->buffer; + DWORD dwRead; + BOOL ok; + +again: + ok = ReadFile(pi->pipe, lastBuf, 25, &dwRead, 0L); + if (!ok || dwRead == 0) { + CloseHandle(pi->pipe); + return 0; + } + lastBuf += dwRead; + goto again; + + return 0; /* makes the compiler happy */ +} + +int +IsIn (const char *string, const char *substring) +{ + return (strstr(string, substring) != NULL); +} |