--- /dev/null
+/*
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+
+/* 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.
+ *
+ * RESIZE_PENDING: Non-zero means that the window might need to
+ * change its size (or the size of its panes)
+ * because of a change in the size of one of its
+ * children.
+ */
+
+#define REDRAW_PENDING 0x0001
+#define WIDGET_DELETED 0x0002
+#define REQUESTED_RELAYOUT 0x0004
+#define RECOMPUTE_GEOMETRY 0x0008
+#define PROXY_REDRAW_PENDING 0x0010
+#define RESIZE_PENDING 0x0020
+
+/*
+ * 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));
+
+#define ValidSashIndex(pwPtr, sash) \
+ (((sash) >= 0) && ((sash) < (pwPtr)->numSlaves))
+
+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}
+};
+
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 (!ValidSashIndex(pwPtr, sash)) {
+ 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 (!ValidSashIndex(pwPtr, sash)) {
+ 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 (!ValidSashIndex(pwPtr, sash)) {
+ 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ }
+ if (pwPtr->flags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ArrangePanes, (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);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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);
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ if (!(pwPtr->flags & RESIZE_PENDING)) {
+ pwPtr->flags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ArrangePanes, (ClientData) pwPtr);
+ }
+ } else {
+ ComputeGeometry(pwPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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|RESIZE_PENDING);
+
+ /*
+ * 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);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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--;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+ }
+
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
--- /dev/null
+/*
+ * tkStyle.c --
+ *
+ * This file implements the widget styles and themes support.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+
+/*
+ * The following structure is used to cache widget option specs matching an
+ * element's required options defined by Tk_ElementOptionSpecs. It also holds
+ * information behind Tk_StyledElement opaque tokens.
+ */
+
+typedef struct StyledWidgetSpec {
+ struct StyledElement *elementPtr; /* Pointer to the element holding this
+ * structure. */
+ Tk_OptionTable optionTable; /* Option table for the widget class
+ * using the element. */
+ CONST Tk_OptionSpec **optionsPtr; /* Table of option spec pointers,
+ * matching the option list provided
+ * during element registration.
+ * Malloc'd. */
+} StyledWidgetSpec;
+
+/*
+ * Elements are declared using static templates. But static
+ * information must be completed by dynamic information only
+ * accessible at runtime. For each registered element, an instance of
+ * the following structure is stored in each style engine and used to
+ * cache information about the widget types (identified by their
+ * optionTable) that use the given element.
+ */
+
+typedef struct StyledElement {
+ struct Tk_ElementSpec *specPtr;
+ /* Filled with template provided during
+ * registration. NULL means no implementation
+ * is available for the current engine. */
+ int nbWidgetSpecs; /* Size of the array below. Number of distinct
+ * widget classes (actually, distinct option
+ * tables) that used the element so far. */
+ StyledWidgetSpec *widgetSpecs;
+ /* See above for the structure definition.
+ * Table grows dynamically as new widgets
+ * use the element. Malloc'd. */
+} StyledElement;
+
+/*
+ * The following structure holds information behind Tk_StyleEngine opaque
+ * tokens.
+ */
+
+typedef struct StyleEngine {
+ CONST char *name; /* Name of engine. Points to a hash key. */
+ StyledElement *elements; /* Table of widget element descriptors. Each
+ * element is indexed by a unique system-wide
+ * ID. Table grows dynamically as new elements
+ * are registered. Malloc'd*/
+ struct StyleEngine *parentPtr;
+ /* Parent engine. Engines may be layered to form
+ * a fallback chain, terminated by the default
+ * system engine. */
+} StyleEngine;
+
+/*
+ * Styles are instances of style engines. The following structure holds
+ * information behind Tk_Style opaque tokens.
+ */
+
+typedef struct Style {
+ int refCount; /* Number of active uses of this style.
+ * If this count is 0, then this Style
+ * structure is no longer valid. */
+ Tcl_HashEntry *hashPtr; /* Entry in style table for this structure,
+ * used when deleting it. */
+ CONST char *name; /* Name of style. Points to a hash key. */
+ StyleEngine *enginePtr; /* Style engine of which the style is an
+ * instance. */
+ ClientData clientData; /* Data provided during registration. */
+} Style;
+
+/*
+ * Each registered element uses an instance of the following structure.
+ */
+
+typedef struct Element {
+ CONST char *name; /* Name of element. Points to a hash key. */
+ int id; /* Id of element. */
+ int genericId; /* Id of generic element. */
+ int created; /* Boolean, whether the element was created
+ * explicitly (was registered) or implicitly
+ * (by a derived element). */
+} Element;
+
+/*
+ * Thread-local data.
+ */
+
+typedef struct ThreadSpecificData {
+ int nbInit; /* Number of calls to the init proc. */
+ Tcl_HashTable engineTable; /* Map a name to a style engine. Keys are
+ * strings, values are Tk_StyleEngine
+ * pointers. */
+ StyleEngine *defaultEnginePtr;
+ /* Default, core-defined style engine. Global
+ * fallback for all engines. */
+ Tcl_HashTable styleTable; /* Map a name to a style. Keys are strings,
+ * values are Tk_Style pointers.*/
+ int nbElements; /* Size of the below tables. */
+ Tcl_HashTable elementTable; /* Map a name to an element Id. Keys are
+ * strings, values are integer element IDs. */
+ Element *elements; /* Array of Elements. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+/* TODO: sort alpha. */
+static int CreateElement _ANSI_ARGS_((CONST char *name,
+ int create));
+static void DupStyleObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeElement _ANSI_ARGS_((Element *elementPtr));
+static void FreeStyle _ANSI_ARGS_((Style *stylePtr));
+static void FreeStyledElement _ANSI_ARGS_((
+ StyledElement *elementPtr));
+static void FreeStyleEngine _ANSI_ARGS_((
+ StyleEngine *enginePtr));
+static void FreeStyleObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void FreeWidgetSpec _ANSI_ARGS_((
+ StyledWidgetSpec *widgetSpecPtr));
+static StyledElement * GetStyledElement _ANSI_ARGS_((
+ StyleEngine *enginePtr, int elementId));
+static StyledWidgetSpec * GetWidgetSpec _ANSI_ARGS_((StyledElement *elementPtr,
+ Tk_OptionTable optionTable));
+static void InitElement _ANSI_ARGS_((Element *elementPtr,
+ CONST char *name, int id, int genericId,
+ int created));
+static void InitStyle _ANSI_ARGS_((Style *stylePtr,
+ Tcl_HashEntry *hashPtr, CONST char *name,
+ StyleEngine *enginePtr, ClientData clientData));
+static void InitStyledElement _ANSI_ARGS_((
+ StyledElement *elementPtr));
+static void InitStyleEngine _ANSI_ARGS_((StyleEngine *enginePtr,
+ CONST char *name, StyleEngine *parentPtr));
+static void InitWidgetSpec _ANSI_ARGS_((
+ StyledWidgetSpec *widgetSpecPtr,
+ StyledElement *elementPtr,
+ Tk_OptionTable optionTable));
+static int SetStyleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "style" Tcl
+ * object, used for drawing. The internalRep.otherValuePtr field of
+ * each style object points to the Style structure for the stylefont, or
+ * NULL.
+ */
+
+static Tcl_ObjType styleObjType = {
+ "style", /* name */
+ FreeStyleObjProc, /* freeIntRepProc */
+ DupStyleObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetStyleFromAny /* setFromAnyProc */
+};
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkStylePkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the style
+ * package on a per application basis.
+ *
+ * Results:
+ * Stores data in thread-local storage.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkStylePkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->nbInit != 0) return;
+
+ /*
+ * Initialize tables.
+ */
+
+ Tcl_InitHashTable(&tsdPtr->engineTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&tsdPtr->styleTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&tsdPtr->elementTable, TCL_STRING_KEYS);
+ tsdPtr->nbElements = 0;
+ tsdPtr->elements = NULL;
+
+ /*
+ * Create the default system engine.
+ */
+
+ tsdPtr->defaultEnginePtr =
+ (StyleEngine *) Tk_RegisterStyleEngine(NULL, NULL);
+
+ /*
+ * Create the default system style.
+ */
+
+ Tk_CreateStyle(NULL, (Tk_StyleEngine) tsdPtr->defaultEnginePtr,
+ (ClientData) 0);
+
+ tsdPtr->nbInit++;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkStylePkgFree --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures that were used by the style package
+ * for this application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkStylePkgFree(mainPtr)
+ TkMainInfo *mainPtr; /* The application being deleted. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ StyleEngine *enginePtr;
+ int i;
+
+ tsdPtr->nbInit--;
+ if (tsdPtr->nbInit != 0) return;
+
+ /*
+ * Free styles.
+ */
+
+ entryPtr = Tcl_FirstHashEntry(&tsdPtr->styleTable, &search);
+ while (entryPtr != NULL) {
+ ckfree((char *) Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->styleTable);
+
+ /*
+ * Free engines.
+ */
+
+ entryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
+ while (entryPtr != NULL) {
+ enginePtr = (StyleEngine *) Tcl_GetHashValue(entryPtr);
+ FreeStyleEngine(enginePtr);
+ ckfree((char *) enginePtr);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->engineTable);
+
+ /*
+ * Free elements.
+ */
+
+ for (i = 0; i < tsdPtr->nbElements; i++) {
+ FreeElement(tsdPtr->elements+i);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->elementTable);
+ ckfree((char *) tsdPtr->elements);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_RegisterStyleEngine --
+ *
+ * This procedure is called to register a new style engine. Style engines
+ * are stored in thread-local space.
+ *
+ * Results:
+ * The newly allocated engine.
+ *
+ * Side effects:
+ * Memory allocated. Data added to thread-local table.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyleEngine
+Tk_RegisterStyleEngine(name, parent)
+ CONST char *name; /* Name of the engine to create. NULL or empty
+ * means the default system engine. */
+ Tk_StyleEngine parent; /* The engine's parent. NULL means the default
+ * system engine. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ StyleEngine *enginePtr;
+
+ /*
+ * Attempt to create a new entry in the engine table.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->engineTable, (name?name:""),
+ &newEntry);
+ if (!newEntry) {
+ /*
+ * An engine was already registered by that name.
+ */
+
+ return NULL;
+ }
+
+ /*
+ * Allocate and intitialize a new engine.
+ */
+
+ enginePtr = (StyleEngine *) ckalloc(sizeof(StyleEngine));
+ InitStyleEngine(enginePtr, Tcl_GetHashKey(&tsdPtr->engineTable, entryPtr),
+ (StyleEngine *) parent);
+ Tcl_SetHashValue(entryPtr, (ClientData) enginePtr);
+
+ return (Tk_StyleEngine) enginePtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyleEngine --
+ *
+ * Initialize a newly allocated style engine.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyleEngine(enginePtr, name, parentPtr)
+ StyleEngine *enginePtr; /* Points to an uninitialized engine. */
+ CONST char *name; /* Name of the registered engine. NULL or empty
+ * means the default system engine. Usually
+ * points to the hash key. */
+ StyleEngine *parentPtr; /* The engine's parent. NULL means the default
+ * system engine. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int elementId;
+
+ if (name == NULL || *name == '\0') {
+ /*
+ * This is the default style engine.
+ */
+
+ enginePtr->parentPtr = NULL;
+
+ } else if (parentPtr == NULL) {
+ /*
+ * The default style engine is the parent.
+ */
+
+ enginePtr->parentPtr = tsdPtr->defaultEnginePtr;
+
+ } else {
+ enginePtr->parentPtr = parentPtr;
+ }
+
+ /*
+ * Allocate and initialize elements array.
+ */
+
+ if (tsdPtr->nbElements > 0) {
+ enginePtr->elements = (StyledElement *) ckalloc(
+ sizeof(StyledElement) * tsdPtr->nbElements);
+ for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
+ InitStyledElement(enginePtr->elements+elementId);
+ }
+ } else {
+ enginePtr->elements = NULL;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyleEngine --
+ *
+ * Free an engine and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyleEngine(enginePtr)
+ StyleEngine *enginePtr; /* The style engine to free. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int elementId;
+
+ /*
+ * Free allocated elements.
+ */
+
+ for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
+ FreeStyledElement(enginePtr->elements+elementId);
+ }
+ ckfree((char *) enginePtr->elements);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyleEngine --
+ *
+ * Retrieve a registered style engine by its name.
+ *
+ * Results:
+ * A pointer to the style engine, or NULL if none found.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyleEngine
+Tk_GetStyleEngine(name)
+ CONST char *name; /* Name of the engine to retrieve. NULL or
+ * empty means the default system engine. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+
+ if (name == NULL) {
+ return (Tk_StyleEngine) tsdPtr->defaultEnginePtr;
+ }
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->engineTable, (name?name:""));
+ if (!entryPtr) {
+ return NULL;
+ }
+
+ return (Tk_StyleEngine) Tcl_GetHashValue(entryPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitElement --
+ *
+ * Initialize a newly allocated element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitElement(elementPtr, name, id, genericId, created)
+ Element *elementPtr; /* Points to an uninitialized element.*/
+ CONST char *name; /* Name of the registered element. Usually
+ * points to the hash key. */
+ int id; /* Unique element ID. */
+ int genericId; /* ID of generic element. -1 means none. */
+ int created; /* Boolean, whether the element was created
+ * explicitly (was registered) or implicitly
+ * (by a derived element). */
+{
+ elementPtr->name = name;
+ elementPtr->id = id;
+ elementPtr->genericId = genericId;
+ elementPtr->created = (created?1:0);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeElement --
+ *
+ * Free an element and its associated data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeElement(elementPtr)
+ Element *elementPtr; /* The element to free. */
+{
+ /* Nothing to do. */
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyledElement --
+ *
+ * Initialize a newly allocated styled element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyledElement(elementPtr)
+ StyledElement *elementPtr; /* Points to an uninitialized element.*/
+{
+ memset(elementPtr, 0, sizeof(StyledElement));
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyledElement --
+ *
+ * Free a styled element and its associated data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyledElement(elementPtr)
+ StyledElement *elementPtr; /* The styled element to free. */
+{
+ int i;
+
+ /*
+ * Free allocated widget specs.
+ */
+
+ for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
+ FreeWidgetSpec(elementPtr->widgetSpecs+i);
+ }
+ ckfree((char *) elementPtr->widgetSpecs);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CreateElement --
+ *
+ * Find an existing or create a new element.
+ *
+ * Results:
+ * The unique ID for the created or found element.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+CreateElement(name, create)
+ CONST char *name; /* Name of the element. */
+ int create; /* Boolean, whether the element is being created
+ * explicitly (being registered) or implicitly (by a
+ * derived element). */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr, *engineEntryPtr;
+ Tcl_HashSearch search;
+ int newEntry;
+ int elementId, genericId = -1;
+ char *dot;
+ StyleEngine *enginePtr;
+
+ /*
+ * Find or create the element.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->elementTable, name, &newEntry);
+ if (!newEntry) {
+ elementId = (int) Tcl_GetHashValue(entryPtr);
+ if (create) {
+ tsdPtr->elements[elementId].created = 1;
+ }
+ return elementId;
+ }
+
+ /*
+ * The element didn't exist. If it's a derived element, find or
+ * create its generic element ID.
+ */
+
+ dot = strchr(name, '.');
+ if (dot) {
+ genericId = CreateElement(dot+1, 0);
+ }
+
+ elementId = tsdPtr->nbElements++;
+ Tcl_SetHashValue(entryPtr, (ClientData) elementId);
+
+ /*
+ * Reallocate element table.
+ */
+
+ tsdPtr->elements = (Element *) ckrealloc((char *) tsdPtr->elements,
+ sizeof(Element) * tsdPtr->nbElements);
+ InitElement(tsdPtr->elements+elementId,
+ Tcl_GetHashKey(&tsdPtr->elementTable, entryPtr), elementId,
+ genericId, create);
+
+ /*
+ * Reallocate style engines' element table.
+ */
+
+ engineEntryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
+ while (engineEntryPtr != NULL) {
+ enginePtr = (StyleEngine *) Tcl_GetHashValue(engineEntryPtr);
+
+ enginePtr->elements = (StyledElement *) ckrealloc(
+ (char *) enginePtr->elements,
+ sizeof(StyledElement) * tsdPtr->nbElements);
+ InitStyledElement(enginePtr->elements+elementId);
+
+ engineEntryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ return elementId;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementId --
+ *
+ * Find an existing element.
+ *
+ * Results:
+ * The unique ID for the found element, or -1 if not found.
+ *
+ * Side effects:
+ * Generic elements may be created.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_GetElementId(name)
+ CONST char *name; /* Name of the element. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int genericId = -1;
+ char *dot;
+
+ /*
+ * Find the element Id.
+ */
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->elementTable, name);
+ if (entryPtr) {
+ return (int) Tcl_GetHashValue(entryPtr);
+ }
+
+ /*
+ * Element not found. If the given name was derived, then first search for
+ * the generic element. If found, create the new derived element.
+ */
+
+ dot = strchr(name, '.');
+ if (!dot) {
+ return -1;
+ }
+ genericId = Tk_GetElementId(dot+1);
+ if (genericId == -1) {
+ return -1;
+ }
+ if (!tsdPtr->elements[genericId].created) {
+ /*
+ * The generic element was created implicitly and thus has no real
+ * existence.
+ */
+
+ return -1;
+ } else {
+ /*
+ * The generic element was created explicitly. Create the derived
+ * element.
+ */
+
+ return CreateElement(name, 1);
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_RegisterStyledElement --
+ *
+ * Register an implementation of a new or existing element for the
+ * given style engine.
+ *
+ * Results:
+ * The unique ID for the created or found element.
+ *
+ * Side effects:
+ * Elements may be created. Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_RegisterStyledElement(engine, templatePtr)
+ Tk_StyleEngine engine; /* Style engine providing the
+ * implementation. */
+ Tk_ElementSpec *templatePtr; /* Static template information about
+ * the element. */
+{
+ int elementId;
+ StyledElement *elementPtr;
+ Tk_ElementSpec *specPtr;
+ int nbOptions;
+ register Tk_ElementOptionSpec *srcOptions, *dstOptions;
+
+ if (templatePtr->version != TK_STYLE_VERSION_1) {
+ /*
+ * Version mismatch. Do nothing.
+ */
+
+ return -1;
+ }
+
+ if (engine == NULL) {
+ engine = Tk_GetStyleEngine(NULL);
+ }
+
+ /*
+ * Register the element, allocating storage in the various engines if
+ * necessary.
+ */
+
+ elementId = CreateElement(templatePtr->name, 1);
+
+ /*
+ * Initialize the styled element.
+ */
+
+ elementPtr = ((StyleEngine *) engine)->elements+elementId;
+
+ specPtr = (Tk_ElementSpec *) ckalloc(sizeof(Tk_ElementSpec));
+ specPtr->version = templatePtr->version;
+ specPtr->name = ckalloc(strlen(templatePtr->name)+1);
+ strcpy(specPtr->name, templatePtr->name);
+ nbOptions = 0;
+ for (nbOptions = 0, srcOptions = templatePtr->options;
+ srcOptions->name != NULL;
+ nbOptions++, srcOptions++);
+ specPtr->options = (Tk_ElementOptionSpec *) ckalloc(
+ sizeof(Tk_ElementOptionSpec) * (nbOptions+1));
+ for (srcOptions = templatePtr->options, dstOptions = specPtr->options;
+ /* End condition within loop */;
+ srcOptions++, dstOptions++) {
+ if (srcOptions->name == NULL) {
+ dstOptions->name = NULL;
+ break;
+ }
+
+ dstOptions->name = ckalloc(strlen(srcOptions->name)+1);
+ strcpy(dstOptions->name, srcOptions->name);
+ dstOptions->type = srcOptions->type;
+ }
+ specPtr->getSize = templatePtr->getSize;
+ specPtr->getBox = templatePtr->getBox;
+ specPtr->getBorderWidth = templatePtr->getBorderWidth;
+ specPtr->draw = templatePtr->draw;
+
+ elementPtr->specPtr = specPtr;
+ elementPtr->nbWidgetSpecs = 0;
+ elementPtr->widgetSpecs = NULL;
+
+ return elementId;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetStyledElement --
+ *
+ * Get a registered implementation of an existing element for the
+ * given style engine.
+ *
+ * Results:
+ * The styled element descriptor, or NULL if not found.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static StyledElement *
+GetStyledElement(enginePtr, elementId)
+ StyleEngine *enginePtr; /* Style engine providing the implementation.
+ * NULL means the default system engine. */
+ int elementId; /* Unique element ID */{
+ StyledElement *elementPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ StyleEngine *enginePtr2;
+
+ if (enginePtr == NULL) {
+ enginePtr = tsdPtr->defaultEnginePtr;
+ }
+
+ while (elementId >= 0 && elementId < tsdPtr->nbElements) {
+ /*
+ * Look for an implemented element through the engine chain.
+ */
+
+ enginePtr2 = enginePtr;
+ do {
+ elementPtr = enginePtr2->elements+elementId;
+ if (elementPtr->specPtr != NULL) {
+ return elementPtr;
+ }
+ enginePtr2 = enginePtr2->parentPtr;
+ } while (enginePtr2 != NULL);
+
+ /*
+ * None found, try with the generic element.
+ */
+
+ elementId = tsdPtr->elements[elementId].genericId;
+ }
+
+ /*
+ * No matching element found.
+ */
+
+ return NULL;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitWidgetSpec --
+ *
+ * Initialize a newly allocated widget spec.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable)
+ StyledWidgetSpec *widgetSpecPtr; /* Points to an uninitialized widget
+ * spec. */
+ StyledElement *elementPtr; /* Styled element descriptor. */
+ Tk_OptionTable optionTable; /* The widget's option table. */
+{
+ int i, nbOptions;
+ Tk_ElementOptionSpec *elementOptionPtr;
+ CONST Tk_OptionSpec *widgetOptionPtr;
+
+ widgetSpecPtr->elementPtr = elementPtr;
+ widgetSpecPtr->optionTable = optionTable;
+
+ /*
+ * Count the number of options.
+ */
+
+ for (nbOptions = 0, elementOptionPtr = elementPtr->specPtr->options;
+ elementOptionPtr->name != NULL;
+ nbOptions++, elementOptionPtr++) {
+ }
+
+ /*
+ * Build the widget option list.
+ */
+
+ widgetSpecPtr->optionsPtr = (CONST Tk_OptionSpec **) ckalloc(
+ sizeof(Tk_OptionSpec *) * nbOptions);
+ for (i = 0, elementOptionPtr = elementPtr->specPtr->options;
+ i < nbOptions;
+ i++, elementOptionPtr++) {
+ widgetOptionPtr = TkGetOptionSpec(elementOptionPtr->name, optionTable);
+
+ /*
+ * Check that the widget option type is compatible with one of the
+ * element's required types.
+ */
+
+ if ( elementOptionPtr->type == TK_OPTION_END
+ || elementOptionPtr->type == widgetOptionPtr->type) {
+ widgetSpecPtr->optionsPtr[i] = widgetOptionPtr;
+ } else {
+ widgetSpecPtr->optionsPtr[i] = NULL;
+ }
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeWidgetSpec --
+ *
+ * Free a widget spec and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeWidgetSpec(widgetSpecPtr)
+ StyledWidgetSpec *widgetSpecPtr; /* The widget spec to free. */
+{
+ ckfree((char *) widgetSpecPtr->optionsPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetWidgetSpec --
+ *
+ * Return a new or existing widget spec for the given element and
+ * widget type (identified by its option table).
+ *
+ * Results:
+ * A pointer to the matching widget spec.
+ *
+ * Side effects:
+ * Memory may be allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static StyledWidgetSpec *
+GetWidgetSpec(elementPtr, optionTable)
+ StyledElement *elementPtr; /* Styled element descriptor. */
+ Tk_OptionTable optionTable; /* The widget's option table. */
+{
+ StyledWidgetSpec *widgetSpecPtr;
+ int i;
+
+ /*
+ * Try to find an existing widget spec.
+ */
+
+ for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
+ widgetSpecPtr = elementPtr->widgetSpecs+i;
+ if (widgetSpecPtr->optionTable == optionTable) {
+ return widgetSpecPtr;
+ }
+ }
+
+ /*
+ * Create and initialize a new widget spec.
+ */
+
+ i = elementPtr->nbWidgetSpecs++;
+ elementPtr->widgetSpecs = (StyledWidgetSpec *) ckrealloc(
+ (char *) elementPtr->widgetSpecs,
+ sizeof(StyledWidgetSpec) * elementPtr->nbWidgetSpecs);
+ widgetSpecPtr = elementPtr->widgetSpecs+i;
+ InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable);
+
+ return widgetSpecPtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyledElement --
+ *
+ * This procedure returns a styled instance of the given element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyledElement
+Tk_GetStyledElement(style, elementId, optionTable)
+ Tk_Style style; /* The widget style. */
+ int elementId; /* Unique element ID. */
+ Tk_OptionTable optionTable; /* Option table for the widget. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledElement *elementPtr;
+
+ /*
+ * Get an element implementation and call corresponding hook.
+ */
+
+ elementPtr = GetStyledElement((stylePtr?stylePtr->enginePtr:NULL),
+ elementId);
+ if (!elementPtr) {
+ return NULL;
+ }
+
+ return (Tk_StyledElement) GetWidgetSpec(elementPtr, optionTable);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementSize --
+ *
+ * This procedure computes the size of the given widget element according
+ * to its style.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_GetElementSize(style, element, recordPtr, tkwin, width, height, inner, widthPtr,
+ heightPtr)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+ int width, height; /* Requested size. */
+ int inner; /* Boolean. If TRUE, compute the outer
+ * size according to the requested
+ * minimum inner size. If FALSE, compute
+ * the inner size according to the
+ * requested maximum outer size. */
+ int *widthPtr, *heightPtr; /* Returned size. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->getSize(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, width, height, inner,
+ widthPtr, heightPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementBox --
+ *
+ * This procedure computes the bounding or inscribed box coordinates
+ * of the given widget element according to its style and within the
+ * given limits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_GetElementBox(style, element, recordPtr, tkwin, x, y, width, height, inner,
+ xPtr, yPtr, widthPtr, heightPtr)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+ int x, y; /* Top left corner of available area. */
+ int width, height; /* Size of available area. */
+ int inner; /* Boolean. If TRUE, compute the
+ * bounding box according to the
+ * requested inscribed box size. If
+ * FALSE, compute the inscribed box
+ * according to the requested bounding
+ * box. */
+ int *xPtr, *yPtr; /* Returned top left corner. */
+ int *widthPtr, *heightPtr; /* Returned size. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->getBox(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, x, y, width, height,
+ inner, xPtr, yPtr, widthPtr, heightPtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementBorderWidth --
+ *
+ * This procedure computes the border widthof the given widget element
+ * according to its style and within the given limits.
+ *
+ * Results:
+ * Border width in pixels. This value is uniform for all four sides.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_GetElementBorderWidth(style, element, recordPtr, tkwin)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ return widgetSpecPtr->elementPtr->specPtr->getBorderWidth(
+ stylePtr->clientData, recordPtr, widgetSpecPtr->optionsPtr, tkwin);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawElement --
+ *
+ * This procedure draw the given widget element in a given drawable area.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawElement(style, element, recordPtr, tkwin, d, x, y, width, height, state)
+ Tk_Style style; /* The widget style. */
+ Tk_StyledElement element; /* The styled element, previously
+ * returned by Tk_GetStyledElement. */
+ char *recordPtr; /* The widget record. */
+ Tk_Window tkwin; /* The widget window. */
+ Drawable d; /* Where to draw element. */
+ int x, y; /* Top left corner of element. */
+ int width, height; /* Size of element. */
+ int state; /* Drawing state flags. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->draw(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, d, x, y, width,
+ height, state);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_CreateStyle --
+ *
+ * This procedure is called to create a new style as an instance of the
+ * given engine. Styles are stored in thread-local space.
+ *
+ * Results:
+ * The newly allocated style.
+ *
+ * Side effects:
+ * Memory allocated. Data added to thread-local table. The style's
+ * refCount is incremented.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_CreateStyle(name, engine, clientData)
+ CONST char *name; /* Name of the style to create. NULL or empty
+ * means the default system style. */
+ Tk_StyleEngine engine; /* The style engine. */
+ ClientData clientData; /* Private data passed as is to engine code. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ Style *stylePtr;
+
+ /*
+ * Attempt to create a new entry in the style table.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->styleTable, (name?name:""),
+ &newEntry);
+ if (!newEntry) {
+ /*
+ * A style was already registered by that name.
+ */
+
+ return NULL;
+ }
+
+ /*
+ * Allocate and intitialize a new style.
+ */
+
+ stylePtr = (Style *) ckalloc(sizeof(Style));
+ InitStyle(stylePtr, entryPtr, Tcl_GetHashKey(&tsdPtr->styleTable, entryPtr),
+ (engine?(StyleEngine *) engine:tsdPtr->defaultEnginePtr), clientData);
+ Tcl_SetHashValue(entryPtr, (ClientData) stylePtr);
+ stylePtr->refCount++;
+
+ return (Tk_Style) stylePtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_NameOfStyle --
+ *
+ * Given a style, return its registered name.
+ *
+ * Results:
+ * The return value is the name that was passed to Tk_CreateStyle() to
+ * create the style. The storage for the returned string is private
+ * (it points to the corresponding hash key) The caller should not modify
+ * this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+CONST char *
+Tk_NameOfStyle(style)
+ Tk_Style style; /* Style whose name is desired. */
+{
+ Style *stylePtr = (Style *) style;
+
+ return stylePtr->name;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyle --
+ *
+ * Initialize a newly allocated style.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyle(stylePtr, hashPtr, name, enginePtr, clientData)
+ Style *stylePtr; /* Points to an uninitialized style. */
+ Tcl_HashEntry *hashPtr; /* Hash entry for the registered style. */
+ CONST char *name; /* Name of the registered style. NULL or empty
+ * means the default system style. Usually
+ * points to the hash key. */
+ StyleEngine *enginePtr; /* The style engine. */
+ ClientData clientData; /* Private data passed as is to engine code. */
+{
+ stylePtr->refCount = 0;
+ stylePtr->hashPtr = hashPtr;
+ stylePtr->name = name;
+ stylePtr->enginePtr = enginePtr;
+ stylePtr->clientData = clientData;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyle --
+ *
+ * Free a style and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyle(stylePtr)
+ Style *stylePtr; /* The style to free. */
+{
+ /* Nothing to do. */
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyle --
+ *
+ * Retrieve a registered style by its name.
+ *
+ * Results:
+ * A pointer to the style engine, or NULL if none found. In the latter
+ * case and if the interp is not NULL, an error message is left in the
+ * interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_GetStyle(interp, name)
+ Tcl_Interp *interp; /* Interp for error return. */
+ CONST char *name; /* Name of the style to retrieve. NULL or empty
+ * means the default system style. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ Style *stylePtr;
+
+ /*
+ * Search for a corresponding entry in the style table.
+ */
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name?name:""));
+ if (entryPtr == NULL) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", NULL);
+ }
+ return (Tk_Style) NULL;
+ }
+ stylePtr = (Style *) Tcl_GetHashValue(entryPtr);
+ stylePtr->refCount++;
+
+ return (Tk_Style) stylePtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeStyle --
+ *
+ * Free a style previously created by Tk_CreateStyle.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The style's refCount is decremented. If it reaches zero, the style
+ * is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeStyle(style)
+ Tk_Style style; /* The style to free. */
+{
+ Style *stylePtr = (Style *) style;
+
+ if (stylePtr == NULL) {
+ return;
+ }
+ stylePtr->refCount--;
+ if (stylePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * Keep the default style alive.
+ */
+
+ if (*stylePtr->name == '\0') {
+ stylePtr->refCount = 1;
+ return;
+ }
+
+ Tcl_DeleteHashEntry(stylePtr->hashPtr);
+ FreeStyle(stylePtr);
+ ckfree((char *) stylePtr);
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_AllocStyleFromObj --
+ *
+ * Map the string name of a style to a corresponding Tk_Style. The style
+ * must have already been created by Tk_CreateStyle.
+ *
+ * Results:
+ * The return value is a token for the style that matches objPtr, or
+ * NULL if none found. If NULL is returned, an error message will be
+ * left in interp's result object.
+ *
+ * Side effects:
+ * The style's reference count is incremented. For each call to this
+ * procedure, there should eventually be a call to Tk_FreeStyle() or
+ * Tk_FreeStyleFromObj() so that the database is cleaned up when styles
+ * aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_AllocStyleFromObj(interp, objPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Obj *objPtr; /* Object containing name of the style to
+ * retrieve. */
+{
+ Style *stylePtr;
+
+ if (objPtr->typePtr != &styleObjType) {
+ SetStyleFromAny(interp, objPtr);
+ stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
+ } else {
+ stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
+ stylePtr->refCount++;
+ }
+
+ return (Tk_Style) stylePtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetStyleFromObj --
+ *
+ * Find the style that corresponds to a given object. The style must
+ * have already been created by Tk_CreateStyle.
+ *
+ * Results:
+ * The return value is a token for the style that matches objPtr, or
+ * NULL if none found.
+ *
+ * Side effects:
+ * If the object is not already a style ref, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_GetStyleFromObj(objPtr)
+ Tcl_Obj *objPtr; /* The object from which to get the style. */
+{
+ if (objPtr->typePtr != &styleObjType) {
+ SetStyleFromAny((Tcl_Interp *) NULL, objPtr);
+ }
+
+ return (Tk_Style) objPtr->internalRep.otherValuePtr;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeStyleFromObj --
+ *
+ * Called to release a style inside a Tcl_Obj *.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the object is a style ref, the conversion will free its
+ * internal representation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeStyleFromObj(objPtr)
+ Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
+{
+ if (objPtr->typePtr == &styleObjType) {
+ FreeStyleObjProc(objPtr);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetStyleFromAny --
+ *
+ * Convert the internal representation of a Tcl object to the
+ * style internal form.
+ *
+ * Results:
+ * Always returns TCL_OK. If an error occurs is returned (e.g. the
+ * style doesn't exist), an error message will be left in interp's
+ * result.
+ *
+ * Side effects:
+ * The object is left with its typePtr pointing to styleObjType.
+ * The reference count is incremented (in Tk_GetStyle()).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetStyleFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *name;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ name = Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &styleObjType;
+ objPtr->internalRep.otherValuePtr = (VOID *) Tk_GetStyle(interp, name);
+
+ return TCL_OK;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyleObjProc --
+ *
+ * This proc is called to release an object reference to a style.
+ * Called when the object's internal rep is released.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count is decremented (in Tk_FreeStyle()).
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyleObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
+{
+ Style *stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
+
+ if (stylePtr != NULL) {
+ Tk_FreeStyle((Tk_Style) stylePtr);
+ objPtr->internalRep.otherValuePtr = NULL;
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupStyleObjProc --
+ *
+ * When a cached style object is duplicated, this is called to
+ * update the internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The style's refCount is incremented and the internal rep of the copy
+ * is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupStyleObjProc(srcObjPtr, dupObjPtr)
+ Tcl_Obj *srcObjPtr; /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr; /* The object we are copying to. */
+{
+ Style *stylePtr = (Style *) srcObjPtr->internalRep.otherValuePtr;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.otherValuePtr = (VOID *) stylePtr;
+
+ if (stylePtr != NULL) {
+ stylePtr->refCount++;
+ }
+}
OSDN Git Service
